skalberg@14620
|
1 |
(* Title: HOL/Import/hol4rews.ML
|
skalberg@14620
|
2 |
ID: $Id$
|
skalberg@14620
|
3 |
Author: Sebastian Skalberg (TU Muenchen)
|
skalberg@14620
|
4 |
*)
|
skalberg@14620
|
5 |
|
skalberg@14516
|
6 |
structure StringPair = TableFun(type key = string * string val ord = prod_ord string_ord string_ord);
|
skalberg@14516
|
7 |
|
skalberg@14516
|
8 |
type holthm = (term * term) list * thm
|
skalberg@14516
|
9 |
|
skalberg@14516
|
10 |
datatype ImportStatus =
|
skalberg@14516
|
11 |
NoImport
|
skalberg@14516
|
12 |
| Generating of string
|
skalberg@14516
|
13 |
| Replaying of string
|
skalberg@14516
|
14 |
|
skalberg@14516
|
15 |
structure HOL4DefThyArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
16 |
struct
|
skalberg@14516
|
17 |
val name = "HOL4/import_status"
|
skalberg@14516
|
18 |
type T = ImportStatus
|
skalberg@14516
|
19 |
val empty = NoImport
|
skalberg@14516
|
20 |
val copy = I
|
skalberg@14516
|
21 |
val prep_ext = I
|
skalberg@14516
|
22 |
fun merge (NoImport,NoImport) = NoImport
|
skalberg@14516
|
23 |
| merge _ = (warning "Import status set during merge"; NoImport)
|
skalberg@14516
|
24 |
fun print sg import_status =
|
skalberg@14516
|
25 |
Pretty.writeln (Pretty.str (case import_status of NoImport => "No current import" | Generating thyname => ("Generating " ^ thyname) | Replaying thyname => ("Replaying " ^ thyname)))
|
skalberg@14516
|
26 |
end;
|
skalberg@14516
|
27 |
|
skalberg@14516
|
28 |
structure HOL4DefThy = TheoryDataFun(HOL4DefThyArgs);
|
skalberg@14516
|
29 |
|
skalberg@14516
|
30 |
structure ImportSegmentArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
31 |
struct
|
skalberg@14620
|
32 |
val name = "HOL4/import_segment"
|
skalberg@14516
|
33 |
type T = string
|
skalberg@14516
|
34 |
val empty = ""
|
skalberg@14516
|
35 |
val copy = I
|
skalberg@14516
|
36 |
val prep_ext = I
|
skalberg@14516
|
37 |
fun merge ("",arg) = arg
|
skalberg@14516
|
38 |
| merge (arg,"") = arg
|
skalberg@14516
|
39 |
| merge (s1,s2) =
|
skalberg@14516
|
40 |
if s1 = s2
|
skalberg@14516
|
41 |
then s1
|
skalberg@14516
|
42 |
else error "Trying to merge two different import segments"
|
skalberg@14516
|
43 |
fun print sg import_segment =
|
skalberg@14516
|
44 |
Pretty.writeln (Pretty.str ("Import segment: " ^ import_segment))
|
skalberg@14516
|
45 |
end;
|
skalberg@14516
|
46 |
|
skalberg@14516
|
47 |
structure ImportSegment = TheoryDataFun(ImportSegmentArgs);
|
skalberg@14516
|
48 |
|
skalberg@14516
|
49 |
val get_import_segment = ImportSegment.get
|
skalberg@14516
|
50 |
val set_import_segment = ImportSegment.put
|
skalberg@14516
|
51 |
|
skalberg@14516
|
52 |
structure HOL4UNamesArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
53 |
struct
|
skalberg@14516
|
54 |
val name = "HOL4/used_names"
|
skalberg@14516
|
55 |
type T = string list
|
skalberg@14516
|
56 |
val empty = []
|
skalberg@14516
|
57 |
val copy = I
|
skalberg@14516
|
58 |
val prep_ext = I
|
skalberg@14516
|
59 |
fun merge ([],[]) = []
|
skalberg@14516
|
60 |
| merge _ = error "Used names not empty during merge"
|
skalberg@14516
|
61 |
fun print sg used_names =
|
skalberg@14516
|
62 |
Pretty.writeln (Pretty.str "Printing of HOL4/used_names Not implemented")
|
skalberg@14516
|
63 |
end;
|
skalberg@14516
|
64 |
|
skalberg@14516
|
65 |
structure HOL4UNames = TheoryDataFun(HOL4UNamesArgs);
|
skalberg@14516
|
66 |
|
skalberg@14516
|
67 |
structure HOL4DumpArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
68 |
struct
|
skalberg@14516
|
69 |
val name = "HOL4/dump_data"
|
skalberg@14516
|
70 |
type T = string * string * string list
|
skalberg@14516
|
71 |
val empty = ("","",[])
|
skalberg@14516
|
72 |
val copy = I
|
skalberg@14516
|
73 |
val prep_ext = I
|
skalberg@14516
|
74 |
fun merge (("","",[]),("","",[])) = ("","",[])
|
skalberg@14516
|
75 |
| merge _ = error "Dump data not empty during merge"
|
skalberg@14516
|
76 |
fun print sg dump_data =
|
skalberg@14516
|
77 |
Pretty.writeln (Pretty.str "Printing of HOL4/dump_data Not implemented")
|
skalberg@14516
|
78 |
end;
|
skalberg@14516
|
79 |
|
skalberg@14516
|
80 |
structure HOL4Dump = TheoryDataFun(HOL4DumpArgs);
|
skalberg@14516
|
81 |
|
skalberg@14516
|
82 |
structure HOL4MovesArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
83 |
struct
|
skalberg@14516
|
84 |
val name = "HOL4/moves"
|
skalberg@14516
|
85 |
type T = string Symtab.table
|
skalberg@14516
|
86 |
val empty = Symtab.empty
|
skalberg@14516
|
87 |
val copy = I
|
skalberg@14516
|
88 |
val prep_ext = I
|
skalberg@14518
|
89 |
val merge : T * T -> T = Symtab.merge (K true)
|
skalberg@14516
|
90 |
fun print sg tab =
|
skalberg@14516
|
91 |
Pretty.writeln (Pretty.big_list "HOL4 moves:"
|
skalberg@14516
|
92 |
(Symtab.foldl (fn (xl,(bef,aft)) => (Pretty.str (bef ^ " --> " ^ aft)::xl)) ([],tab)))
|
skalberg@14516
|
93 |
end;
|
skalberg@14516
|
94 |
|
skalberg@14516
|
95 |
structure HOL4Moves = TheoryDataFun(HOL4MovesArgs);
|
skalberg@14516
|
96 |
|
skalberg@14516
|
97 |
structure HOL4ImportsArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
98 |
struct
|
skalberg@14516
|
99 |
val name = "HOL4/imports"
|
skalberg@14516
|
100 |
type T = string Symtab.table
|
skalberg@14516
|
101 |
val empty = Symtab.empty
|
skalberg@14516
|
102 |
val copy = I
|
skalberg@14516
|
103 |
val prep_ext = I
|
skalberg@14518
|
104 |
val merge : T * T -> T = Symtab.merge (K true)
|
skalberg@14516
|
105 |
fun print sg tab =
|
skalberg@14516
|
106 |
Pretty.writeln (Pretty.big_list "HOL4 imports:"
|
skalberg@14516
|
107 |
(Symtab.foldl (fn (xl,(thyname,segname)) => (Pretty.str (thyname ^ " imported from segment " ^ segname)::xl)) ([],tab)))
|
skalberg@14516
|
108 |
end;
|
skalberg@14516
|
109 |
|
skalberg@14516
|
110 |
structure HOL4Imports = TheoryDataFun(HOL4ImportsArgs);
|
skalberg@14516
|
111 |
|
skalberg@14516
|
112 |
fun get_segment2 thyname thy =
|
skalberg@14516
|
113 |
let
|
skalberg@14516
|
114 |
val imps = HOL4Imports.get thy
|
skalberg@14516
|
115 |
in
|
skalberg@14516
|
116 |
Symtab.lookup(imps,thyname)
|
skalberg@14516
|
117 |
end
|
skalberg@14516
|
118 |
|
skalberg@14516
|
119 |
fun set_segment thyname segname thy =
|
skalberg@14516
|
120 |
let
|
skalberg@14516
|
121 |
val imps = HOL4Imports.get thy
|
skalberg@14516
|
122 |
val imps' = Symtab.update_new((thyname,segname),imps)
|
skalberg@14516
|
123 |
in
|
skalberg@14516
|
124 |
HOL4Imports.put imps' thy
|
skalberg@14516
|
125 |
end
|
skalberg@14516
|
126 |
|
skalberg@14516
|
127 |
structure HOL4CMovesArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
128 |
struct
|
skalberg@14516
|
129 |
val name = "HOL4/constant_moves"
|
skalberg@14516
|
130 |
type T = string Symtab.table
|
skalberg@14516
|
131 |
val empty = Symtab.empty
|
skalberg@14516
|
132 |
val copy = I
|
skalberg@14516
|
133 |
val prep_ext = I
|
skalberg@14518
|
134 |
val merge : T * T -> T = Symtab.merge (K true)
|
skalberg@14516
|
135 |
fun print sg tab =
|
skalberg@14516
|
136 |
Pretty.writeln (Pretty.big_list "HOL4 constant moves:"
|
skalberg@14516
|
137 |
(Symtab.foldl (fn (xl,(bef,aft)) => (Pretty.str (bef ^ " --> " ^ aft)::xl)) ([],tab)))
|
skalberg@14516
|
138 |
end;
|
skalberg@14516
|
139 |
|
skalberg@14516
|
140 |
structure HOL4CMoves = TheoryDataFun(HOL4CMovesArgs);
|
skalberg@14516
|
141 |
|
skalberg@14516
|
142 |
structure HOL4MapsArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
143 |
struct
|
skalberg@14516
|
144 |
val name = "HOL4/mappings"
|
skalberg@14516
|
145 |
type T = (string option) StringPair.table
|
skalberg@14516
|
146 |
val empty = StringPair.empty
|
skalberg@14516
|
147 |
val copy = I
|
skalberg@14516
|
148 |
val prep_ext = I
|
skalberg@14518
|
149 |
val merge : T * T -> T = StringPair.merge (K true)
|
skalberg@14516
|
150 |
fun print sg tab =
|
skalberg@14516
|
151 |
Pretty.writeln (Pretty.big_list "HOL4 mappings:"
|
skalberg@15531
|
152 |
(StringPair.foldl (fn (xl,((bthy,bthm),isathm)) => (Pretty.str (bthy ^ "." ^ bthm ^ (case isathm of SOME th => " --> " ^ th | NONE => "IGNORED"))::xl)) ([],tab)))
|
skalberg@14516
|
153 |
end;
|
skalberg@14516
|
154 |
|
skalberg@14516
|
155 |
structure HOL4Maps = TheoryDataFun(HOL4MapsArgs);
|
skalberg@14516
|
156 |
|
skalberg@14516
|
157 |
structure HOL4ThmsArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
158 |
struct
|
skalberg@14516
|
159 |
val name = "HOL4/theorems"
|
skalberg@14516
|
160 |
type T = holthm StringPair.table
|
skalberg@14516
|
161 |
val empty = StringPair.empty
|
skalberg@14516
|
162 |
val copy = I
|
skalberg@14516
|
163 |
val prep_ext = I
|
skalberg@14518
|
164 |
val merge : T * T -> T = StringPair.merge (K true)
|
skalberg@14516
|
165 |
fun print sg tab =
|
skalberg@14516
|
166 |
Pretty.writeln (Pretty.big_list "HOL4 mappings:"
|
skalberg@14516
|
167 |
(StringPair.foldl (fn (xl,((bthy,bthm),(_,thm))) => (Pretty.str (bthy ^ "." ^ bthm ^ ":")::(Display.pretty_thm thm)::xl)) ([],tab)))
|
skalberg@14516
|
168 |
end;
|
skalberg@14516
|
169 |
|
skalberg@14516
|
170 |
structure HOL4Thms = TheoryDataFun(HOL4ThmsArgs);
|
skalberg@14516
|
171 |
|
skalberg@14516
|
172 |
structure HOL4ConstMapsArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
173 |
struct
|
skalberg@14516
|
174 |
val name = "HOL4/constmappings"
|
skalberg@14516
|
175 |
type T = (bool * string * typ option) StringPair.table
|
skalberg@14516
|
176 |
val empty = StringPair.empty
|
skalberg@14516
|
177 |
val copy = I
|
skalberg@14516
|
178 |
val prep_ext = I
|
skalberg@14518
|
179 |
val merge : T * T -> T = StringPair.merge (K true)
|
skalberg@14516
|
180 |
fun print sg tab =
|
skalberg@14516
|
181 |
Pretty.writeln (Pretty.big_list "HOL4 constant mappings:"
|
skalberg@14516
|
182 |
(StringPair.foldl (fn (xl,((bthy,bconst),(internal,isaconst,_))) => (Pretty.str (bthy ^ "." ^ bconst ^ " --> " ^ isaconst ^ (if internal then " (*)" else ""))::xl)) ([],tab)))
|
skalberg@14516
|
183 |
end;
|
skalberg@14516
|
184 |
|
skalberg@14516
|
185 |
structure HOL4ConstMaps = TheoryDataFun(HOL4ConstMapsArgs);
|
skalberg@14516
|
186 |
|
skalberg@14516
|
187 |
structure HOL4RenameArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
188 |
struct
|
skalberg@14516
|
189 |
val name = "HOL4/renamings"
|
skalberg@14516
|
190 |
type T = string StringPair.table
|
skalberg@14516
|
191 |
val empty = StringPair.empty
|
skalberg@14516
|
192 |
val copy = I
|
skalberg@14516
|
193 |
val prep_ext = I
|
skalberg@14518
|
194 |
val merge : T * T -> T = StringPair.merge (K true)
|
skalberg@14516
|
195 |
fun print sg tab =
|
skalberg@14516
|
196 |
Pretty.writeln (Pretty.big_list "HOL4 constant renamings:"
|
skalberg@14516
|
197 |
(StringPair.foldl (fn (xl,((bthy,bconst),newname)) => (Pretty.str (bthy ^ "." ^ bconst ^ " --> " ^ newname)::xl)) ([],tab)))
|
skalberg@14516
|
198 |
end;
|
skalberg@14516
|
199 |
|
skalberg@14516
|
200 |
structure HOL4Rename = TheoryDataFun(HOL4RenameArgs);
|
skalberg@14516
|
201 |
|
skalberg@14516
|
202 |
structure HOL4DefMapsArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
203 |
struct
|
skalberg@14516
|
204 |
val name = "HOL4/def_maps"
|
skalberg@14516
|
205 |
type T = string StringPair.table
|
skalberg@14516
|
206 |
val empty = StringPair.empty
|
skalberg@14516
|
207 |
val copy = I
|
skalberg@14516
|
208 |
val prep_ext = I
|
skalberg@14518
|
209 |
val merge : T * T -> T = StringPair.merge (K true)
|
skalberg@14516
|
210 |
fun print sg tab =
|
skalberg@14516
|
211 |
Pretty.writeln (Pretty.big_list "HOL4 constant definitions:"
|
skalberg@14516
|
212 |
(StringPair.foldl (fn (xl,((bthy,bconst),newname)) => (Pretty.str (bthy ^ "." ^ bconst ^ ": " ^ newname)::xl)) ([],tab)))
|
skalberg@14516
|
213 |
end;
|
skalberg@14516
|
214 |
|
skalberg@14516
|
215 |
structure HOL4DefMaps = TheoryDataFun(HOL4DefMapsArgs);
|
skalberg@14516
|
216 |
|
skalberg@14516
|
217 |
structure HOL4TypeMapsArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
218 |
struct
|
skalberg@14516
|
219 |
val name = "HOL4/typemappings"
|
skalberg@14516
|
220 |
type T = (bool * string) StringPair.table
|
skalberg@14516
|
221 |
val empty = StringPair.empty
|
skalberg@14516
|
222 |
val copy = I
|
skalberg@14516
|
223 |
val prep_ext = I
|
skalberg@14518
|
224 |
val merge : T * T -> T = StringPair.merge (K true)
|
skalberg@14516
|
225 |
fun print sg tab =
|
skalberg@14516
|
226 |
Pretty.writeln (Pretty.big_list "HOL4 type mappings:"
|
skalberg@14516
|
227 |
(StringPair.foldl (fn (xl,((bthy,bconst),(internal,isaconst))) => (Pretty.str (bthy ^ "." ^ bconst ^ " --> " ^ isaconst ^ (if internal then " (*)" else ""))::xl)) ([],tab)))
|
skalberg@14516
|
228 |
end;
|
skalberg@14516
|
229 |
|
skalberg@14516
|
230 |
structure HOL4TypeMaps = TheoryDataFun(HOL4TypeMapsArgs);
|
skalberg@14516
|
231 |
|
skalberg@14516
|
232 |
structure HOL4PendingArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
233 |
struct
|
skalberg@14516
|
234 |
val name = "HOL4/pending"
|
skalberg@14516
|
235 |
type T = ((term * term) list * thm) StringPair.table
|
skalberg@14516
|
236 |
val empty = StringPair.empty
|
skalberg@14516
|
237 |
val copy = I
|
skalberg@14516
|
238 |
val prep_ext = I
|
skalberg@14518
|
239 |
val merge : T * T -> T = StringPair.merge (K true)
|
skalberg@14516
|
240 |
fun print sg tab =
|
skalberg@14516
|
241 |
Pretty.writeln (Pretty.big_list "HOL4 pending theorems:"
|
skalberg@14516
|
242 |
(StringPair.foldl (fn (xl,((bthy,bthm),(_,th))) => (Pretty.chunks [Pretty.str (bthy ^ "." ^ bthm ^ ":"),Display.pretty_thm th]::xl)) ([],tab)))
|
skalberg@14516
|
243 |
end;
|
skalberg@14516
|
244 |
|
skalberg@14516
|
245 |
structure HOL4Pending = TheoryDataFun(HOL4PendingArgs);
|
skalberg@14516
|
246 |
|
skalberg@14516
|
247 |
structure HOL4RewritesArgs: THEORY_DATA_ARGS =
|
skalberg@14516
|
248 |
struct
|
skalberg@14516
|
249 |
val name = "HOL4/rewrites"
|
skalberg@14516
|
250 |
type T = thm list
|
skalberg@14516
|
251 |
val empty = []
|
skalberg@14516
|
252 |
val copy = I
|
skalberg@14516
|
253 |
val prep_ext = I
|
skalberg@14516
|
254 |
val merge = Library.gen_union Thm.eq_thm
|
skalberg@14516
|
255 |
fun print sg thms =
|
skalberg@14516
|
256 |
Pretty.writeln (Pretty.big_list "HOL4 rewrite rules:"
|
skalberg@14516
|
257 |
(map Display.pretty_thm thms))
|
skalberg@14516
|
258 |
end;
|
skalberg@14516
|
259 |
|
skalberg@14516
|
260 |
structure HOL4Rewrites = TheoryDataFun(HOL4RewritesArgs);
|
skalberg@14516
|
261 |
|
skalberg@14516
|
262 |
val hol4_debug = ref false
|
skalberg@14516
|
263 |
fun message s = if !hol4_debug then writeln s else ()
|
skalberg@14516
|
264 |
|
skalberg@14516
|
265 |
fun add_hol4_rewrite (thy,th) =
|
skalberg@14516
|
266 |
let
|
skalberg@14516
|
267 |
val _ = message "Adding HOL4 rewrite"
|
skalberg@14516
|
268 |
val th1 = th RS eq_reflection
|
skalberg@14516
|
269 |
val current_rews = HOL4Rewrites.get thy
|
skalberg@14516
|
270 |
val new_rews = gen_ins Thm.eq_thm (th1,current_rews)
|
skalberg@14516
|
271 |
val updated_thy = HOL4Rewrites.put new_rews thy
|
skalberg@14516
|
272 |
in
|
skalberg@14516
|
273 |
(updated_thy,th1)
|
skalberg@14516
|
274 |
end;
|
skalberg@14516
|
275 |
|
skalberg@14516
|
276 |
fun ignore_hol4 bthy bthm thy =
|
skalberg@14516
|
277 |
let
|
skalberg@14516
|
278 |
val _ = message ("Ignoring " ^ bthy ^ "." ^ bthm)
|
skalberg@14516
|
279 |
val curmaps = HOL4Maps.get thy
|
skalberg@15531
|
280 |
val newmaps = StringPair.update_new(((bthy,bthm),NONE),curmaps)
|
skalberg@14516
|
281 |
val upd_thy = HOL4Maps.put newmaps thy
|
skalberg@14516
|
282 |
in
|
skalberg@14516
|
283 |
upd_thy
|
skalberg@14516
|
284 |
end
|
skalberg@14516
|
285 |
|
skalberg@14516
|
286 |
val opt_get_output_thy = #2 o HOL4Dump.get
|
skalberg@14516
|
287 |
|
skalberg@14516
|
288 |
fun get_output_thy thy =
|
skalberg@14516
|
289 |
case #2 (HOL4Dump.get thy) of
|
skalberg@14516
|
290 |
"" => error "No theory file being output"
|
skalberg@14516
|
291 |
| thyname => thyname
|
skalberg@14516
|
292 |
|
skalberg@14516
|
293 |
val get_output_dir = #1 o HOL4Dump.get
|
skalberg@14516
|
294 |
|
skalberg@14516
|
295 |
fun add_hol4_move bef aft thy =
|
skalberg@14516
|
296 |
let
|
skalberg@14516
|
297 |
val curmoves = HOL4Moves.get thy
|
skalberg@14516
|
298 |
val newmoves = Symtab.update_new((bef,aft),curmoves)
|
skalberg@14516
|
299 |
in
|
skalberg@14516
|
300 |
HOL4Moves.put newmoves thy
|
skalberg@14516
|
301 |
end
|
skalberg@14516
|
302 |
|
skalberg@14516
|
303 |
fun get_hol4_move bef thy =
|
skalberg@14516
|
304 |
let
|
skalberg@14516
|
305 |
val moves = HOL4Moves.get thy
|
skalberg@14516
|
306 |
in
|
skalberg@14516
|
307 |
Symtab.lookup(moves,bef)
|
skalberg@14516
|
308 |
end
|
skalberg@14516
|
309 |
|
skalberg@14516
|
310 |
fun follow_name thmname thy =
|
skalberg@14516
|
311 |
let
|
skalberg@14516
|
312 |
val moves = HOL4Moves.get thy
|
skalberg@14516
|
313 |
fun F thmname =
|
skalberg@14516
|
314 |
case Symtab.lookup(moves,thmname) of
|
skalberg@15531
|
315 |
SOME name => F name
|
skalberg@15531
|
316 |
| NONE => thmname
|
skalberg@14516
|
317 |
in
|
skalberg@14516
|
318 |
F thmname
|
skalberg@14516
|
319 |
end
|
skalberg@14516
|
320 |
|
skalberg@14516
|
321 |
fun add_hol4_cmove bef aft thy =
|
skalberg@14516
|
322 |
let
|
skalberg@14516
|
323 |
val curmoves = HOL4CMoves.get thy
|
skalberg@14516
|
324 |
val newmoves = Symtab.update_new((bef,aft),curmoves)
|
skalberg@14516
|
325 |
in
|
skalberg@14516
|
326 |
HOL4CMoves.put newmoves thy
|
skalberg@14516
|
327 |
end
|
skalberg@14516
|
328 |
|
skalberg@14516
|
329 |
fun get_hol4_cmove bef thy =
|
skalberg@14516
|
330 |
let
|
skalberg@14516
|
331 |
val moves = HOL4CMoves.get thy
|
skalberg@14516
|
332 |
in
|
skalberg@14516
|
333 |
Symtab.lookup(moves,bef)
|
skalberg@14516
|
334 |
end
|
skalberg@14516
|
335 |
|
skalberg@14516
|
336 |
fun follow_cname thmname thy =
|
skalberg@14516
|
337 |
let
|
skalberg@14516
|
338 |
val moves = HOL4CMoves.get thy
|
skalberg@14516
|
339 |
fun F thmname =
|
skalberg@14516
|
340 |
case Symtab.lookup(moves,thmname) of
|
skalberg@15531
|
341 |
SOME name => F name
|
skalberg@15531
|
342 |
| NONE => thmname
|
skalberg@14516
|
343 |
in
|
skalberg@14516
|
344 |
F thmname
|
skalberg@14516
|
345 |
end
|
skalberg@14516
|
346 |
|
skalberg@14516
|
347 |
fun add_hol4_mapping bthy bthm isathm thy =
|
skalberg@14516
|
348 |
let
|
skalberg@14516
|
349 |
val isathm = follow_name isathm thy
|
skalberg@14516
|
350 |
val _ = message ("Adding theorem map: " ^ bthy ^ "." ^ bthm ^ " --> " ^ isathm)
|
skalberg@14516
|
351 |
val curmaps = HOL4Maps.get thy
|
skalberg@15531
|
352 |
val newmaps = StringPair.update_new(((bthy,bthm),SOME isathm),curmaps)
|
skalberg@14516
|
353 |
val upd_thy = HOL4Maps.put newmaps thy
|
skalberg@14516
|
354 |
in
|
skalberg@14516
|
355 |
upd_thy
|
skalberg@14516
|
356 |
end;
|
skalberg@14516
|
357 |
|
skalberg@14516
|
358 |
fun get_hol4_type_mapping bthy tycon thy =
|
skalberg@14516
|
359 |
let
|
skalberg@14516
|
360 |
val maps = HOL4TypeMaps.get thy
|
skalberg@14516
|
361 |
in
|
skalberg@14516
|
362 |
StringPair.lookup(maps,(bthy,tycon))
|
skalberg@14516
|
363 |
end
|
skalberg@14516
|
364 |
|
skalberg@14516
|
365 |
fun get_hol4_mapping bthy bthm thy =
|
skalberg@14516
|
366 |
let
|
skalberg@14516
|
367 |
val curmaps = HOL4Maps.get thy
|
skalberg@14516
|
368 |
in
|
skalberg@14516
|
369 |
StringPair.lookup(curmaps,(bthy,bthm))
|
skalberg@14516
|
370 |
end;
|
skalberg@14516
|
371 |
|
skalberg@14516
|
372 |
fun add_hol4_const_mapping bthy bconst internal isaconst thy =
|
skalberg@14516
|
373 |
let
|
skalberg@14516
|
374 |
val thy = case opt_get_output_thy thy of
|
skalberg@14516
|
375 |
"" => thy
|
skalberg@14516
|
376 |
| output_thy => if internal
|
skalberg@14516
|
377 |
then add_hol4_cmove (Sign.full_name (sign_of thy) bconst) (output_thy ^ "." ^ bthy ^ "." ^ bconst) thy
|
skalberg@14516
|
378 |
else thy
|
skalberg@14516
|
379 |
val _ = message ("Adding cmap " ^ bthy ^ "." ^ bconst ^ " -> " ^ isaconst ^ (if internal then " (*)" else ""))
|
skalberg@14516
|
380 |
val curmaps = HOL4ConstMaps.get thy
|
skalberg@15531
|
381 |
val newmaps = StringPair.update_new(((bthy,bconst),(internal,isaconst,NONE)),curmaps)
|
skalberg@14516
|
382 |
val upd_thy = HOL4ConstMaps.put newmaps thy
|
skalberg@14516
|
383 |
in
|
skalberg@14516
|
384 |
upd_thy
|
skalberg@14516
|
385 |
end;
|
skalberg@14516
|
386 |
|
skalberg@14516
|
387 |
fun add_hol4_const_renaming bthy bconst newname thy =
|
skalberg@14516
|
388 |
let
|
skalberg@14516
|
389 |
val currens = HOL4Rename.get thy
|
skalberg@14516
|
390 |
val _ = message ("Adding renaming " ^ bthy ^ "." ^ bconst ^ " -> " ^ newname)
|
skalberg@14516
|
391 |
val newrens = StringPair.update_new(((bthy,bconst),newname),currens)
|
skalberg@14516
|
392 |
val upd_thy = HOL4Rename.put newrens thy
|
skalberg@14516
|
393 |
in
|
skalberg@14516
|
394 |
upd_thy
|
skalberg@14516
|
395 |
end;
|
skalberg@14516
|
396 |
|
skalberg@14516
|
397 |
fun get_hol4_const_renaming bthy bconst thy =
|
skalberg@14516
|
398 |
let
|
skalberg@14516
|
399 |
val currens = HOL4Rename.get thy
|
skalberg@14516
|
400 |
in
|
skalberg@14516
|
401 |
StringPair.lookup(currens,(bthy,bconst))
|
skalberg@14516
|
402 |
end;
|
skalberg@14516
|
403 |
|
skalberg@14516
|
404 |
fun get_hol4_const_mapping bthy bconst thy =
|
skalberg@14516
|
405 |
let
|
skalberg@14516
|
406 |
val bconst = case get_hol4_const_renaming bthy bconst thy of
|
skalberg@15531
|
407 |
SOME name => name
|
skalberg@15531
|
408 |
| NONE => bconst
|
skalberg@14516
|
409 |
val maps = HOL4ConstMaps.get thy
|
skalberg@14516
|
410 |
in
|
skalberg@14516
|
411 |
StringPair.lookup(maps,(bthy,bconst))
|
skalberg@14516
|
412 |
end
|
skalberg@14516
|
413 |
|
skalberg@14516
|
414 |
fun add_hol4_const_wt_mapping bthy bconst internal isaconst typ thy =
|
skalberg@14516
|
415 |
let
|
skalberg@14516
|
416 |
val thy = case opt_get_output_thy thy of
|
skalberg@14516
|
417 |
"" => thy
|
skalberg@14516
|
418 |
| output_thy => if internal
|
skalberg@14516
|
419 |
then add_hol4_cmove (Sign.full_name (sign_of thy) bconst) (output_thy ^ "." ^ bthy ^ "." ^ bconst) thy
|
skalberg@14516
|
420 |
else thy
|
skalberg@14516
|
421 |
val _ = message ("Adding cmap " ^ bthy ^ "." ^ bconst ^ " -> " ^ isaconst ^ (if internal then " (*)" else ""))
|
skalberg@14516
|
422 |
val curmaps = HOL4ConstMaps.get thy
|
skalberg@15531
|
423 |
val newmaps = StringPair.update_new(((bthy,bconst),(internal,isaconst,SOME typ)),curmaps)
|
skalberg@14516
|
424 |
val upd_thy = HOL4ConstMaps.put newmaps thy
|
skalberg@14516
|
425 |
in
|
skalberg@14516
|
426 |
upd_thy
|
skalberg@14516
|
427 |
end;
|
skalberg@14516
|
428 |
|
skalberg@14516
|
429 |
fun add_hol4_type_mapping bthy bconst internal isaconst thy =
|
skalberg@14516
|
430 |
let
|
skalberg@14516
|
431 |
val curmaps = HOL4TypeMaps.get thy
|
skalberg@14516
|
432 |
val _ = message ("Adding tmap " ^ bthy ^ "." ^ bconst ^ " -> " ^ isaconst ^ (if internal then " (*)" else ""))
|
skalberg@14516
|
433 |
val newmaps = StringPair.update_new(((bthy,bconst),(internal,isaconst)),curmaps)
|
skalberg@14516
|
434 |
val upd_thy = HOL4TypeMaps.put newmaps thy
|
skalberg@14516
|
435 |
in
|
skalberg@14516
|
436 |
upd_thy
|
skalberg@14516
|
437 |
end;
|
skalberg@14516
|
438 |
|
skalberg@14516
|
439 |
fun add_hol4_pending bthy bthm hth thy =
|
skalberg@14516
|
440 |
let
|
skalberg@14516
|
441 |
val thmname = Sign.full_name (sign_of thy) bthm
|
skalberg@14516
|
442 |
val _ = message ("Add pending " ^ bthy ^ "." ^ bthm)
|
skalberg@14516
|
443 |
val curpend = HOL4Pending.get thy
|
skalberg@14516
|
444 |
val newpend = StringPair.update_new(((bthy,bthm),hth),curpend)
|
skalberg@14516
|
445 |
val upd_thy = HOL4Pending.put newpend thy
|
skalberg@14516
|
446 |
val thy' = case opt_get_output_thy upd_thy of
|
skalberg@14516
|
447 |
"" => add_hol4_mapping bthy bthm thmname upd_thy
|
skalberg@14516
|
448 |
| output_thy =>
|
skalberg@14516
|
449 |
let
|
skalberg@14516
|
450 |
val new_thmname = output_thy ^ "." ^ bthy ^ "." ^ bthm
|
skalberg@14516
|
451 |
in
|
skalberg@14516
|
452 |
upd_thy |> add_hol4_move thmname new_thmname
|
skalberg@14516
|
453 |
|> add_hol4_mapping bthy bthm new_thmname
|
skalberg@14516
|
454 |
end
|
skalberg@14516
|
455 |
in
|
skalberg@14516
|
456 |
thy'
|
skalberg@14516
|
457 |
end;
|
skalberg@14516
|
458 |
|
skalberg@14516
|
459 |
fun get_hol4_theorem thyname thmname thy =
|
skalberg@14516
|
460 |
let
|
skalberg@14516
|
461 |
val isathms = HOL4Thms.get thy
|
skalberg@14516
|
462 |
in
|
skalberg@14516
|
463 |
StringPair.lookup (isathms,(thyname,thmname))
|
skalberg@14516
|
464 |
end
|
skalberg@14516
|
465 |
|
skalberg@14516
|
466 |
fun add_hol4_theorem thyname thmname hth thy =
|
skalberg@14516
|
467 |
let
|
skalberg@14516
|
468 |
val _ = message ("Adding HOL4 theorem " ^ thyname ^ "." ^ thmname)
|
skalberg@14516
|
469 |
val isathms = HOL4Thms.get thy
|
skalberg@14516
|
470 |
val isathms' = StringPair.update_new (((thyname,thmname),hth),isathms)
|
skalberg@14516
|
471 |
val thy' = HOL4Thms.put isathms' thy
|
skalberg@14516
|
472 |
in
|
skalberg@14516
|
473 |
thy'
|
skalberg@14516
|
474 |
end
|
skalberg@14516
|
475 |
|
skalberg@14516
|
476 |
fun export_hol4_pending thy =
|
skalberg@14516
|
477 |
let
|
skalberg@14516
|
478 |
val rews = HOL4Rewrites.get thy
|
skalberg@14516
|
479 |
val outthy = get_output_thy thy
|
skalberg@14516
|
480 |
fun process (thy,((bthy,bthm),hth as (_,thm))) =
|
skalberg@14516
|
481 |
let
|
skalberg@14516
|
482 |
val sg = sign_of thy
|
skalberg@14516
|
483 |
val thm1 = rewrite_rule (map (transfer_sg sg) rews) (transfer_sg sg thm)
|
skalberg@14516
|
484 |
val thm2 = standard thm1
|
skalberg@14516
|
485 |
val (thy2,_) = PureThy.store_thm((bthm,thm2),[]) thy
|
skalberg@14516
|
486 |
val thy5 = add_hol4_theorem bthy bthm hth thy2
|
skalberg@14516
|
487 |
in
|
skalberg@14516
|
488 |
thy5
|
skalberg@14516
|
489 |
end
|
skalberg@14516
|
490 |
|
skalberg@14516
|
491 |
val pending = HOL4Pending.get thy
|
skalberg@14516
|
492 |
val thy1 = StringPair.foldl process (thy,pending)
|
skalberg@14516
|
493 |
val thy2 = HOL4Pending.put (StringPair.empty) thy1
|
skalberg@14516
|
494 |
in
|
skalberg@14516
|
495 |
thy2
|
skalberg@14516
|
496 |
end;
|
skalberg@14516
|
497 |
|
skalberg@14516
|
498 |
fun setup_dump (dir,thyname) thy =
|
skalberg@14516
|
499 |
HOL4Dump.put (dir,thyname,[]) thy
|
skalberg@14516
|
500 |
|
skalberg@14516
|
501 |
fun add_dump str thy =
|
skalberg@14516
|
502 |
let
|
skalberg@14516
|
503 |
val (dir,thyname,curdump) = HOL4Dump.get thy
|
skalberg@14516
|
504 |
in
|
skalberg@14516
|
505 |
HOL4Dump.put (dir,thyname,str::curdump) thy
|
skalberg@14516
|
506 |
end
|
skalberg@14516
|
507 |
|
skalberg@14516
|
508 |
fun flush_dump thy =
|
skalberg@14516
|
509 |
let
|
skalberg@14516
|
510 |
val (dir,thyname,dumpdata) = HOL4Dump.get thy
|
skalberg@14516
|
511 |
val os = TextIO.openOut (OS.Path.joinDirFile {dir=dir,
|
skalberg@14516
|
512 |
file=thyname ^ ".thy"})
|
skalberg@14516
|
513 |
val _ = app (fn s => TextIO.output(os,s ^ "\n\n")) (rev dumpdata)
|
skalberg@14516
|
514 |
val _ = TextIO.closeOut os
|
skalberg@14516
|
515 |
in
|
skalberg@14516
|
516 |
HOL4Dump.put ("","",[]) thy
|
skalberg@14516
|
517 |
end
|
skalberg@14516
|
518 |
|
skalberg@14516
|
519 |
fun set_generating_thy thyname thy =
|
skalberg@14516
|
520 |
case HOL4DefThy.get thy of
|
skalberg@14516
|
521 |
NoImport => HOL4DefThy.put (Generating thyname) thy
|
skalberg@14516
|
522 |
| _ => error "Import already in progess"
|
skalberg@14516
|
523 |
|
skalberg@14516
|
524 |
fun set_replaying_thy thyname thy =
|
skalberg@14516
|
525 |
case HOL4DefThy.get thy of
|
skalberg@14516
|
526 |
NoImport => HOL4DefThy.put (Replaying thyname) thy
|
skalberg@14516
|
527 |
| _ => error "Import already in progess"
|
skalberg@14516
|
528 |
|
skalberg@14516
|
529 |
fun clear_import_thy thy =
|
skalberg@14516
|
530 |
case HOL4DefThy.get thy of
|
skalberg@14516
|
531 |
NoImport => error "No import in progress"
|
skalberg@14516
|
532 |
| _ => HOL4DefThy.put NoImport thy
|
skalberg@14516
|
533 |
|
skalberg@14516
|
534 |
fun get_generating_thy thy =
|
skalberg@14516
|
535 |
case HOL4DefThy.get thy of
|
skalberg@14516
|
536 |
Generating thyname => thyname
|
skalberg@14516
|
537 |
| _ => error "No theory being generated"
|
skalberg@14516
|
538 |
|
skalberg@14516
|
539 |
fun get_replaying_thy thy =
|
skalberg@14516
|
540 |
case HOL4DefThy.get thy of
|
skalberg@14516
|
541 |
Replaying thyname => thyname
|
skalberg@14516
|
542 |
| _ => error "No theory being replayed"
|
skalberg@14516
|
543 |
|
skalberg@14516
|
544 |
fun get_import_thy thy =
|
skalberg@14516
|
545 |
case HOL4DefThy.get thy of
|
skalberg@14516
|
546 |
Replaying thyname => thyname
|
skalberg@14516
|
547 |
| Generating thyname => thyname
|
skalberg@14516
|
548 |
| _ => error "No theory being imported"
|
skalberg@14516
|
549 |
|
skalberg@14516
|
550 |
fun should_ignore thyname thy thmname =
|
skalberg@14516
|
551 |
case get_hol4_mapping thyname thmname thy of
|
skalberg@15531
|
552 |
SOME NONE => true
|
skalberg@14516
|
553 |
| _ => false
|
skalberg@14516
|
554 |
|
skalberg@14516
|
555 |
val trans_string =
|
skalberg@14516
|
556 |
let
|
skalberg@14516
|
557 |
fun quote s = "\"" ^ s ^ "\""
|
skalberg@14516
|
558 |
fun F [] = []
|
skalberg@14516
|
559 |
| F (#"\\" :: cs) = patch #"\\" cs
|
skalberg@14516
|
560 |
| F (#"\"" :: cs) = patch #"\"" cs
|
skalberg@14516
|
561 |
| F (c :: cs) = c :: F cs
|
skalberg@14516
|
562 |
and patch c rest = #"\\" :: c :: F rest
|
skalberg@14516
|
563 |
in
|
skalberg@14516
|
564 |
quote o String.implode o F o String.explode
|
skalberg@14516
|
565 |
end
|
skalberg@14516
|
566 |
|
skalberg@14516
|
567 |
fun dump_import_thy thyname thy =
|
skalberg@14516
|
568 |
let
|
skalberg@14516
|
569 |
val output_dir = get_output_dir thy
|
skalberg@14516
|
570 |
val output_thy = get_output_thy thy
|
skalberg@14516
|
571 |
val import_segment = get_import_segment thy
|
skalberg@14516
|
572 |
val sg = sign_of thy
|
skalberg@14516
|
573 |
val os = TextIO.openOut (OS.Path.joinDirFile {dir=output_dir,
|
skalberg@14516
|
574 |
file=thyname ^ ".imp"})
|
skalberg@14516
|
575 |
fun out s = TextIO.output(os,s)
|
skalberg@14516
|
576 |
val (ignored,mapped) =
|
skalberg@14516
|
577 |
StringPair.foldl (fn ((ign,map),((bthy,bthm),v)) =>
|
skalberg@14516
|
578 |
if bthy = thyname
|
skalberg@14516
|
579 |
then (case v of
|
skalberg@15531
|
580 |
NONE => (bthm::ign,map)
|
skalberg@15531
|
581 |
| SOME w => (ign,(bthm,w)::map))
|
skalberg@14516
|
582 |
else (ign,map))
|
skalberg@14516
|
583 |
(([],[]),HOL4Maps.get thy)
|
skalberg@14516
|
584 |
val constmaps =
|
skalberg@14516
|
585 |
StringPair.foldl (fn (map,((bthy,bthm),v)) =>
|
skalberg@14516
|
586 |
if bthy = thyname
|
skalberg@14516
|
587 |
then (bthm,v)::map
|
skalberg@14516
|
588 |
else map)
|
skalberg@14516
|
589 |
([],HOL4ConstMaps.get thy)
|
skalberg@14516
|
590 |
|
skalberg@14516
|
591 |
val constrenames =
|
skalberg@14516
|
592 |
StringPair.foldl (fn (map,((bthy,bthm),v)) =>
|
skalberg@14516
|
593 |
if bthy = thyname
|
skalberg@14516
|
594 |
then (bthm,v)::map
|
skalberg@14516
|
595 |
else map)
|
skalberg@14516
|
596 |
([],HOL4Rename.get thy)
|
skalberg@14516
|
597 |
|
skalberg@14516
|
598 |
val typemaps =
|
skalberg@14516
|
599 |
StringPair.foldl (fn (map,((bthy,bthm),v)) =>
|
skalberg@14516
|
600 |
if bthy = thyname
|
skalberg@14516
|
601 |
then (bthm,v)::map
|
skalberg@14516
|
602 |
else map)
|
skalberg@14516
|
603 |
([],HOL4TypeMaps.get thy)
|
skalberg@14516
|
604 |
|
skalberg@14516
|
605 |
val defmaps =
|
skalberg@14516
|
606 |
StringPair.foldl (fn (map,((bthy,bthm),v)) =>
|
skalberg@14516
|
607 |
if bthy = thyname
|
skalberg@14516
|
608 |
then (bthm,v)::map
|
skalberg@14516
|
609 |
else map)
|
skalberg@14516
|
610 |
([],HOL4DefMaps.get thy)
|
skalberg@14516
|
611 |
|
skalberg@14516
|
612 |
fun new_name internal isa =
|
skalberg@14516
|
613 |
if internal
|
skalberg@14516
|
614 |
then
|
skalberg@14516
|
615 |
let
|
skalberg@14516
|
616 |
val paths = NameSpace.unpack isa
|
skalberg@14516
|
617 |
val i = drop(length paths - 2,paths)
|
skalberg@14516
|
618 |
in
|
skalberg@14516
|
619 |
case i of
|
skalberg@14516
|
620 |
[seg,con] => output_thy ^ "." ^ seg ^ "." ^ con
|
skalberg@14516
|
621 |
| _ => error "hol4rews.dump internal error"
|
skalberg@14516
|
622 |
end
|
skalberg@14516
|
623 |
else
|
skalberg@14516
|
624 |
isa
|
skalberg@14516
|
625 |
|
skalberg@14516
|
626 |
val _ = out "import\n\n"
|
skalberg@14516
|
627 |
|
skalberg@14516
|
628 |
val _ = out ("import_segment " ^ trans_string import_segment ^ "\n\n")
|
skalberg@14516
|
629 |
val _ = if null defmaps
|
skalberg@14516
|
630 |
then ()
|
skalberg@14516
|
631 |
else out "def_maps"
|
skalberg@14516
|
632 |
val _ = app (fn (hol,isa) =>
|
skalberg@14516
|
633 |
out ("\n " ^ (trans_string hol) ^ " > " ^ (trans_string isa))) defmaps
|
skalberg@14516
|
634 |
val _ = if null defmaps
|
skalberg@14516
|
635 |
then ()
|
skalberg@14516
|
636 |
else out "\n\n"
|
skalberg@14516
|
637 |
|
skalberg@14516
|
638 |
val _ = if null typemaps
|
skalberg@14516
|
639 |
then ()
|
skalberg@14516
|
640 |
else out "type_maps"
|
skalberg@14516
|
641 |
val _ = app (fn (hol,(internal,isa)) =>
|
skalberg@14516
|
642 |
out ("\n " ^ (trans_string hol) ^ " > " ^ (trans_string (new_name internal isa)))) typemaps
|
skalberg@14516
|
643 |
val _ = if null typemaps
|
skalberg@14516
|
644 |
then ()
|
skalberg@14516
|
645 |
else out "\n\n"
|
skalberg@14516
|
646 |
|
skalberg@14516
|
647 |
val _ = if null constmaps
|
skalberg@14516
|
648 |
then ()
|
skalberg@14516
|
649 |
else out "const_maps"
|
skalberg@14516
|
650 |
val _ = app (fn (hol,(internal,isa,opt_ty)) =>
|
skalberg@14516
|
651 |
(out ("\n " ^ (trans_string hol) ^ " > " ^ (trans_string (follow_cname isa thy)));
|
skalberg@14516
|
652 |
case opt_ty of
|
skalberg@15531
|
653 |
SOME ty => out (" :: \"" ^ (string_of_ctyp (ctyp_of sg ty)) ^ "\"")
|
skalberg@15531
|
654 |
| NONE => ())) constmaps
|
skalberg@14516
|
655 |
val _ = if null constmaps
|
skalberg@14516
|
656 |
then ()
|
skalberg@14516
|
657 |
else out "\n\n"
|
skalberg@14516
|
658 |
|
skalberg@14516
|
659 |
val _ = if null constrenames
|
skalberg@14516
|
660 |
then ()
|
skalberg@14516
|
661 |
else out "const_renames"
|
skalberg@14516
|
662 |
val _ = app (fn (old,new) =>
|
skalberg@14516
|
663 |
out ("\n " ^ (trans_string old) ^ " > " ^ (trans_string new))) constrenames
|
skalberg@14516
|
664 |
val _ = if null constrenames
|
skalberg@14516
|
665 |
then ()
|
skalberg@14516
|
666 |
else out "\n\n"
|
skalberg@14516
|
667 |
|
skalberg@14516
|
668 |
val _ = if null mapped
|
skalberg@14516
|
669 |
then ()
|
skalberg@14516
|
670 |
else out "thm_maps"
|
skalberg@14516
|
671 |
val _ = app (fn (hol,isa) => out ("\n " ^ (trans_string hol) ^ " > " ^ (trans_string isa))) mapped
|
skalberg@14516
|
672 |
val _ = if null mapped
|
skalberg@14516
|
673 |
then ()
|
skalberg@14516
|
674 |
else out "\n\n"
|
skalberg@14516
|
675 |
|
skalberg@14516
|
676 |
val _ = if null ignored
|
skalberg@14516
|
677 |
then ()
|
skalberg@14516
|
678 |
else out "ignore_thms"
|
skalberg@14516
|
679 |
val _ = app (fn ign => out ("\n " ^ (trans_string ign))) ignored
|
skalberg@14516
|
680 |
val _ = if null ignored
|
skalberg@14516
|
681 |
then ()
|
skalberg@14516
|
682 |
else out "\n\n"
|
skalberg@14516
|
683 |
|
skalberg@14516
|
684 |
val _ = out "end\n"
|
skalberg@14516
|
685 |
val _ = TextIO.closeOut os
|
skalberg@14516
|
686 |
in
|
skalberg@14516
|
687 |
thy
|
skalberg@14516
|
688 |
end
|
skalberg@14516
|
689 |
|
skalberg@14516
|
690 |
fun set_used_names names thy =
|
skalberg@14516
|
691 |
let
|
skalberg@14516
|
692 |
val unames = HOL4UNames.get thy
|
skalberg@14516
|
693 |
in
|
skalberg@14516
|
694 |
case unames of
|
skalberg@14516
|
695 |
[] => HOL4UNames.put names thy
|
skalberg@14516
|
696 |
| _ => error "hol4rews.set_used_names called on initialized data!"
|
skalberg@14516
|
697 |
end
|
skalberg@14516
|
698 |
|
skalberg@14516
|
699 |
val clear_used_names = HOL4UNames.put HOL4UNamesArgs.empty
|
skalberg@14516
|
700 |
|
skalberg@14516
|
701 |
fun get_defmap thyname const thy =
|
skalberg@14516
|
702 |
let
|
skalberg@14516
|
703 |
val maps = HOL4DefMaps.get thy
|
skalberg@14516
|
704 |
in
|
skalberg@14516
|
705 |
StringPair.lookup(maps,(thyname,const))
|
skalberg@14516
|
706 |
end
|
skalberg@14516
|
707 |
|
skalberg@14516
|
708 |
fun add_defmap thyname const defname thy =
|
skalberg@14516
|
709 |
let
|
skalberg@14516
|
710 |
val _ = message ("Adding defmap " ^ thyname ^ "." ^ const ^ " --> " ^ defname)
|
skalberg@14516
|
711 |
val maps = HOL4DefMaps.get thy
|
skalberg@14516
|
712 |
val maps' = StringPair.update_new(((thyname,const),defname),maps)
|
skalberg@14516
|
713 |
val thy' = HOL4DefMaps.put maps' thy
|
skalberg@14516
|
714 |
in
|
skalberg@14516
|
715 |
thy'
|
skalberg@14516
|
716 |
end
|
skalberg@14516
|
717 |
|
skalberg@14516
|
718 |
fun get_defname thyname name thy =
|
skalberg@14516
|
719 |
let
|
skalberg@14516
|
720 |
val maps = HOL4DefMaps.get thy
|
skalberg@14516
|
721 |
fun F dname = (dname,add_defmap thyname name dname thy)
|
skalberg@14516
|
722 |
in
|
skalberg@14516
|
723 |
case StringPair.lookup(maps,(thyname,name)) of
|
skalberg@15531
|
724 |
SOME thmname => (thmname,thy)
|
skalberg@15531
|
725 |
| NONE =>
|
skalberg@14516
|
726 |
let
|
skalberg@14516
|
727 |
val used = HOL4UNames.get thy
|
skalberg@14516
|
728 |
val defname = def_name name
|
skalberg@14516
|
729 |
val pdefname = name ^ "_primdef"
|
skalberg@14516
|
730 |
in
|
skalberg@14516
|
731 |
if not (defname mem used)
|
skalberg@14516
|
732 |
then F defname (* name_def *)
|
skalberg@14516
|
733 |
else if not (pdefname mem used)
|
skalberg@14516
|
734 |
then F pdefname (* name_primdef *)
|
skalberg@14516
|
735 |
else F (variant used pdefname) (* last resort *)
|
skalberg@14516
|
736 |
end
|
skalberg@14516
|
737 |
end
|
skalberg@14516
|
738 |
|
skalberg@14516
|
739 |
local
|
skalberg@14516
|
740 |
fun handle_meta [x as Appl[Appl[Constant "_constrain", Constant "==", _],_,_]] = x
|
skalberg@14516
|
741 |
| handle_meta [x as Appl[Appl[Constant "_constrain", Constant "all", _],_]] = x
|
skalberg@14516
|
742 |
| handle_meta [x as Appl[Appl[Constant "_constrain", Constant "==>", _],_,_]] = x
|
skalberg@14516
|
743 |
| handle_meta [x] = Appl[Constant "Trueprop",x]
|
skalberg@14518
|
744 |
| handle_meta _ = error "hol4rews error: Trueprop not applied to single argument"
|
skalberg@14516
|
745 |
in
|
skalberg@14516
|
746 |
val smarter_trueprop_parsing = [("Trueprop",handle_meta)]
|
skalberg@14516
|
747 |
end
|
skalberg@14516
|
748 |
|
skalberg@14516
|
749 |
local
|
skalberg@14516
|
750 |
fun initial_maps thy =
|
skalberg@14516
|
751 |
thy |> add_hol4_type_mapping "min" "bool" false "bool"
|
skalberg@14516
|
752 |
|> add_hol4_type_mapping "min" "fun" false "fun"
|
skalberg@14516
|
753 |
|> add_hol4_type_mapping "min" "ind" false "Nat.ind"
|
skalberg@14516
|
754 |
|> add_hol4_const_mapping "min" "=" false "op ="
|
skalberg@14516
|
755 |
|> add_hol4_const_mapping "min" "==>" false "op -->"
|
skalberg@14516
|
756 |
|> add_hol4_const_mapping "min" "@" false "Hilbert_Choice.Eps"
|
skalberg@14516
|
757 |
in
|
skalberg@14516
|
758 |
val hol4_setup =
|
skalberg@14516
|
759 |
[HOL4Rewrites.init,
|
skalberg@14516
|
760 |
HOL4Maps.init,
|
skalberg@14516
|
761 |
HOL4UNames.init,
|
skalberg@14516
|
762 |
HOL4DefMaps.init,
|
skalberg@14516
|
763 |
HOL4Moves.init,
|
skalberg@14516
|
764 |
HOL4CMoves.init,
|
skalberg@14516
|
765 |
HOL4ConstMaps.init,
|
skalberg@14516
|
766 |
HOL4Rename.init,
|
skalberg@14516
|
767 |
HOL4TypeMaps.init,
|
skalberg@14516
|
768 |
HOL4Pending.init,
|
skalberg@14516
|
769 |
HOL4Thms.init,
|
skalberg@14516
|
770 |
HOL4Dump.init,
|
skalberg@14516
|
771 |
HOL4DefThy.init,
|
skalberg@14516
|
772 |
HOL4Imports.init,
|
skalberg@14516
|
773 |
ImportSegment.init,
|
skalberg@14516
|
774 |
initial_maps,
|
skalberg@14516
|
775 |
Attrib.add_attributes [("hol4rew",
|
skalberg@14516
|
776 |
(Attrib.no_args add_hol4_rewrite,
|
skalberg@14516
|
777 |
Attrib.no_args Attrib.undef_local_attribute),
|
skalberg@14516
|
778 |
"HOL4 rewrite rule")]]
|
skalberg@14516
|
779 |
end
|