merged

--- a/src/Pure/General/graph.ML	Sun Sep 27 19:58:24 2009 +0200
+++ b/src/Pure/General/graph.ML	Sun Sep 27 22:25:13 2009 +0200
@@ -132,21 +132,23 @@
   let
     fun reach x (rs, R) =
       if member_keys R x then (rs, R)
-      else apfst (cons x) (fold reach (next x) (rs, insert_keys x R))
-  in fold_map (fn x => fn X => reach x ([], X)) xs empty_keys end;
+      else fold reach (next x) (rs, insert_keys x R) |>> cons x;
+    fun reachs x (rss, R) =
+      reach x ([], R) |>> (fn rs => rs :: rss);
+  in fold reachs xs ([], empty_keys) end;
 
 (*immediate*)
 fun imm_preds G = #1 o #2 o get_entry G;
 fun imm_succs G = #2 o #2 o get_entry G;
 
 (*transitive*)
-fun all_preds G = flat o fst o reachable (imm_preds G);
-fun all_succs G = flat o fst o reachable (imm_succs G);
+fun all_preds G = flat o #1 o reachable (imm_preds G);
+fun all_succs G = flat o #1 o reachable (imm_succs G);
 
 (*strongly connected components; see: David King and John Launchbury,
   "Structuring Depth First Search Algorithms in Haskell"*)
-fun strong_conn G = filter_out null (fst (reachable (imm_preds G)
-  (flat (rev (fst (reachable (imm_succs G) (keys G)))))));
+fun strong_conn G =
+  rev (filter_out null (#1 (reachable (imm_preds G) (all_succs G (keys G)))));
 
 
 (* nodes *)

--- a/src/Pure/proofterm.ML	Sun Sep 27 19:58:24 2009 +0200
+++ b/src/Pure/proofterm.ML	Sun Sep 27 22:25:13 2009 +0200
@@ -173,16 +173,19 @@
 
 fun fold_body_thms f =
   let
-    fun app (PBody {thms, ...}) =
+    fun app path (PBody {thms, ...}) =
      (Future.join_results (map (#3 o #2) thms);
       thms |> fold (fn (i, (name, prop, body)) => fn (x, seen) =>
-        if Inttab.defined seen i then (x, seen)
+        if Inttab.defined path i then
+          error ("Cyclic reference to theorem " ^ quote name)
+        else if Inttab.defined seen i then (x, seen)
         else
           let
             val body' = Future.join body;
-            val (x', seen') = app body' (x, Inttab.update (i, ()) seen);
+            val path' = Inttab.update (i, ()) path;
+            val (x', seen') = app path' body' (x, Inttab.update (i, ()) seen);
           in (f (name, prop, body') x', seen') end));
-  in fn bodies => fn x => #1 (fold app bodies (x, Inttab.empty)) end;
+  in fn bodies => fn x => #1 (fold (app Inttab.empty) bodies (x, Inttab.empty)) end;
 
 fun join_bodies bodies = fold_body_thms (fn _ => fn () => ()) bodies ();