[start making ssimplify work on sets of mutually recursive declarations
John Meacham <john@repetae.net>**20051018030610] hunk ./E/SSimplify.hs 1
-module E.SSimplify(Occurance(..), simplify, SimplifyOpts(..)) where
+module E.SSimplify(Occurance(..), simplifyE, simplifyDs, SimplifyOpts(..)) where
hunk ./E/SSimplify.hs 16
+import E.Annotate
hunk ./E/SSimplify.hs 45
-    deriving(Show,Eq,Ord)
+    deriving(Show,Eq,Ord,Typeable)
hunk ./E/SSimplify.hs 177
-simplify :: SimplifyOpts -> E -> (E,Stat, Map.Map TVr Occurance)
-simplify sopts e = (e'',stat,occ) where
-    (e',fvs,occ) = collectOcc sopts  e
-    addN = do
-        addNames (map tvrNum $ Map.keys occ)
+simplifyE :: SimplifyOpts -> E -> (Stat,E)
+simplifyE sopts e = (stat,e') where
+    (stat,[(_,e')]) =  simplifyDs sopts [(tvrSilly,e)]
+
+simplifyDs :: SimplifyOpts -> [(TVr,E)] -> (Stat,[(TVr,E)])
+simplifyDs sopts dsIn = (stat,dsOut) where
+    collocc dsIn = do
+        let ((ELetRec dsIn' _),fvs,occ) = collectOcc sopts (ELetRec dsIn (eTuple (map EVar (fsts dsIn))))
+        addNames (map tvrIdent $ Map.keys occ)
hunk ./E/SSimplify.hs 187
+        let occ' = Map.mapKeysMonotonic tvrIdent occ
+            dsIn'' = runIdentity $ annotateDs mempty (\t nfo -> return $ maybe (Info.delete Many nfo) (flip Info.insert nfo) (Map.lookup t occ')) (\_ -> return) (\_ -> return) dsIn'
+        return dsIn''
hunk ./E/SSimplify.hs 191
-    (e'',stat)  = runIdentity $ runStatT (runNameMT (addN >> f e' mempty initialB)) -- (e,mempty)
+    initialB' = mempty { envInScope =  Map.map (\e -> NotKnown) (so_boundVars sopts) }
+    (dsOut,stat)  = runIdentity $ runStatT (runNameMT doit)
+    doit = do
+        ds' <- collocc dsIn
+        let g (t,e) = do
+                e' <- if forceInline t then
+                        f e mempty initialB'  -- ^ do not inline into functions which themself will be inlined
+                            else f e mempty initialB
+                return (t,e')
+        mapM g ds'
hunk ./E/SSimplify.hs 241
-    --g (EVar v) sub inb = do
-    --    case Map.lookup (tvrNum v) sub of
-   --         Just (Done e) -> return e
-    --        Just (Susp e s) -> do
-    --            e' <- f e s inb
-    --            return e'
-            --Nothing -> return (EVar v)
-    --        Nothing -> error $ "vvar with no subst: " ++ show (EVar v) -- h (EVar v) xs' inb
hunk ./E/SSimplify.hs 256
-                case Map.lookup t occ of
+                case Info.lookup (tvrInfo t) of
hunk ./Main.hs 193
-            let (e',stat,occ) = SS.simplify sopt e
+            let (stat, e') = SS.simplifyE sopt e
hunk ./Main.hs 326
-        let (e',stat,occ) = SS.simplify sopt e
+        let (stat, e') = SS.simplifyE sopt e
hunk ./Main.hs 348
-        let (e',stat,occ) = SS.simplify sopt e
+        let (stat, e') = SS.simplifyE sopt e
hunk ./Main.hs 368
-            let (e',stat,occ) = SS.simplify sopt e
+            let (stat, e') = SS.simplifyE sopt e