766 fun thy_feature_of s = "y" ^ s |
766 fun thy_feature_of s = "y" ^ s |
767 fun type_feature_of s = "t" ^ s |
767 fun type_feature_of s = "t" ^ s |
768 fun class_feature_of s = "s" ^ s |
768 fun class_feature_of s = "s" ^ s |
769 val local_feature = "local" |
769 val local_feature = "local" |
770 |
770 |
771 fun crude_theory_ord p = |
771 fun crude_thm_ord ctxt = |
772 if Theory.subthy p then |
772 let |
773 if Theory.eq_thy p then EQUAL else LESS |
773 val ancestor_lengths = |
774 else if Theory.subthy (swap p) then |
774 fold (fn thy => Symtab.update (Context.theory_name thy, length (Context.ancestors_of thy))) |
775 GREATER |
775 (Theory.nodes_of (Proof_Context.theory_of ctxt)) Symtab.empty |
776 else |
776 val ancestor_length = Symtab.lookup ancestor_lengths o Context.theory_id_name |
777 (case int_ord (apply2 (length o Theory.ancestors_of) p) of |
777 fun crude_theory_ord p = |
778 EQUAL => string_ord (apply2 Context.theory_name p) |
778 if Context.eq_thy_id p then EQUAL |
779 | order => order) |
779 else if Context.proper_subthy_id p then LESS |
780 |
780 else if Context.proper_subthy_id (swap p) then GREATER |
781 fun crude_thm_ord ctxt p = |
781 else |
782 (case crude_theory_ord (apply2 Thm.theory_of_thm p) of |
782 (case apply2 ancestor_length p of |
783 EQUAL => |
783 (SOME m, SOME n) => |
784 (* The hack below is necessary because of odd dependencies that are not reflected in the theory |
784 (case int_ord (m, n) of |
785 comparison. *) |
785 EQUAL => string_ord (apply2 Context.theory_id_name p) |
786 let val q = apply2 (nickname_of_thm ctxt) p in |
786 | ord => ord) |
787 (* Hack to put "xxx_def" before "xxxI" and "xxxE" *) |
787 | _ => string_ord (apply2 Context.theory_id_name p)) |
788 (case bool_ord (apply2 (String.isSuffix "_def") (swap q)) of |
788 in |
789 EQUAL => string_ord q |
789 fn p => |
|
790 (case crude_theory_ord (apply2 Thm.theory_id_of_thm p) of |
|
791 EQUAL => |
|
792 (* The hack below is necessary because of odd dependencies that are not reflected in the theory |
|
793 comparison. *) |
|
794 let val q = apply2 (nickname_of_thm ctxt) p in |
|
795 (* Hack to put "xxx_def" before "xxxI" and "xxxE" *) |
|
796 (case bool_ord (apply2 (String.isSuffix "_def") (swap q)) of |
|
797 EQUAL => string_ord q |
|
798 | ord => ord) |
|
799 end |
790 | ord => ord) |
800 | ord => ord) |
791 end |
801 end; |
792 | ord => ord) |
802 |
793 |
803 val thm_less_eq = Context.subthy_id o apply2 Thm.theory_id_of_thm |
794 val thm_less_eq = Theory.subthy o apply2 Thm.theory_of_thm |
|
795 fun thm_less p = thm_less_eq p andalso not (thm_less_eq (swap p)) |
804 fun thm_less p = thm_less_eq p andalso not (thm_less_eq (swap p)) |
796 |
805 |
797 val freezeT = Type.legacy_freeze_type |
806 val freezeT = Type.legacy_freeze_type |
798 |
807 |
799 fun freeze (t $ u) = freeze t $ freeze u |
808 fun freeze (t $ u) = freeze t $ freeze u |
1108 (maxs, Graph.Keys.fold (insert_new seen) (Graph.imm_preds G new) news)) |
1117 (maxs, Graph.Keys.fold (insert_new seen) (Graph.imm_preds G new) news)) |
1109 in |
1118 in |
1110 find_maxes Symtab.empty ([], Graph.maximals G) |
1119 find_maxes Symtab.empty ([], Graph.maximals G) |
1111 end |
1120 end |
1112 |
1121 |
1113 fun strict_subthy thyp = Theory.subthy thyp andalso not (Theory.subthy (swap thyp)) |
|
1114 |
|
1115 fun maximal_wrt_access_graph _ _ [] = [] |
1122 fun maximal_wrt_access_graph _ _ [] = [] |
1116 | maximal_wrt_access_graph ctxt access_G ((fact as (_, th)) :: facts) = |
1123 | maximal_wrt_access_graph ctxt access_G ((fact as (_, th)) :: facts) = |
1117 let val thy = Thm.theory_of_thm th in |
1124 let val thy_id = Thm.theory_id_of_thm th in |
1118 fact :: filter_out (fn (_, th') => strict_subthy (Thm.theory_of_thm th', thy)) facts |
1125 fact :: filter_out (fn (_, th') => |
|
1126 Context.proper_subthy_id (Thm.theory_id_of_thm th', thy_id)) facts |
1119 |> map (nickname_of_thm ctxt o snd) |
1127 |> map (nickname_of_thm ctxt o snd) |
1120 |> maximal_wrt_graph access_G |
1128 |> maximal_wrt_graph access_G |
1121 end |
1129 end |
1122 |
1130 |
1123 fun is_fact_in_graph ctxt access_G = can (Graph.get_node access_G) o nickname_of_thm ctxt |
1131 fun is_fact_in_graph ctxt access_G = can (Graph.get_node access_G) o nickname_of_thm ctxt |