diff src/core_untangle.sml @ 455:d4a81273d4b1

Nested demo
author Adam Chlipala <adamc@hcoop.net>
date Tue, 04 Nov 2008 09:33:35 -0500
parents 9163f8014f9b
children 23a88d81a1b5
line wrap: on
line diff
--- a/src/core_untangle.sml	Sat Nov 01 21:24:43 2008 -0400
+++ b/src/core_untangle.sml	Tue Nov 04 09:33:35 2008 -0500
@@ -45,6 +45,15 @@
 
 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 @@
                     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);