src/Pure/Thy/thm_deps.ML
changeset 28826 3b460b6eadae
parent 28817 c8cc94a470d4
child 29606 fedb8be05f24
--- a/src/Pure/Thy/thm_deps.ML	Mon Nov 17 21:13:48 2008 +0100
+++ b/src/Pure/Thy/thm_deps.ML	Mon Nov 17 21:28:46 2008 +0100
@@ -16,36 +16,33 @@
 
 (* thm_deps *)
 
-fun add_dep (name, _, PBody {thms = thms', ...}) =
-  name <> "" ?
-    Graph.new_node (name, ()) #>
-    fold (fn (_, (name', _, _)) => name <> "" ? Graph.add_edge (name', name)) thms';
-
 fun thm_deps thms =
   let
-    val graph = Proofterm.fold_body_thms add_dep (map Thm.proof_body_of thms) Graph.empty;
-    fun add_entry (name, (_, (preds, _))) =
-      let
-        val prefix = #1 (Library.split_last (NameSpace.explode name));
-        val session =
-          (case prefix of
-            a :: _ =>
-              (case ThyInfo.lookup_theory a of
-                SOME thy =>
-                  (case Present.session_name thy of
-                    "" => []
-                  | session => [session])
-              | NONE => [])
-           | _ => ["global"]);
-        val entry =
-          {name = Sign.base_name name,
-           ID = name,
-           dir = space_implode "/" (session @ prefix),
-           unfold = false,
-           path = "",
-           parents = preds};
-      in cons entry end;
-  in Present.display_graph (sort_wrt #ID (Graph.fold add_entry graph [])) end;
+    fun add_dep ("", _, _) = I
+      | add_dep (name, _, PBody {thms = thms', ...}) =
+          let
+            val prefix = #1 (Library.split_last (NameSpace.explode name));
+            val session =
+              (case prefix of
+                a :: _ =>
+                  (case ThyInfo.lookup_theory a of
+                    SOME thy =>
+                      (case Present.session_name thy of
+                        "" => []
+                      | session => [session])
+                  | NONE => [])
+               | _ => ["global"]);
+            val parents = filter_out (fn s => s = "") (map (#1 o #2) thms');
+            val entry =
+              {name = Sign.base_name name,
+               ID = name,
+               dir = space_implode "/" (session @ prefix),
+               unfold = false,
+               path = "",
+               parents = parents};
+          in cons entry end;
+    val deps = Proofterm.fold_body_thms add_dep (map Thm.proof_body_of thms) [];
+  in Present.display_graph (sort_wrt #ID deps) end;
 
 
 (* unused_thms *)