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 = |