[use same algorithm for top level bindings as LetRec ones, consider more inlinings beneficial, allow arbitrary inlining in final phase.
John Meacham <john@repetae.net>**20060419020944] hunk ./E/SSimplify.hs 12
+import Control.Monad.Reader
hunk ./E/SSimplify.hs 70
-        (dsIn',(OMap fvs,uids)) = runReaderWriter (unOM $ collectDs dsIn $ if progClosed prog then mempty else fromList $ map (flip (,) Many) (map (tvrIdent . fst) dsIn)) ()
+        (dsIn',(OMap fvs,uids)) = runReaderWriter (unOM $ collectDs dsIn $ if progClosed prog then mempty else fromList $ map (flip (,) Many) (map (tvrIdent . fst) dsIn)) (fromList $ map tvrIdent $ progEntryPoints prog)
hunk ./E/SSimplify.hs 74
-newtype OM a = OM (ReaderWriter () (OMap,IdSet) a)
-    deriving(Monad,Functor,MonadWriter (OMap,IdSet))
+newtype OM a = OM (ReaderWriter IdSet (OMap,IdSet) a)
+    deriving(Monad,Functor,MonadWriter (OMap,IdSet),MonadReader IdSet)
hunk ./E/SSimplify.hs 97
-    (fe,(OMap omap,_)) = runReaderWriter (unOM $ collectOccurance e) ()
+    (fe,(OMap omap,_)) = runReaderWriter (unOM $ collectOccurance e) mempty
hunk ./E/SSimplify.hs 203
+    exp <- ask
hunk ./E/SSimplify.hs 205
-        rds = reachable graph (mkeys fve ++ [ tvrIdent t | (t,_) <- ds, getProperty prop_EXPORTED t])
+        rds = reachable graph (mkeys fve ++ [ tvrIdent t | (t,_) <- ds, getProperty prop_EXPORTED t || (tvrIdent t `member` exp)])
hunk ./E/SSimplify.hs 217
-            False -> case getProperty prop_EXPORTED t of
+            False -> case getProperty prop_EXPORTED t || (tvrIdent t `member` exp) of
hunk ./E/SSimplify.hs 255
-    so_dataTable :: DataTable,             -- ^ the data table
-    so_exports :: [Int]
+    so_dataTable :: DataTable              -- ^ the data table
hunk ./E/SSimplify.hs 362
+    exportedSet = fromList $ map tvrIdent (progEntryPoints prog) :: IdSet
hunk ./E/SSimplify.hs 366
-    (dsOut,stat)  = runIdentity $ runStatT (runIdNameT doit)
+    ((dsOut,_),stat)  = runIdentity $ runStatT (runIdNameT doit)
hunk ./E/SSimplify.hs 372
-        let g (t,e) = do
-                e' <- if not (so_finalPhase sopts) && forceInline t  then
-                        f e initialB'  -- ^ do not inline into functions which themself will be inlined
-                            else f e initialB
-                return (t,e')
-        mapM g ds'
+        doDs ds' initialB
+--        let g (t,e) = do
+--                e' <- if not (so_finalPhase sopts) && forceInline t  then
+--                        f e initialB'  -- ^ do not inline into functions which themself will be inlined
+--                            else f e initialB
+--                return (t,e')
+--        mapM g ds'
hunk ./E/SSimplify.hs 440
-        addNames $ map (tvrIdent . fst) ds
-        let z (t,EVar t') | t == t' = do    -- look for simple loops and replace them with errors.
-                t'' <- nname t inb
-                mtick $ "E.Simplify.<<loop>>.{" ++ showName (tvrIdent t) ++ "}"
-                return (tvrIdent t,Many,t'',EError "<<loop>>" (getType t))
-            z (t,e) = do
-                t' <- nname t inb
-                case Info.lookup (tvrInfo t) of
-                    _ | forceNoinline t -> return (tvrIdent t,LoopBreaker,t',e)
-                    Just Once -> return (tvrIdent t,Once,error $ "Once: " ++ show t,e)
-                    Just n -> return (tvrIdent t,n,t',e)
-                    -- We don't want to inline things we don't have occurance info for because they might lead to an infinite loop. hopefully the next pass will fix it.
-                    Nothing -> return (tvrIdent t,LoopBreaker,t',e)
-                    -- Nothing -> error $ "No Occurance info for " ++ show t
-            w ((t,Once,t',e):rs) inb ds = do
-                mtick $ "E.Simplify.inline.Once.{" ++ showName t ++ "}"
-                w rs (insertSuspSubst' t e inb) ds -- (minsert t (Susp e sub) sub) inb ds
-            w ((t,n,t',e):rs) inb ds = do
-                e' <- f e inb
-                case isAtomic e' && n /= LoopBreaker of
-                    True -> do
-                        when (n /= Unused) $ mtick $ "E.Simplify.inline.Atomic.{" ++ showName t ++ "}"
-                        w rs (insertDoneSubst' t e' . envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) $ inb) ds -- ((t',e'):ds) -- (minsert t (Done e') sub) (envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb) ((t',e'):ds)
-                    -- False | worthStricting e', Strict <- Info.lookup (tvrInfo t') -> w rs sub
-                    False -> w rs (if n /= LoopBreaker then (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb) else inb) ((t',e'):ds)
-            w [] inb ds = return (ds,inb)
-        ds <- sequence [ etaExpandDef' (so_dataTable sopts) t e | (t,e) <- ds]
-        s' <- mapM z ds
-        let
-            --sub'' = {- Map.fromList [ (t,Susp e sub'') | (t,Once,_,e) <- s'] `Map.union`-} ([ (t,Done (EVar t'))  | (t,n,t',_) <- s', n /= Once]) `union` sub
-            sub'' = fromList [ (t,susp e sub'') | (t,Once,_,e) <- s'] `union` fromList [ (t,Done (EVar t'))  | (t,n,t',_) <- s', n /= Once] `union` envSubst inb
-        (ds',inb') <- w s'  (cacheSubst (envSubst_s sub'' $ envInScope_u (fromList [ (tvrIdent t',NotKnown) | (_,n,t',_) <- s', n /= Once] `union`) inb)) []
+        (ds',inb') <- doDs ds inb
hunk ./E/SSimplify.hs 612
-                Just IsBoundTo { bindingE = e } | forceInline v -> do
+                Just IsBoundTo { bindingE = e } | not (forceNoinline v), isAtomic e  -> do
+                    mtick  (toAtom $ "E.Simplify.inline.atomic.{" ++ tvrShowName v  ++ "}")
+                    didInline inb e xs'
+                Just IsBoundTo { bindingE = e } | not (so_finalPhase sopts), forceInline v, someBenefit v e xs' -> do
hunk ./E/SSimplify.hs 664
+    doDs ds inb = do
+        addNames $ map (tvrIdent . fst) ds
+        let z (t,EVar t') | t == t' = do    -- look for simple loops and replace them with errors.
+                t'' <- nname t inb
+                mtick $ "E.Simplify.<<loop>>.{" ++ showName (tvrIdent t) ++ "}"
+                return (tvrIdent t,Many,t'',EError "<<loop>>" (getType t))
+            z (t,e) = do
+                t' <- nname t inb
+                case Info.lookup (tvrInfo t) of
+                    _ | forceNoinline t -> return (tvrIdent t,LoopBreaker,t',e)
+                    Just Once -> return (tvrIdent t,Once,error $ "Once: " ++ show t,e)
+                    Just n -> return (tvrIdent t,n,t',e)
+                    -- We don't want to inline things we don't have occurance info for because they might lead to an infinite loop. hopefully the next pass will fix it.
+                    Nothing -> return (tvrIdent t,LoopBreaker,t',e)
+                    -- Nothing -> error $ "No Occurance info for " ++ show t
+            w ((t,Once,t',e):rs) inb ds = do
+                mtick $ "E.Simplify.inline.Once.{" ++ showName t ++ "}"
+                w rs (insertSuspSubst' t e inb) ds -- (minsert t (Susp e sub) sub) inb ds
+            w ((t,n,t',e):rs) inb ds = do
+                let inb' = if not (so_finalPhase sopts) && forceInline t' then envInScope_u (fmap (const NotKnown)) inb else inb
+                e' <- f e inb'
+--                w rs (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb) ((t',e'):ds)
+                w rs (if n /= LoopBreaker then (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb) else inb) ((t',e'):ds)
+                case isAtomic e' && n /= LoopBreaker && t `notMember` exportedSet  of
+                    True -> do
+                        when (n /= Unused) $ mtick $ "E.Simplify.inline.Atomic.{" ++ showName t ++ "}"
+                        w rs (insertDoneSubst' t e' . envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) $ inb) ds -- ((t',e'):ds) -- (minsert t (Done e') sub) (envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb) ((t',e'):ds)
+                    --False -> w rs (if n /= LoopBreaker then (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb) else inb) ((t',e'):ds)
+                    False -> w rs (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb)  ((t',e'):ds)
+            w [] inb ds = return (ds,inb)
+        ds <- sequence [ etaExpandDef' (so_dataTable sopts) t e | (t,e) <- ds]
+        s' <- mapM z ds
+        let sub'' = fromList [ (t,susp e sub'') | (t,Once,_,e) <- s'] `union` fromList [ (t,Done (EVar t'))  | (t,n,t',_) <- s', n /= Once] `union` envSubst inb
+        (ds',inb') <- w s'  (cacheSubst (envSubst_s sub'' $ envInScope_u (fromList [ (tvrIdent t',NotKnown) | (_,n,t',_) <- s', n /= Once] `union`) inb)) []
+        return (ds',inb')
hunk ./E/SSimplify.hs 702
+someBenefit _ e _ | isAtomic e = True
hunk ./E/SSimplify.hs 704
+someBenefit _ EPi {} _ = True
hunk ./E/SSimplify.hs 706
+someBenefit v (ELetRec ds e) xs | someBenefit v e xs = True
+someBenefit _v ECase {} _ = True