author | wenzelm |
Fri, 21 Sep 2018 17:48:39 +0200 | |
changeset 69027 | 5ea3f424e787 |
parent 69023 | cef000855cf4 |
child 69028 | f440bedb8e45 |
permissions | -rw-r--r-- |
68154 | 1 |
(* Title: Pure/Thy/export_theory.ML |
2 |
Author: Makarius |
|
3 |
||
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
4 |
Export foundational theory content and locale/class structure. |
68154 | 5 |
*) |
6 |
||
7 |
signature EXPORT_THEORY = |
|
8 |
sig |
|
68201 | 9 |
val setup_presentation: (Thy_Info.presentation_context -> theory -> unit) -> unit |
10 |
val export_body: theory -> string -> XML.body -> unit |
|
68154 | 11 |
end; |
12 |
||
13 |
structure Export_Theory: EXPORT_THEORY = |
|
14 |
struct |
|
15 |
||
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
16 |
(* standardization of variables: only frees and named bounds *) |
68725 | 17 |
|
18 |
local |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
19 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
20 |
fun declare_names (Abs (_, _, b)) = declare_names b |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
21 |
| declare_names (t $ u) = declare_names t #> declare_names u |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
22 |
| declare_names (Const (c, _)) = Name.declare (Long_Name.base_name c) |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
23 |
| declare_names (Free (x, _)) = Name.declare x |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
24 |
| declare_names _ = I; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
25 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
26 |
fun variant_abs bs (Abs (x, T, t)) = |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
27 |
let |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
28 |
val names = fold Name.declare bs (declare_names t Name.context); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
29 |
val x' = #1 (Name.variant x names); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
30 |
val t' = variant_abs (x' :: bs) t; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
31 |
in Abs (x', T, t') end |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
32 |
| variant_abs bs (t $ u) = variant_abs bs t $ variant_abs bs u |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
33 |
| variant_abs _ t = t; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
34 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
35 |
in |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
36 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
37 |
fun standard_vars used = |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
38 |
let |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
39 |
fun zero_var_indexes tm = |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
40 |
Term_Subst.instantiate (Term_Subst.zero_var_indexes_inst used [tm]) tm; |
68725 | 41 |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
42 |
fun unvarifyT ty = ty |> Term.map_atyps |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
43 |
(fn TVar ((a, _), S) => TFree (a, S) |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
44 |
| T as TFree (a, _) => |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
45 |
if Name.is_declared used a then T |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
46 |
else raise TYPE (Logic.bad_fixed a, [ty], [])); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
47 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
48 |
fun unvarify tm = tm |> Term.map_aterms |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
49 |
(fn Var ((x, _), T) => Free (x, T) |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
50 |
| t as Free (x, _) => |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
51 |
if Name.is_declared used x then t |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
52 |
else raise TERM (Logic.bad_fixed x, [tm]) |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
53 |
| t => t); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
54 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
55 |
in zero_var_indexes #> map_types unvarifyT #> unvarify #> variant_abs [] end; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
56 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
57 |
val standard_vars_global = standard_vars Name.context; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
58 |
|
68725 | 59 |
end; |
60 |
||
61 |
||
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
62 |
(* free variables: not declared in the context *) |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
63 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
64 |
val is_free = not oo Name.is_declared; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
65 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
66 |
fun add_frees used = |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
67 |
fold_aterms (fn Free (x, T) => is_free used x ? insert (op =) (x, T) | _ => I); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
68 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
69 |
fun add_tfrees used = |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
70 |
(fold_types o fold_atyps) (fn TFree (a, S) => is_free used a ? insert (op =) (a, S) | _ => I); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
71 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
72 |
|
69019 | 73 |
(* locale support *) |
74 |
||
75 |
fun locale_axioms thy loc = |
|
76 |
let |
|
77 |
val (intro1, intro2) = Locale.intros_of thy loc; |
|
78 |
fun intros_tac ctxt = Method.try_intros_tac ctxt (the_list intro1 @ the_list intro2); |
|
79 |
val res = |
|
80 |
Proof_Context.init_global thy |
|
81 |
|> Interpretation.interpretation ([(loc, (("", false), (Expression.Named [], [])))], []) |
|
82 |
|> Proof.refine (Method.Basic (METHOD o intros_tac)) |
|
83 |
|> Seq.filter_results |
|
84 |
|> try Seq.hd; |
|
85 |
in |
|
86 |
(case res of |
|
87 |
SOME st => Thm.prems_of (#goal (Proof.goal st)) |
|
88 |
| NONE => raise Fail ("Cannot unfold locale " ^ quote loc)) |
|
89 |
end; |
|
90 |
||
91 |
||
68201 | 92 |
(* general setup *) |
68154 | 93 |
|
68201 | 94 |
fun setup_presentation f = |
95 |
Theory.setup (Thy_Info.add_presentation (fn context => fn thy => |
|
96 |
if Options.bool (#options context) "export_theory" then f context thy else ())); |
|
68154 | 97 |
|
68201 | 98 |
fun export_body thy name body = |
68230 | 99 |
Export.export thy ("theory/" ^ name) (Buffer.chunks (YXML.buffer_body body Buffer.empty)); |
68165 | 100 |
|
68154 | 101 |
|
68201 | 102 |
(* presentation *) |
103 |
||
104 |
val _ = setup_presentation (fn {adjust_pos, ...} => fn thy => |
|
105 |
let |
|
68900
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
106 |
val parents = Theory.parents_of thy; |
68264 | 107 |
val rep_tsig = Type.rep_tsig (Sign.tsig_of thy); |
108 |
||
69003 | 109 |
val thy_ctxt = Proof_Context.init_global thy; |
68997 | 110 |
|
68264 | 111 |
|
68201 | 112 |
(* entities *) |
68154 | 113 |
|
68201 | 114 |
fun entity_markup space name = |
115 |
let |
|
69003 | 116 |
val xname = Name_Space.extern_shortest thy_ctxt space name; |
68201 | 117 |
val {serial, pos, ...} = Name_Space.the_entry space name; |
118 |
val props = |
|
68830
44ec6fdaacf8
retain original id, which is command_id/exec_id for PIDE;
wenzelm
parents:
68727
diff
changeset
|
119 |
Position.offset_properties_of (adjust_pos pos) @ |
44ec6fdaacf8
retain original id, which is command_id/exec_id for PIDE;
wenzelm
parents:
68727
diff
changeset
|
120 |
Position.id_properties_of pos @ |
44ec6fdaacf8
retain original id, which is command_id/exec_id for PIDE;
wenzelm
parents:
68727
diff
changeset
|
121 |
Markup.serial_properties serial; |
68997 | 122 |
in (Markup.entityN, (Markup.nameN, name) :: (Markup.xnameN, xname) :: props) end; |
68154 | 123 |
|
68201 | 124 |
fun export_entities export_name export get_space decls = |
125 |
let val elems = |
|
126 |
let |
|
68206 | 127 |
val parent_spaces = map get_space parents; |
68201 | 128 |
val space = get_space thy; |
129 |
in |
|
130 |
(decls, []) |-> fold (fn (name, decl) => |
|
131 |
if exists (fn space => Name_Space.declared space name) parent_spaces then I |
|
132 |
else |
|
133 |
(case export name decl of |
|
134 |
NONE => I |
|
68724 | 135 |
| SOME body => |
136 |
cons (#serial (Name_Space.the_entry space name), |
|
137 |
XML.Elem (entity_markup space name, body)))) |
|
138 |
|> sort (int_ord o apply2 #1) |> map #2 |
|
68201 | 139 |
end; |
140 |
in if null elems then () else export_body thy export_name elems end; |
|
68165 | 141 |
|
142 |
||
69003 | 143 |
(* infix syntax *) |
144 |
||
145 |
fun get_infix_const ctxt = Syntax.get_infix (Proof_Context.syn_of ctxt) o Lexicon.mark_const; |
|
146 |
fun get_infix_type ctxt = Syntax.get_infix (Proof_Context.syn_of ctxt) o Lexicon.mark_type; |
|
147 |
||
148 |
fun encode_infix {assoc, delim, pri} = |
|
149 |
let |
|
150 |
val ass = |
|
151 |
(case assoc of |
|
152 |
Syntax_Ext.No_Assoc => 0 |
|
153 |
| Syntax_Ext.Left_Assoc => 1 |
|
154 |
| Syntax_Ext.Right_Assoc => 2); |
|
155 |
open XML.Encode Term_XML.Encode; |
|
156 |
in triple int string int (ass, delim, pri) end; |
|
157 |
||
158 |
||
68201 | 159 |
(* types *) |
68165 | 160 |
|
68201 | 161 |
val encode_type = |
162 |
let open XML.Encode Term_XML.Encode |
|
69003 | 163 |
in triple (option encode_infix) (list string) (option typ) end; |
68165 | 164 |
|
69003 | 165 |
fun export_type c (Type.LogicalType n) = |
166 |
SOME (encode_type (get_infix_type thy_ctxt c, Name.invent Name.context Name.aT n, NONE)) |
|
167 |
| export_type c (Type.Abbreviation (args, U, false)) = |
|
168 |
SOME (encode_type (get_infix_type thy_ctxt c, args, SOME U)) |
|
169 |
| export_type _ _ = NONE; |
|
68165 | 170 |
|
68201 | 171 |
val _ = |
69003 | 172 |
export_entities "types" export_type Sign.type_space |
68264 | 173 |
(Name_Space.dest_table (#types rep_tsig)); |
68201 | 174 |
|
68173 | 175 |
|
68201 | 176 |
(* consts *) |
177 |
||
178 |
val encode_const = |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
179 |
let open XML.Encode Term_XML.Encode |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
180 |
in pair (option encode_infix) (pair (list string) (pair typ (option term))) end; |
68165 | 181 |
|
68201 | 182 |
fun export_const c (T, abbrev) = |
183 |
let |
|
69003 | 184 |
val syntax = get_infix_const thy_ctxt c; |
68201 | 185 |
val T' = T |> Logic.unvarifyT_global |> Type.strip_sorts; |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
186 |
val abbrev' = abbrev |> Option.map (standard_vars_global #> map_types Type.strip_sorts); |
68201 | 187 |
val args = map (#1 o dest_TFree) (Consts.typargs (Sign.consts_of thy) (c, T')); |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
188 |
in encode_const (syntax, (args, (T', abbrev'))) end; |
68165 | 189 |
|
68201 | 190 |
val _ = |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
191 |
export_entities "consts" (SOME oo export_const) Sign.const_space |
68201 | 192 |
(#constants (Consts.dest (Sign.consts_of thy))); |
193 |
||
68208 | 194 |
|
68232 | 195 |
(* axioms and facts *) |
68208 | 196 |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
197 |
fun prop_of raw_thm = |
68727 | 198 |
let |
199 |
val thm = raw_thm |
|
200 |
|> Thm.transfer thy |
|
201 |
|> Thm.check_hyps (Context.Theory thy) |
|
202 |
|> Thm.strip_shyps; |
|
203 |
val prop = thm |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
204 |
|> Thm.full_prop_of; |
68727 | 205 |
in (Thm.extra_shyps thm, prop) end; |
68539 | 206 |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
207 |
fun encode_prop used (Ss, raw_prop) = |
68208 | 208 |
let |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
209 |
val prop = standard_vars used raw_prop; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
210 |
val args = rev (add_frees used prop []); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
211 |
val typargs = rev (add_tfrees used prop []); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
212 |
val used' = fold (Name.declare o #1) typargs used; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
213 |
val sorts = Name.invent used' Name.aT (length Ss) ~~ Ss; |
68726 | 214 |
in |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
215 |
(sorts @ typargs, args, prop) |> |
68727 | 216 |
let open XML.Encode Term_XML.Encode |
217 |
in triple (list (pair string sort)) (list (pair string typ)) term end |
|
68726 | 218 |
end; |
68208 | 219 |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
220 |
fun encode_axiom used t = encode_prop used ([], t); |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
221 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
222 |
val encode_fact_single = encode_prop Name.context o prop_of; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
223 |
val encode_fact_multi = XML.Encode.list (encode_prop Name.context) o map prop_of; |
68208 | 224 |
|
68232 | 225 |
val _ = |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
226 |
export_entities "axioms" (fn _ => fn t => SOME (encode_axiom Name.context t)) |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
227 |
Theory.axiom_space (Theory.axioms_of thy); |
68235
a3bd410db5b2
standardize implicit variables: non-zero indexes do occur occasionally, e.g. via RS;
wenzelm
parents:
68232
diff
changeset
|
228 |
val _ = |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
229 |
export_entities "facts" (K (SOME o encode_fact_multi)) |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
230 |
(Facts.space_of o Global_Theory.facts_of) |
68232 | 231 |
(Facts.dest_static true [] (Global_Theory.facts_of thy)); |
232 |
||
68264 | 233 |
|
234 |
(* type classes *) |
|
235 |
||
236 |
val encode_class = |
|
237 |
let open XML.Encode Term_XML.Encode |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
238 |
in pair (list (pair string typ)) (list encode_fact_single) end; |
68264 | 239 |
|
240 |
fun export_class name = |
|
241 |
(case try (Axclass.get_info thy) name of |
|
242 |
NONE => ([], []) |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
243 |
| SOME {params, axioms, ...} => (params, axioms)) |
68264 | 244 |
|> encode_class |> SOME; |
245 |
||
246 |
val _ = |
|
247 |
export_entities "classes" (fn name => fn () => export_class name) |
|
248 |
Sign.class_space (map (rpair ()) (Graph.keys (Sorts.classes_of (#2 (#classes rep_tsig))))); |
|
249 |
||
68295 | 250 |
|
251 |
(* sort algebra *) |
|
252 |
||
253 |
val {classrel, arities} = |
|
254 |
Sorts.dest_algebra (map (#2 o #classes o Type.rep_tsig o Sign.tsig_of) parents) |
|
255 |
(#2 (#classes rep_tsig)); |
|
256 |
||
257 |
val encode_classrel = |
|
258 |
let open XML.Encode |
|
259 |
in list (pair string (list string)) end; |
|
260 |
||
261 |
val encode_arities = |
|
262 |
let open XML.Encode Term_XML.Encode |
|
263 |
in list (triple string (list sort) string) end; |
|
264 |
||
265 |
val _ = if null classrel then () else export_body thy "classrel" (encode_classrel classrel); |
|
266 |
val _ = if null arities then () else export_body thy "arities" (encode_arities arities); |
|
267 |
||
68862 | 268 |
|
269 |
(* locales *) |
|
270 |
||
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
271 |
fun encode_locale used = |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
272 |
let open XML.Encode Term_XML.Encode |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
273 |
in triple (list (pair string sort)) (list (pair string typ)) (list (encode_axiom used)) end; |
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
274 |
|
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
275 |
fun export_locale loc ({type_params, params, ...}: Locale.content) = |
68864 | 276 |
let |
69019 | 277 |
val axioms = locale_axioms thy loc; |
68864 | 278 |
val args = map #1 params; |
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
279 |
val typargs = rev (fold Term.add_tfrees (map Free args @ axioms) (rev type_params)); |
69027 | 280 |
val _ = |
281 |
(case duplicates (eq_fst op =) typargs of |
|
282 |
[] => () |
|
283 |
| dups => |
|
284 |
let val print = Syntax.string_of_typ (Config.put show_sorts true thy_ctxt) o TFree |
|
285 |
in error ("Duplicate type parameters " ^ commas (map print dups)) end); |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
286 |
val used = fold Name.declare (map #1 typargs @ map #1 args) Name.context; |
69027 | 287 |
in encode_locale used (typargs, args, axioms) end |
288 |
handle ERROR msg => |
|
289 |
cat_error msg ("The error(s) above occurred in locale " ^ |
|
290 |
quote (Locale.markup_name thy_ctxt loc)); |
|
68862 | 291 |
|
292 |
val _ = |
|
69023
cef000855cf4
clarified standardization of variables, with proper treatment of local variables;
wenzelm
parents:
69019
diff
changeset
|
293 |
export_entities "locales" (SOME oo export_locale) Locale.locale_space |
68862 | 294 |
(Locale.dest_locales thy); |
295 |
||
68900
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
296 |
|
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
297 |
(* parents *) |
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
298 |
|
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
299 |
val _ = |
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
300 |
export_body thy "parents" |
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
301 |
(XML.Encode.string (cat_lines (map Context.theory_long_name parents))); |
1145b25c53de
more robust: parents are strict in Export_Theory.read_theory and thus approximate "commit" of exports;
wenzelm
parents:
68864
diff
changeset
|
302 |
|
68295 | 303 |
in () end); |
68165 | 304 |
|
305 |
end; |