[move a bunch of stuff from working on ds's to combinators.
John Meacham <john@repetae.net>**20080221032342] hunk ./E/Annotate.hs 19
+annotateCombs :: Monad m =>
+    (IdMap (Maybe E))
+    -> (Id -> Info -> m Info)   -- ^ annotate based on Id map
+    -> (E -> Info -> m Info) -- ^ annotate letbound bindings
+    -> (E -> Info -> m Info) -- ^ annotate lambdabound bindings
+    -> [Comb]            -- ^ terms to annotate
+    -> m [Comb]
+
+annotateCombs imap idann letann lamann ds = do
+    let ds' = [ (combHead c,combBody c) | c <- ds]
+    ELetRec { eDefs = ds'', eBody = Unknown } <- annotate imap idann letann lamann (ELetRec ds' Unknown)
+    return [ combBody_s y . combHead_s x $ emptyComb | (x,y) <- ds'']
+
hunk ./E/Annotate.hs 52
-    ds <- annotateDs imap idann letann lamann (programDs prog)
-    return $ programSetDs ds prog
+    ds <- annotateCombs imap idann letann lamann (progCombinators prog)
+    return $ programUpdate $ prog { progCombinators = ds }
hunk ./E/Eta.hs 124
-        let (ts',fs) = runState (annotateDs mempty pass letann pass ts) False
+        let (ts',fs) = runState (annotateCombs mempty pass letann pass ts) False
hunk ./E/FreeVars.hs 124
+-- note, we include references to this combinator in its free variables.
hunk ./E/FreeVars.hs 126
-    freeVars a = delete (tvrIdent $ combHead a) $ freeVars (combBody a) `union` (freeVars $ combRules a)
+    freeVars a = freeVars (combBody a) `union` (freeVars $ combRules a)
hunk ./E/Inline.hs 7
-    programMapProgComponents,
hunk ./E/Inline.hs 20
+import Support.FreeVars
hunk ./E/Inline.hs 104
-    -> ((Bool,[(TVr,E)]) -> m [(TVr,E)])  -- ^ bool is true if group is recursive.
+    -> ((Bool,[Comb]) -> m [Comb])  -- ^ bool is true if group is recursive.
hunk ./E/Inline.hs 108
-    let g rs imap (Left d:rds) = do
-            [d'] <- annotateDs imap idann letann lamann [d]
-            nds <- f (False,[d'])
+    let g rs imap ((False,ds):rds) = do
+            ds' <- annotateCombs imap idann letann lamann ds
+            nds <- f (False,ds')
hunk ./E/Inline.hs 112
-        g rs imap (Right ds:rds) = do
-            ds' <- annotateDs imap idann letann lamann ds
+        g rs imap ((True,ds):rds) = do
+            ds' <- annotateCombs imap idann letann lamann ds
hunk ./E/Inline.hs 116
-            let smap = substMap' $ fromList [ (tvrIdent x,EVar x) | (x,y) <- nds]
-                nds' = [ (x,smap y) | (x,y) <- nds]
+            let smap = substMap' $ fromList [ (combIdent  x,EVar (combHead  x)) | x <- nds]
+                nds' = [ combBody_u smap x | x <- nds]
hunk ./E/Inline.hs 120
-        bm xs imap = fromList [ (tvrIdent t,Just $ EVar t) | (t,_) <- xs ] `union` imap
-    ds <- g [] imap $ programDecomposedDs prog
-    return $ programSetDs ds prog
-
-
+        bm xs imap = fromList [ (combIdent c,Just $ EVar (combHead c)) | c <- xs ] `union` imap
+    ds <- g [] imap $ programDecomposedCombs prog
+    return $ programUpdate $ prog { progCombinators = ds }
hunk ./E/Inline.hs 124
+programDecomposedCombs :: Program -> [(Bool,[Comb])]
+programDecomposedCombs prog = map f $ scc g where
+    g = newGraph (progCombinators prog) combIdent (toList . (freeVars :: Comb -> IdSet))
+    f (Left c) = (False,[c])
+    f (Right cs) = (True,cs)
hunk ./E/Inline.hs 134
-programComponents :: Program -> [[(TVr,E)]]
-programComponents prog = components $ newGraph (programDs prog) (tvrIdent . fst) (toList . uncurry bindingFreeVars)
-
-programSubProgram prog rec ds = programSetDs ds prog { progType = SubProgram rec, progEntryPoints = map fst ds }
+programSubProgram prog rec ds = prog { progCombinators = ds, progType = SubProgram rec, progEntryPoints = map combHead ds }
hunk ./E/Inline.hs 142
-    let g prog' rs imap (Left d:rds) = do
-            [d'] <- annotateDs imap nann nann nann [d]
-            nprog <- f (programSubProgram prog' False [d'])
-            let nds = programDs nprog
+    let g prog' rs imap ((False,ds):rds) = do
+            ds' <- annotateCombs imap nann nann nann ds
+            nprog <- f (programSubProgram prog' False ds')
+            let nds = progCombinators nprog
hunk ./E/Inline.hs 147
-        g prog' rs imap (Right ds:rds) = do
-            ds' <- annotateDs imap nann nann nann ds
+        g prog' rs imap ((True,ds):rds) = do
+            ds' <- annotateCombs imap nann nann nann ds
hunk ./E/Inline.hs 151
-                smap = substMap' $ fromList [ (tvrIdent x,EVar x) | (x,y) <- nds]
-                nds = programDs nprog
-                nds' = [ (x,smap y) | (x,y) <- nds]
+                smap = substMap' $ fromList [ (combIdent  x,EVar (combHead  x)) | x <- nds]
+                nds = progCombinators nprog
+                nds' = [ combBody_u smap x | x <- nds]
hunk ./E/Inline.hs 156
-        bm xs imap = fromList [ (tvrIdent t,Just $ EVar t) | (t,_) <- xs ] `union` imap
+        bm xs imap = fromList [ (combIdent c,Just $ EVar (combHead c)) | c <- xs ] `union` imap
hunk ./E/Inline.hs 158
-        unames ds prog = prog { progExternalNames = progExternalNames prog `mappend` fromList [ tvrIdent t | (t,_) <- ds ] }
-    (ds,prog'') <- g prog { progStats = mempty } [] imap $ programDecomposedDs prog
-    return $ programSetDs ds prog { progStats = progStats prog `mappend` progStats prog'' }
+        unames ds prog = prog { progExternalNames = progExternalNames prog `mappend` fromList (map combIdent ds) }
+    (ds,prog'') <- g prog { progStats = mempty } [] imap $ programDecomposedCombs prog
+    return $ programUpdate $ prog { progCombinators = ds, progStats = progStats prog `mappend` progStats prog'' }
hunk ./E/Inline.hs 163
-programMapProgComponents :: Monad m =>
-    (Program -> m Program)
-    -> Program
-    -> m Program
-programMapProgComponents f prog = do
-    let prog' = prog { progStats = mempty, progType = MainComponent }
-        g ds = f (programSetDs ds prog')
-    ps <- mapM g (programComponents prog)
-    return $ programSetDs (concatMap programDs ps) prog { progStats = progStats prog `mappend` (mconcat $ map progStats ps) }
-
hunk ./E/Program.hs 65
+
+programUpdate ::  Program -> Program
+programUpdate prog = check prog where
+    ds = progCombinators prog
+    check x
+        | not flint = x
+        | hasRepeatUnder combIdent ds = error $ "programSetDs: program has redundant definitions: \n" ++ names
+        | any (not . isValidAtom) (map combIdent ds) = error $ "programSetDs: trying to set non unique top level name: \n" ++ names
+        | otherwise = x
+    names = intercalate "\n"  (sort $ map (show . tvrShowName . combHead) ds)