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) |