src/Pure/pure_thy.ML
changeset 26292 009e56d16080
parent 26282 305d5ca4fa9d
child 26308 73d68876ba46
equal deleted inserted replaced
26291:d01bf7b10c75 26292:009e56d16080
   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 =