[make programMapRecGroups allow an initial substitution and propagate tvrInfo fields properly.
John Meacham <john@repetae.net>**20060308091351] hunk ./E/Inline.hs 20
+import qualified Data.Map as Map
hunk ./E/Inline.hs 26
+import E.Annotate
hunk ./E/Inline.hs 119
+
+-- | Map recursive groups, allowing an initial map to be passed in and it will
+-- also propagate changes in the tvrInfo properly, and make sure nothing
+-- shadows one of the global names.
+
hunk ./E/Inline.hs 125
-    ((Bool,[(TVr,E)]) -> m [(TVr,E)])  -- ^ bool is true if group is recursive.
+    Map.Map Id (Maybe E)        -- ^ initial map to apply
+    -> (Id -> Info -> m Info)   -- ^ annotate based on Id map
+    -> (E -> Info -> m Info)    -- ^ annotate letbound bindings
+    -> (E -> Info -> m Info)    -- ^ annotate lambdabound bindings
+    -> ((Bool,[(TVr,E)]) -> m [(TVr,E)])  -- ^ bool is true if group is recursive.
hunk ./E/Inline.hs 132
-programMapRecGroups f prog = do
-    let g (Left d) = f (False,[d])
-        g (Right ds) = f (True,ds)
-    nds <- mapM g $ decomposeDs (programDs prog)
-    return $ programSetDs (concat nds) prog
+programMapRecGroups imap idann letann lamann f prog = do
+    let g rs imap (Left d:rds) = do
+            [d'] <- annotateDs imap idann letann lamann [d]
+            nds <- f (False,[d'])
+            g (nds:rs) (bm nds imap) rds
+        g rs imap (Right ds:rds) = do
+            ds' <- annotateDs imap idann letann lamann ds
+            nds <- f (True,ds')
+            let imap' = (bm nds imap)
+            let smap = substMap'' $ Map.fromList [ (tvrIdent x,EVar x) | (x,y) <- nds]
+                nds' = [ (x,smap y) | (x,y) <- nds]
+            g (nds':rs) imap' rds
+        g rs _ [] = return $ concat rs
+        bm xs imap = Map.fromList [ (tvrIdent t,Just $ EVar t) | (t,_) <- xs ] `Map.union` imap
+    ds <- g [] imap $ decomposeDs (programDs prog)
+    return $ programSetDs ds prog