tuned;
authorwenzelm
Sun Sep 27 21:06:43 2009 +0200 (2009-09-27)
changeset 32710fa46afc8c05f
parent 32709 c5956b54a460
child 32711 e24acd21e60e
tuned;
src/Pure/General/graph.ML
     1.1 --- a/src/Pure/General/graph.ML	Sun Sep 27 19:39:40 2009 +0200
     1.2 +++ b/src/Pure/General/graph.ML	Sun Sep 27 21:06:43 2009 +0200
     1.3 @@ -132,21 +132,23 @@
     1.4    let
     1.5      fun reach x (rs, R) =
     1.6        if member_keys R x then (rs, R)
     1.7 -      else apfst (cons x) (fold reach (next x) (rs, insert_keys x R))
     1.8 -  in fold_map (fn x => fn X => reach x ([], X)) xs empty_keys end;
     1.9 +      else fold reach (next x) (rs, insert_keys x R) |>> cons x;
    1.10 +    fun reachs x (rss, R) =
    1.11 +      reach x ([], R) |>> (fn rs => rs :: rss);
    1.12 +  in fold reachs xs ([], empty_keys) end;
    1.13  
    1.14  (*immediate*)
    1.15  fun imm_preds G = #1 o #2 o get_entry G;
    1.16  fun imm_succs G = #2 o #2 o get_entry G;
    1.17  
    1.18  (*transitive*)
    1.19 -fun all_preds G = flat o rev o fst o reachable (imm_preds G);
    1.20 -fun all_succs G = flat o rev o fst o reachable (imm_succs G);
    1.21 +fun all_preds G = flat o #1 o reachable (imm_preds G);
    1.22 +fun all_succs G = flat o #1 o reachable (imm_succs G);
    1.23  
    1.24  (*strongly connected components; see: David King and John Launchbury,
    1.25    "Structuring Depth First Search Algorithms in Haskell"*)
    1.26 -fun strong_conn G = filter_out null (fst (reachable (imm_preds G)
    1.27 -  (flat (rev (fst (reachable (imm_succs G) (keys G)))))));
    1.28 +fun strong_conn G =
    1.29 +  rev (filter_out null (#1 (reachable (imm_preds G) (all_succs G (keys G)))));
    1.30  
    1.31  
    1.32  (* nodes *)