[make annotateCombs properly annotate rules in supercombinators
John Meacham <john@repetae.net>**20080229122101] hunk ./E/Annotate.hs 19
-annotateCombs :: Monad m =>
+annotateCombs :: forall m . Monad m =>
hunk ./E/Annotate.hs 22
-    -> (E -> Info -> m Info) -- ^ annotate letbound bindings
-    -> (E -> Info -> m Info) -- ^ annotate lambdabound bindings
-    -> [Comb]            -- ^ terms to annotate
+    -> (E -> Info -> m Info)    -- ^ annotate letbound bindings
+    -> (E -> Info -> m Info)    -- ^ annotate lambdabound bindings
+    -> [Comb]                   -- ^ terms to annotate
hunk ./E/Annotate.hs 27
-annotateCombs imap idann letann lamann ds = do
-
-    cs <- forM ds $ \comb -> do
+annotateCombs imap idann letann lamann cs = do
+    cs <- forM cs $ \comb -> do
hunk ./E/Annotate.hs 33
-    cs <- forM cs $ \comb -> do
-        rs <- forM (combRules comb) $ \r -> do
-            r' <- annotate nimap idann letann lamann $ ruleBody r
-            return r { ruleBody = r' }
-        nb <- annotate nimap idann letann lamann (combBody comb)
+        f :: (IdMap (Maybe E)) -> E -> m E
+        f ni e = annotate ni idann letann lamann e
+    let mrule :: Rule -> m Rule
+        mrule r = do
+            let g tvr = do
+                nfo <- idann (tvrIdent tvr) (tvrInfo tvr)
+                let ntvr = tvr { tvrInfo = nfo }
+                return (ntvr,minsert (tvrIdent tvr) (Just $ EVar ntvr))
+            bs <- mapM g $ ruleBinds r
+            let nnimap = (foldr (.) id $ snds bs) nimap :: IdMap (Maybe E)
+            args <- mapM (f nnimap) (ruleArgs r)
+            body <- (f nnimap) (ruleBody r)
+            return r { ruleBinds = fsts bs, ruleBody = body, ruleArgs = args }
+    forM cs $ \comb -> do
+        rs <- mapM mrule (combRules comb)
+        nb <- f nimap (combBody comb)
hunk ./E/Annotate.hs 50
-    return cs
-
-
-    --let ds' = [ (combHead c,combBody c) | c <- ds]
-    --ELetRec { eDefs = ds'', eBody = Unknown } <- annotate imap idann letann lamann (ELetRec ds' Unknown)
-    -- TODO. slow
-    --return [ combBody_s y . combHead_s x $ c | c <- ds, (x,y) <- ds'', x == combHead c]
hunk ./E/Annotate.hs 53
-    -> (Id -> Info -> m Info)   -- ^ annotate based on Id map
-    -> (E -> Info -> m Info) -- ^ annotate letbound bindings
-    -> (E -> Info -> m Info) -- ^ annotate lambdabound bindings
-    -> [(TVr,E)]            -- ^ terms to annotate
+    -> (Id -> Info -> m Info)  -- ^ annotate based on Id map
+    -> (E -> Info -> m Info)   -- ^ annotate letbound bindings
+    -> (E -> Info -> m Info)   -- ^ annotate lambdabound bindings
+    -> [(TVr,E)]               -- ^ terms to annotate
hunk ./E/Annotate.hs 68
-    -> Program                -- ^ terms to annotate
+    -> Program                  -- ^ terms to annotate
hunk ./E/Annotate.hs 75
+type AM m = ReaderT (IdMap (Maybe E)) m
+
hunk ./E/Annotate.hs 80
-    -> (E -> Info -> m Info) -- ^ annotate letbound bindings
-    -> (E -> Info -> m Info) -- ^ annotate lambdabound bindings
-    ->  E            -- ^ term to annotate
+    -> (E -> Info -> m Info)    -- ^ annotate letbound bindings
+    -> (E -> Info -> m Info)    -- ^ annotate lambdabound bindings
+    ->  E                       -- ^ term to annotate