[allow printing of transformations as they happen, fix double simplification of letrec rhss, don't omit atomic substitutions right away, clean up code some
John Meacham <john@repetae.net>**20060419042339] hunk ./E/SSimplify.hs 7
+    programSSimplifyPStat,
hunk ./E/SSimplify.hs 346
-    Identity (stat,[(_,e')]) =  simplifyDs program sopts [(tvrSilly,e)]
+    Identity ([(_,e')],stat) =  runStatT $ simplifyDs program sopts [(tvrSilly,e)]
hunk ./E/SSimplify.hs 350
-    Identity (stats,dsIn) = simplifyDs prog sopts (programDs prog)
+    Identity (dsIn,stats) = runStatT $ simplifyDs prog sopts (programDs prog)
hunk ./E/SSimplify.hs 353
+programSSimplifyPStat :: SimplifyOpts -> Program -> IO Program
+programSSimplifyPStat sopts prog = do
+    setPrintStats True
+    dsIn <- simplifyDs prog sopts (programDs prog)
+    return (programSetDs dsIn prog)
+
hunk ./E/SSimplify.hs 365
-type SM m = IdNameT (StatT m)
+type SM m = IdNameT m
hunk ./E/SSimplify.hs 367
-simplifyDs :: forall m . Monad m => Program -> SimplifyOpts -> [(TVr,E)] -> m (Stat,[(TVr,E)])
+simplifyDs :: forall m . MonadStats m => Program -> SimplifyOpts -> [(TVr,E)] -> m [(TVr,E)]
hunk ./E/SSimplify.hs 370
-        ((dsOut,_),stat) <- runStatT (runIdNameT doit)
-        return (stat,dsOut)
+        (dsOut,_) <- (runIdNameT doit)
+        return dsOut
hunk ./E/SSimplify.hs 380
-        ds' <- sequence [etaExpandDef' (so_dataTable sopts) t e | (t,e) <- dsIn ]
-        doDs ds' initialB
+        --ds' <- sequence [etaExpandDef' (so_dataTable sopts) t e | (t,e) <- dsIn ]
+        doDs dsIn initialB
hunk ./E/SSimplify.hs 621
-                Just IsBoundTo { bindingE = e } | not (forceNoinline v), isAtomic e  -> do
+                Just IsBoundTo { bindingE = e } | isAtomic e  -> do
hunk ./E/SSimplify.hs 659
-        mtick (toAtom "E.Simplify.case-application")
+        mticks (length xs) (toAtom "E.Simplify.case-application")
hunk ./E/SSimplify.hs 665
-        mtick (toAtom "E.Simplify.let-application")
+        mticks (length xs) (toAtom "E.Simplify.let-application")
hunk ./E/SSimplify.hs 669
-        mtick (toAtom "E.Simplify.error-application")
+        mticks (length xs) (toAtom "E.Simplify.error-application")
hunk ./E/SSimplify.hs 675
-        let z (t,EVar t') | t == t' = do    -- look for simple loops and replace them with errors.
+        let z :: (InTVr,InE) -> SM m (Id,Occurance,OutTVr,InE)
+            z (t,EVar t') | t == t' = do    -- look for simple loops and replace them with errors.
hunk ./E/SSimplify.hs 689
+            w :: [(Id,Occurance,OutTVr,InE)] -> Env -> [(OutTVr,OutE)] -> SM m ([(OutTVr,OutE)],Env)
hunk ./E/SSimplify.hs 692
-                w rs (insertSuspSubst' t e inb) ds -- (minsert t (Susp e sub) sub) inb ds
+                w rs inb ds -- (minsert t (Susp e sub) sub) inb ds
hunk ./E/SSimplify.hs 694
-                let inb' = if not (so_finalPhase sopts) && forceInline t' then envInScope_u (fmap (const NotKnown)) inb else inb
+                let inb' = if not (so_finalPhase sopts) && forceInline t' then (cacheSubst $ envInScope_u (fmap (const NotKnown)) inb) else inb
hunk ./E/SSimplify.hs 696
+                w rs (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb)  ((t',e'):ds)
hunk ./E/SSimplify.hs 698
-                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)
+                --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)
hunk ./E/SSimplify.hs 704
-                    False -> w rs (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb)  ((t',e'):ds)
+                --    _ -> w rs (cacheSubst $ envInScope_u (minsert (tvrIdent t') (isBoundTo n e')) inb)  ((t',e'):ds)
hunk ./E/SSimplify.hs 706
-        ds <- sequence [ etaExpandDef' (so_dataTable sopts) t e | (t,e) <- ds]
hunk ./E/SSimplify.hs 709
+        ds' <- sequence [ etaExpandDef' (so_dataTable sopts) t e | (t,e) <- ds']