# HG changeset patch
# User wenzelm
# Date 1254078403 -7200
# Node ID fa46afc8c05ff6450dc497894ed044734ffaa4a3
# Parent  c5956b54a460ffcad9c1437745ab514e502e1113
tuned;

diff -r c5956b54a460 -r fa46afc8c05f src/Pure/General/graph.ML
--- a/src/Pure/General/graph.ML	Sun Sep 27 19:39:40 2009 +0200
+++ b/src/Pure/General/graph.ML	Sun Sep 27 21:06:43 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 rev o fst o reachable (imm_preds G);
-fun all_succs G = flat o rev 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 *)