src/Pure/Thy/thy_read.ML
changeset 783 08f1785a4384
parent 778 9a03ed31ea2f
child 871 1c060d444a81
equal deleted inserted replaced
782:200a16083201 783:08f1785a4384
   256          if thy_uptodate orelse thy_file = "" then ()
   256          if thy_uptodate orelse thy_file = "" then ()
   257          else (writeln ("Reading \"" ^ name ^ ".thy\"");
   257          else (writeln ("Reading \"" ^ name ^ ".thy\"");
   258                read_thy tname thy_file;
   258                read_thy tname thy_file;
   259                use (out_name tname)
   259                use (out_name tname)
   260               );
   260               );
       
   261          set_info (file_info thy_file) "" tname;
       
   262                                        (*mark thy_file as successfully loaded*)
   261 
   263 
   262          if ml_file = "" then ()
   264          if ml_file = "" then ()
   263          else (writeln ("Reading \"" ^ name ^ ".ML\"");
   265          else (writeln ("Reading \"" ^ name ^ ".ML\"");
   264                use ml_file);
   266                use ml_file);
   265 
   267 
   453     val show_sg = Pretty.str_of o Sign.pretty_sg;
   455     val show_sg = Pretty.str_of o Sign.pretty_sg;
   454   in
   456   in
   455     if is_some opt_info andalso eq_sg (the opt_info) then
   457     if is_some opt_info andalso eq_sg (the opt_info) then
   456       (xname, the opt_info)
   458       (xname, the opt_info)
   457     else
   459     else
   458       (case Symtab.find_first (eq_sg o snd) (! loaded_thys) of
   460       (case Symtab.find_first (eq_sg o snd) (!loaded_thys) of
   459         Some name_info => name_info
   461         Some name_info => name_info
   460       | None => error ("Theory " ^ show_sg sg ^ " not stored by loader"))
   462       | None => error ("Theory " ^ show_sg sg ^ " not stored by loader"))
   461   end;
   463   end;
   462 
   464 
   463 
   465 
   511 
   513 
   512 fun qed_goalw name thy rths agoal tacsf =
   514 fun qed_goalw name thy rths agoal tacsf =
   513   (qed_thm := prove_goalw thy rths agoal tacsf;
   515   (qed_thm := prove_goalw thy rths agoal tacsf;
   514    use_string ["val " ^ name ^ " = store_thm (" ^ quote name ^", !qed_thm);"]);
   516    use_string ["val " ^ name ^ " = store_thm (" ^ quote name ^", !qed_thm);"]);
   515 
   517 
       
   518 
   516 (* Retrieve theorems *)
   519 (* Retrieve theorems *)
   517 
   520 
   518 (*Get all theorems belonging to a given theory object*)
   521 (*Get all direct ancestors of a theory*)
   519 fun thmtab thy =
   522 fun get_parents child =
   520   let val (_, ThyInfo {thms, ...}) = thyinfo_of_sign (sign_of thy)
   523   let fun has_child (tname, ThyInfo {children, theory, ...}) = 
       
   524         if child mem children then Some tname else None;
       
   525   in mapfilter has_child (Symtab.dest (!loaded_thys)) end;
       
   526 
       
   527 (*Get all theorems belonging to a given theory*)
       
   528 fun thmtab_ofthy thy =
       
   529   let val (_, ThyInfo {thms, ...}) = thyinfo_of_sign (sign_of thy);
       
   530   in thms end;
       
   531 
       
   532 fun thmtab_ofname name =
       
   533   let val ThyInfo {thms, ...} = the (get_thyinfo name);
   521   in thms end;
   534   in thms end;
   522 
   535 
   523 (*Get a stored theorem specified by theory and name*)
   536 (*Get a stored theorem specified by theory and name*)
   524 fun get_thm thy name =
   537 fun get_thm thy name =
   525   (case Symtab.lookup (thmtab thy, name) of
   538   let fun get [] [] searched =
   526     Some thm => thm
   539            raise THEORY ("get_thm: no theorem " ^ quote name, [thy])
   527   | None => raise THEORY ("get_thm: no theorem " ^ quote name, [thy]));
   540         | get [] ng searched =
       
   541             get (distinct (gen_rems (op =) (ng, searched))) [] searched
       
   542         | get (t::ts) ng searched =
       
   543             (case Symtab.lookup (thmtab_ofname t, name) of
       
   544                  Some thm => thm
       
   545                | None => get ts (ng @ get_parents t) (t::searched));
       
   546 
       
   547       val (tname, _) = thyinfo_of_sign (sign_of thy);
       
   548   in get [tname] [] [] end;
   528 
   549 
   529 (*Get stored theorems of a theory*)
   550 (*Get stored theorems of a theory*)
   530 val thms_of = Symtab.dest o thmtab;
   551 val thms_of = Symtab.dest o thmtab_ofthy;
   531 
   552 
   532 
   553 
   533 (* print theory *)
   554 (* print theory *)
   534 
   555 
   535 fun print_thms thy =
   556 fun print_thms thy =