summaryrefslogtreecommitdiff
path: root/src/core_untangle.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-04 09:33:35 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-04 09:33:35 -0500
commit627c93b9779f632bd8d90e7e2de26a5a9c197f08 (patch)
treee40f2a8767966c59e146479de02ec297958fc3c3 /src/core_untangle.sml
parent24483b49c81a6ac1c99cd28ca3505150b5999863 (diff)
Nested demo
Diffstat (limited to 'src/core_untangle.sml')
-rw-r--r--src/core_untangle.sml36
1 files changed, 32 insertions, 4 deletions
diff --git a/src/core_untangle.sml b/src/core_untangle.sml
index 6f424614..ededded0 100644
--- a/src/core_untangle.sml
+++ b/src/core_untangle.sml
@@ -45,6 +45,15 @@ fun exp (e, 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 decl (dAll as (d, loc)) =
case d of
DValRec vis =>
@@ -52,16 +61,35 @@ 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 used = foldl (fn ((_, n, _, e, _), used) =>
let
- val usedHere = U.Exp.fold {con = default,
- kind = default,
- exp = exp} IS.empty e
+ val usedHere = expUsed e
in
- IM.insert (used, n, IS.intersection (usedHere, thisGroup))
+ IM.insert (used, n, usedHere)
end)
IM.empty vis
+ 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)
+ 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);