248 (NameSelection (name, [Single i]), thm)); |
248 (NameSelection (name, [Single i]), thm)); |
249 |
249 |
250 |
250 |
251 (* lookup/get thms *) |
251 (* lookup/get thms *) |
252 |
252 |
253 fun lookup_thms thy = |
253 local |
|
254 |
|
255 fun lookup_thms thy xname = |
254 let |
256 let |
255 val (space, thms) = #theorems (get_theorems thy); |
257 val (space, thms) = #theorems (get_theorems thy); |
256 val thy_ref = Theory.check_thy thy; |
258 val name = NameSpace.intern space xname; |
257 in |
259 in Option.map (pair name) (Symtab.lookup thms name) end; |
258 fn name => |
260 |
259 Option.map (map (Thm.transfer (Theory.deref thy_ref))) (*dynamic identity*) |
261 fun lookup_fact thy xname = |
260 (Symtab.lookup thms (NameSpace.intern space name)) (*static content*) |
262 let |
261 end; |
263 val facts = all_facts_of thy; |
|
264 val name = NameSpace.intern (Facts.space_of facts) xname; |
|
265 in Option.map (pair name) (Facts.lookup facts name) end; |
|
266 |
|
267 fun show_result NONE = "none" |
|
268 | show_result (SOME (name, _)) = quote name; |
|
269 |
|
270 in |
262 |
271 |
263 fun get_thms theory thmref = |
272 fun get_thms theory thmref = |
264 let val name = name_of_thmref thmref in |
273 let |
265 get_first (fn thy => lookup_thms thy name) (theory :: Theory.ancestors_of theory) |
274 val name = name_of_thmref thmref; |
266 |> the_thms name |> select_thm thmref |> map (Thm.transfer theory) |
275 val new_res = lookup_fact theory name; |
267 end; |
276 val old_res = get_first (fn thy => lookup_thms thy name) (theory :: Theory.ancestors_of theory); |
|
277 val is_same = |
|
278 (case (new_res, old_res) of |
|
279 (NONE, NONE) => true |
|
280 | (SOME (name1, ths1), SOME (name2, ths2)) => name1 = name2 andalso Thm.eq_thms (ths1, ths2) |
|
281 | _ => false); |
|
282 val _ = |
|
283 if is_same then () |
|
284 else legacy_feature ("Fact lookup differs from old-style thm database:\n" ^ |
|
285 show_result new_res ^ " vs " ^ show_result old_res ^ |
|
286 Position.str_of (Position.thread_data ())); |
|
287 in Option.map #2 old_res |> the_thms name |> select_thm thmref |> map (Thm.transfer theory) end; |
268 |
288 |
269 fun get_thmss thy thmrefs = maps (get_thms thy) thmrefs; |
289 fun get_thmss thy thmrefs = maps (get_thms thy) thmrefs; |
270 fun get_thm thy thmref = single_thm (name_of_thmref thmref) (get_thms thy thmref); |
290 fun get_thm thy thmref = single_thm (name_of_thmref thmref) (get_thms thy thmref); |
|
291 |
|
292 end; |
271 |
293 |
272 |
294 |
273 (* thms_of etc. *) |
295 (* thms_of etc. *) |
274 |
296 |
275 fun thms_of thy = |
297 fun thms_of thy = |