Optimize CoreUntangle

1 files changed, 20 insertions, 31 deletions

diff --git a/src/core_untangle.sml b/src/core_untangle.sml
index ededded0..1b34fe8f 100644
--- a/src/core_untangle.sml
+++ b/src/core_untangle.sml
@@ -37,22 +37,21 @@ structure IM = IntBinaryMap
 
 fun default (k, s) = s
 
-fun exp (e, s) =
+fun exp thisGroup (e, s) =
     case e of
-        ENamed n => IS.add (s, n)
+        ENamed n =>
+        if IS.member (thisGroup, n) then
+            IS.add (s, n)
+        else
+            s
 
       | _ => s
 
 fun untangle file =
     let
-        val edefs = foldl (fn ((d, _), edefs) =>
-                              case d of
-                                  DVal (_, n, _, e, _) => IM.insert (edefs, n, e)
-                                | DValRec vis =>
-                                  foldl (fn ((_, n, _, e, _), edefs) =>
-                                            IM.insert (edefs, n, e)) edefs vis
-                                | _ => edefs)
-                    IM.empty file
+        fun expUsed thisGroup = U.Exp.fold {con = default,
+                                            kind = default,
+                                            exp = exp thisGroup} IS.empty
 
         fun decl (dAll as (d, loc)) =
             case d of
@@ -61,35 +60,23 @@ fun untangle file =
                     val thisGroup = foldl (fn ((_, n, _, _, _), thisGroup) =>
                                               IS.add (thisGroup, n)) IS.empty vis
 
-                    val expUsed = U.Exp.fold {con = default,
-                                              kind = default,
-                                              exp = exp} IS.empty
+                    val edefs = foldl (fn ((_, n, _, e, _), edefs) =>
+                                         IM.insert (edefs, n, expUsed thisGroup e))
+                                     IM.empty vis
 
-                    val used = foldl (fn ((_, n, _, e, _), used) =>
-                                       let
-                                           val usedHere = expUsed e
-                                       in
-                                           IM.insert (used, n, usedHere)
-                                       end)
-                               IM.empty vis
+                    val used = edefs
 
                     fun expand used =
                         IS.foldl (fn (n, used) =>
                                      case IM.find (edefs, n) of
                                          NONE => used
-                                       | SOME e =>
-                                         let
-                                             val usedHere = expUsed e
-                                         in
-                                             if IS.isEmpty (IS.difference (usedHere, used)) then
-                                                 used
-                                             else
-                                                 expand (IS.union (usedHere, used))
-                                         end)
+                                       | SOME usedHere =>
+                                         if IS.isEmpty (IS.difference (usedHere, used)) then
+                                             used
+                                         else
+                                             expand (IS.union (usedHere, used)))
                         used used
 
-                    val used = IM.map (fn s => IS.intersection (expand s, thisGroup)) used
-
                     fun p_graph reachable =
                         IM.appi (fn (n, reachableHere) =>
                                     (print (Int.toString n);
@@ -164,6 +151,7 @@ fun untangle file =
                             end
 
                     val sccs = sccs (thisGroup, [])
+
                     (*val () = app (fn nodes => (print "SCC:";
                                                IS.app (fn i => (print " ";
                                                                 print (Int.toString i))) nodes;
@@ -199,6 +187,7 @@ fun untangle file =
                             end
 
                     val sccs = topo (sccs, [])
+
                     (*val () = app (fn nodes => (print "SCC':";
                                                IS.app (fn i => (print " ";
                                                                 print (Int.toString i))) nodes;