Nominal/nominal_dt_data.ML
author Christian Urban <urbanc@in.tum.de>
Tue, 05 Jul 2011 15:00:41 +0200
changeset 2946 d9c3cc271e62
parent 2927 116f9ba4f59f
child 2957 01ff621599bc
permissions -rw-r--r--
added a tactic "all_trivials" which simplifies all trivial constructor cases and leaves the others untouched.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2890
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     1
(* Author: Christian Urban
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     2
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     3
   data about nominal datatypes 
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     4
*)
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     5
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     6
signature NOMINAL_DT_DATA =
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     7
sig
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     8
  type info =
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
     9
   {inject : thm list,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    10
    distinct : thm list,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    11
    strong_inducts : thm list,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    12
    strong_exhaust : thm list}
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    13
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    14
  val get_all_info: Proof.context -> (string * info) list
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    15
  val get_info: Proof.context -> string -> info option
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    16
  val the_info: Proof.context -> string -> info 
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    17
  val register_info: (string * info) -> Context.generic -> Context.generic
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    18
  val mk_infos: string list -> thm list -> thm list -> thm list -> thm list -> (string * info) list
2927
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    19
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    20
  datatype alpha_result = AlphaResult of
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    21
    {alpha_names      : string list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    22
     alpha_trms       : term list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    23
     alpha_tys        : typ list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    24
     alpha_bn_names   : string list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    25
     alpha_bn_trms    : term list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    26
     alpha_bn_tys     : typ list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    27
     alpha_intros     : thm list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    28
     alpha_cases      : thm list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    29
     alpha_raw_induct : thm}
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    30
   
2890
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    31
end
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    32
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    33
structure Nominal_Dt_Data: NOMINAL_DT_DATA =
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    34
struct
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    35
2927
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    36
2890
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    37
(* information generated by nominal_datatype *)
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    38
type info =
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    39
   {inject : thm list,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    40
    distinct : thm list,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    41
    strong_inducts : thm list,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    42
    strong_exhaust : thm list}
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    43
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    44
structure NominalData = Generic_Data
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    45
 (type T = info Symtab.table
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    46
  val empty = Symtab.empty
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    47
  val extend = I
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    48
  val merge = Symtab.merge (K true))
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    49
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    50
val get_all_info = Symtab.dest o NominalData.get o Context.Proof
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    51
val get_info = Symtab.lookup o NominalData.get o Context.Proof
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    52
val register_info = NominalData.map o Symtab.update
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    53
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    54
fun the_info thy name =
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    55
  (case get_info thy name of
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    56
    SOME info => info
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    57
  | NONE => error ("Unknown nominal datatype " ^ quote name))
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    58
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    59
fun mk_infos ty_names inject distinct strong_inducts strong_exhaust =
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    60
let
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    61
  fun aux ty_name =
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    62
    (ty_name, {inject = inject,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    63
               distinct = distinct,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    64
               strong_inducts = strong_inducts,
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    65
               strong_exhaust = strong_exhaust 
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    66
              })
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    67
in
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    68
  map aux ty_names
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    69
end
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    70
2927
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    71
datatype alpha_result = AlphaResult of
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    72
  {alpha_names      : string list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    73
   alpha_trms       : term list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    74
   alpha_tys        : typ list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    75
   alpha_bn_names   : string list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    76
   alpha_bn_trms    : term list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    77
   alpha_bn_tys     : typ list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    78
   alpha_intros     : thm list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    79
   alpha_cases      : thm list,
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    80
   alpha_raw_induct : thm}
116f9ba4f59f combined distributed data for alpha in alpha_result (partially done)
Christian Urban <urbanc@in.tum.de>
parents: 2890
diff changeset
    81
2890
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    82
503630c553a8 added file
Christian Urban <urbanc@in.tum.de>
parents:
diff changeset
    83
end