Mercurial > urweb
changeset 519:23a88d81a1b5
Optimize CoreUntangle
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 27 Nov 2008 11:40:13 -0500 |
| parents | 685d232bd1a5 |
| children | 3f20c22098af |
| files | src/core_untangle.sml |
| diffstat | 1 files changed, 20 insertions(+), 31 deletions(-) [+] |
line wrap: on
line diff
--- a/src/core_untangle.sml Thu Nov 27 11:17:56 2008 -0500 +++ b/src/core_untangle.sml Thu Nov 27 11:40:13 2008 -0500 @@ -37,22 +37,21 @@ 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 @@ 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 @@ 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 @@ end val sccs = topo (sccs, []) + (*val () = app (fn nodes => (print "SCC':"; IS.app (fn i => (print " "; print (Int.toString i))) nodes;