src/HOL/thy_data.ML
changeset 4259 adbe3f4e7caf
parent 4150 56025371fc02
child 4329 9d99bfdd7441
equal deleted inserted replaced
4258:f2ca5a87f0a7 4259:adbe3f4e7caf
     6 *)
     6 *)
     7 
     7 
     8 (*for records*)
     8 (*for records*)
     9 type record_info =
     9 type record_info =
    10  {parent: string option,
    10  {parent: string option,
    11   fields: (string * ctyp) list};
    11   fields: (string * typ) list};
    12 
    12 
    13 (*for datatypes*)
    13 (*for datatypes*)
    14 type datatype_info =
    14 type datatype_info =
    15  {case_const: term,
    15  {case_const: term,
    16   case_rewrites: thm list,
    16   case_rewrites: thm list,
    28   val put_records: record_info Symtab.table -> theory -> theory;
    28   val put_records: record_info Symtab.table -> theory -> theory;
    29   val get_datatypes_sg: Sign.sg -> datatype_info Symtab.table
    29   val get_datatypes_sg: Sign.sg -> datatype_info Symtab.table
    30   val get_datatypes: theory -> datatype_info Symtab.table
    30   val get_datatypes: theory -> datatype_info Symtab.table
    31   val put_datatypes: datatype_info Symtab.table -> theory -> theory
    31   val put_datatypes: datatype_info Symtab.table -> theory -> theory
    32   val hol_data: (string * (object * (object -> object) *
    32   val hol_data: (string * (object * (object -> object) *
    33     (object * object -> object) * (object -> unit))) list
    33     (object * object -> object) * (Sign.sg -> object -> unit))) list
    34 end;
    34 end;
    35 
    35 
    36 structure ThyData: THY_DATA =
    36 structure ThyData: THY_DATA =
    37 struct
    37 struct
    38 
    38 
    50   fun prep_ext (x as DatatypeInfo _) = x;
    50   fun prep_ext (x as DatatypeInfo _) = x;
    51 
    51 
    52   fun merge (DatatypeInfo tab1, DatatypeInfo tab2) =
    52   fun merge (DatatypeInfo tab1, DatatypeInfo tab2) =
    53     DatatypeInfo (Symtab.merge (K true) (tab1, tab2));
    53     DatatypeInfo (Symtab.merge (K true) (tab1, tab2));
    54 
    54 
    55   fun print (DatatypeInfo tab) =
    55   fun print sg (DatatypeInfo tab) =
    56     Pretty.writeln (Pretty.strs ("datatypes:" :: map fst (Symtab.dest tab)));
    56     Pretty.writeln (Pretty.strs ("datatypes:" ::
       
    57       map (Sign.cond_extern sg Sign.typeK o fst) (Symtab.dest tab)));
    57 in
    58 in
    58   val datatypes_thy_data = (datatypesK, (empty, prep_ext, merge, print));
    59   val datatypes_thy_data = (datatypesK, (empty, prep_ext, merge, print));
    59 end;
    60 end;
    60 
    61 
    61 
    62 
    89   fun prep_ext (x as Records _) = x;
    90   fun prep_ext (x as Records _) = x;
    90 
    91 
    91   fun merge (Records tab1, Records tab2) =
    92   fun merge (Records tab1, Records tab2) =
    92     Records (Symtab.merge (K true) (tab1, tab2));
    93     Records (Symtab.merge (K true) (tab1, tab2));
    93 
    94 
    94   fun print (Records tab) =
    95   fun print sg (Records tab) =
    95     let
    96     let
    96       fun pretty_parent None = []
    97       fun pretty_parent None = []
    97         | pretty_parent (Some name) = [Pretty.str (name ^ " +")];
    98         | pretty_parent (Some name) =
       
    99             [Pretty.str (Sign.cond_extern sg Sign.typeK name ^ " +")];
    98 
   100 
    99       fun pretty_field (c, T) = Pretty.block
   101       fun pretty_field (c, T) = Pretty.block
   100         [Pretty.str (c ^ " :: "), Pretty.brk 1, Pretty.quote (Display.pretty_ctyp T)];
   102         [Pretty.str (Sign.cond_extern sg Sign.constK c ^ " :: "),
       
   103           Pretty.brk 1, Pretty.quote (Sign.pretty_typ sg T)];
   101 
   104 
   102       fun pretty_record (name, {parent, fields}) =
   105       fun pretty_record (name, {parent, fields}) =
   103         Pretty.big_list (name ^ " =") (pretty_parent parent @ map pretty_field fields);
   106         Pretty.big_list (name ^ " =") (pretty_parent parent @ map pretty_field fields);
   104     in
   107     in
   105       seq (Pretty.writeln o pretty_record) (Symtab.dest tab)
   108       seq (Pretty.writeln o pretty_record) (Symtab.dest tab)
   122 
   125 
   123 
   126 
   124 (** hol_data **)
   127 (** hol_data **)
   125 
   128 
   126 val hol_data =
   129 val hol_data =
   127  [Simplifier.simpset_thy_data,          (*see Provers/simplifier.ML*)
   130  [Simplifier.simpset_thy_data,
   128   ClasetThyData.thy_data,               (*see Provers/classical.ML*)
   131   ClasetThyData.thy_data,
   129   datatypes_thy_data,
   132   datatypes_thy_data,
   130   record_thy_data];
   133   record_thy_data];
   131 
   134 
   132 
   135 
   133 end;
   136 end;