Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/FLINT/src/comp-lib/scc.sml
ViewVC logotype

Diff of /sml/branches/FLINT/src/comp-lib/scc.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 410, Fri Sep 3 00:25:03 1999 UTC revision 411, Fri Sep 3 00:25:03 1999 UTC
# Line 38  Line 38 
38      structure Node = Node      structure Node = Node
39    
40      structure NodeOrdSet = struct      structure NodeOrdSet = struct
41          type elem = Node.node          type ord_key = Node.node
42          val (op <) = Node.lt          fun compare(n1, n2) =
43              if Node.eq(n1,n2) then General.EQUAL
44              else if Node.lt(n1,n2) then General.LESS
45                   else General.GREATER
46      end      end
47    
48      structure Map = MapF (NodeOrdSet)      structure Map = BinaryMapFn(NodeOrdSet)
49    
50      type node = Node.node      type node = Node.node
51    
# Line 53  Line 56 
56      fun topOrder { root, follow } = let      fun topOrder { root, follow } = let
57    
58          fun getNode (n, nm as (npre, m)) =          fun getNode (n, nm as (npre, m)) =
59              (nm, (Map.lookup m n))            (case Map.find(m, n)
60              handle Map.MapF => let               of NONE => let
61                  val r = { pre = npre, low = ref npre }                  val r = { pre = npre, low = ref npre }
62                  val m' = Map.add (m, n, r)                    val m' = Map.insert (m, n, r)
63              in                  in ((npre + 1, m'), r)
                 ((npre + 1, m'), r)  
64              end              end
65                  | SOME r => (nm, r)
66              (*esac*))
67    
68          fun theNode x y = Node.eq (x, y)          fun theNode x y = Node.eq (x, y)
69    
# Line 105  Line 109 
109                          cont (nodemap, stack, sccl)                          cont (nodemap, stack, sccl)
110                      end                      end
111                  end                  end
112                | loop (tn :: tnl) (nodemap as (npre, theMap), stack, sccl) = let                | loop (tn :: tnl) (nodemap as (npre, theMap), stack, sccl) =
113                      val { pre = tn_pre, low = tn_low } = Map.lookup theMap tn                  (case Map.find(theMap, tn)
114                      (* the lookup succeeded -> we have seen tn before *)                    of SOME{ pre = tn_pre, low = tn_low } => let
115                      val tl = !tn_low                      val tl = !tn_low
116                  in                  in
117                      if tl < (!node_low) andalso                      if tl < (!node_low) andalso
# Line 115  Line 119 
119                          node_low := tl                          node_low := tl
120                      else ();                      else ();
121                          loop tnl (nodemap, stack, sccl)                          loop tnl (nodemap, stack, sccl)
122                  end handle Map.MapF => let                       end
123                      | NONE =>let
124                      (* lookup failed -> tn is a new node *)                      (* lookup failed -> tn is a new node *)
125                      val tn_pre = npre                      val tn_pre = npre
126                      val tn_low = ref npre                      val tn_low = ref npre
127                      val npre = npre + 1                      val npre = npre + 1
128                      val theMap = Map.add (theMap, tn,                        val theMap =
129                            Map.insert (theMap, tn,
130                                            { pre = tn_pre, low = tn_low })                                            { pre = tn_pre, low = tn_low })
131                      val nodemap = (npre, theMap)                      val nodemap = (npre, theMap)
132                  in                  in
# Line 131  Line 137 
137                            sccl = sccl,                            sccl = sccl,
138                            cont = loop tnl }                            cont = loop tnl }
139                  end                  end
140                     (*esac*))
141          in          in
142              loop (follow node) (nodemap, stack, sccl)              loop (follow node) (nodemap, stack, sccl)
143          end          end
# Line 139  Line 146 
146      in      in
147          dfs { node = root, node_pre = 0, node_low = root_low,          dfs { node = root, node_pre = 0, node_low = root_low,
148                parent_low = ref 0,       (* dummy *)                parent_low = ref 0,       (* dummy *)
149                nodemap = (1, Map.singleton (root, { pre = 0, low = root_low })),                nodemap = (1, Map.insert (Map.empty, root, { pre = 0, low = root_low })),
150                stack = [root],                stack = [root],
151                sccl = [],                sccl = [],
152                cont = fn (_, _, sccl) => sccl }                cont = fn (_, _, sccl) => sccl }
# Line 147  Line 154 
154  end  end
155    
156  (*  (*
157   * $Log$   * $Log: scc.sml,v $
158     * Revision 1.1.1.1  1998/04/08 18:39:14  george
159     * Version 110.5
160     *
161   *)   *)

Legend:
Removed from v.410  
changed lines
  Added in v.411

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0