[Make the simplifier O(n) instead of O(n^2)
Lemmih <lemmih@gmail.com>**20081120233412
 Ignore-this: 9ef7955e492aa9f36cecd3b7e6b01c80
] hunk ./E/SSimplify.hs 37
-import GenUtil
+import GenUtil hiding (split)
hunk ./E/SSimplify.hs 58
+import System.Random
+import Debug.Trace
+
hunk ./E/SSimplify.hs 83
-    let dsIn = progCombinators (runIdentity $ programMapBodies (return . subst (tVr (-1) Unknown) Unknown) prog)
+    let dsIn = progCombinators prog -- (runIdentity $ programMapBodies (return . subst (tVr (-1) Unknown) Unknown) prog)
hunk ./E/SSimplify.hs 85
-    in (progCombinators_s dsIn' prog) { progFreeIds = idMapToIdSet fvs, progUsedIds = uids }
+    in --trace ("dsIn: "++show (length dsIn)) $
+       (progCombinators_s dsIn' prog) { progFreeIds = idMapToIdSet fvs, progUsedIds = uids }
hunk ./E/SSimplify.hs 308
-data Range = Done OutE | Susp InE Subst OutE -- cached result
+data Range = Done OutE | Susp InE Subst
hunk ./E/SSimplify.hs 367
-susp e sub =  Susp e sub Unknown
+susp e sub =  Susp e sub
hunk ./E/SSimplify.hs 418
-    g (Susp e s' _) = doSubst' False False (applySubst' s') check e
+    g (Susp e s') = doSubst' False False (applySubst' s') check e
hunk ./E/SSimplify.hs 422
-evalRange (Susp e s _) = localEnv (envSubst_s s)  $ dosub e
+evalRange (Susp e s) = localEnv (envSubst_s s)  $ dosub e
hunk ./E/SSimplify.hs 457
-    | ArgContext
+--    | ArgContext
hunk ./E/SSimplify.hs 459
-    | Scrutinee {
+{-    | Scrutinee {
hunk ./E/SSimplify.hs 461
-        }
+        }-}
hunk ./E/SSimplify.hs 488
-    f ArgContext e = dosub e
+--    f ArgContext e = dosub e
hunk ./E/SSimplify.hs 504
-            Just (Susp e s _) -> localEnv (envSubst_s s)  $ f cont e
+            Just (Susp e s) -> localEnv (envSubst_s s)  $ f cont e
hunk ./E/SSimplify.hs 527
-        e' <- f (Scrutinee (not $ null as)) e
+--        e' <- f (Scrutinee (not $ null as)) e
+        e' <- f StartContext e
hunk ./E/SSimplify.hs 558
-    f cont e = dosub e >>= done cont
---    f cont e | isApplyTo cont = els
---             | otherwise = tryEta
---            where
---            els = do
---                x' <- dosub e
---                done cont x'
---            tryEta = do
---                eed <- etaExpandDef (so_dataTable sopts) 0 tvr { tvrIdent = 0 } e
---                case eed of
---                    Just (_,e) -> f cont e
---                    Nothing -> els
+    f cont e = trace ("Fall through: " ++ show (cont,e)) $ dosub e >>= done cont
hunk ./E/SSimplify.hs 563
+    -- Rename a if necessary. We always have to substitute all occurrences because we update the type.
hunk ./E/SSimplify.hs 782
-            z <- h e (reverse rs)
+            z <- hFunc e (reverse rs)
hunk ./E/SSimplify.hs 784
-        z _ rs = h e (reverse rs)
-    h :: OutE -> [OutE] -> SM OutE
-    h (EVar v) xs' = do
+        z _ rs = hFunc e (reverse rs)
+    hFunc :: OutE -> [OutE] -> SM OutE
+    hFunc (EVar v) xs' = do
hunk ./E/SSimplify.hs 824
-    h e xs' = do app (e,xs')
+    hFunc e xs' = do app (e,xs')
hunk ./E/SSimplify.hs 826
+    didInline z zs = return (foldl EAp z zs)
hunk ./E/SSimplify.hs 847
---    app' ec@ECase {} xs = do
---        mticks (length xs) (toAtom "E.Simplify.case-application")
---        let f e = app' e xs
---        ec' <- caseBodiesMapM f ec
---        let t = foldl eAp (eCaseType ec') xs
---        return $ caseUpdate ec' { eCaseType = t }
---    app' ELetRec { eDefs = ds, eBody = e } xs = do
---        mticks (length xs) (toAtom "E.Simplify.let-application")
---        e' <- app' e xs
---        return $ eLetRec ds e'
hunk ./E/SSimplify.hs 1005
-    idsBound :: !IdSet
+    idsBound :: !IdSet,
+    smStdGen :: !StdGen
hunk ./E/SSimplify.hs 1009
-smState = SmState { idsUsed = mempty, idsBound = mempty }
+smState = SmState { idsUsed = mempty, idsBound = mempty, smStdGen = mkStdGen 42 }
hunk ./E/SSimplify.hs 1012
-    deriving(Monad,Functor,MonadReader Env)
+    deriving(Monad,Functor,MonadReader Env, MonadState SmState)
hunk ./E/SSimplify.hs 1025
-    f s@SmState { idsUsed = used, idsBound = bound } = case fn (used,bound) of (used',bound') -> s { idsUsed = used', idsBound = bound' }
+    f s@SmState { idsUsed = used, idsBound = bound, smStdGen=gen } = case fn (used,bound) of (used',bound') -> s { idsUsed = used', idsBound = bound', smStdGen = gen }
hunk ./E/SSimplify.hs 1033
-        modifyIds (\ (used,bound) -> (fromList ns `union` used, bound) )
+        modifyIds (\ (used,bound) -> -- trace ("AddNames: " ++ show (size used,size bound)) $
+                   (fromList ns `union` used, bound) )
hunk ./E/SSimplify.hs 1037
-        modifyIds (\ (used,bound) -> (nset `union` used, nset `union` bound) )
+        modifyIds (\ (used,bound) -> --trace ("AddBoundNames: " ++ show (size used, size bound))
+                   (nset `union` used, nset `union` bound) )
hunk ./E/SSimplify.hs 1055
-        newNameFrom  (genNames (size used + size bound))
-
+--        trace ("newName: "++ show (size used, size bound)) $ return ()
+        --newNameFrom  (genNames (size used + size bound))
+        sm <- get
+        let (g1,g2) = split (smStdGen sm)
+        put sm{smStdGen = g1}
+        newNameFrom (filter even $ randoms g2)
hunk ./E/SSimplify.hs 1067
-smAddNamesIdSet nset = do modifyIds (\ (used,bound) -> (nset `union` used, bound) )
-smAddBoundNamesIdSet nset = do modifyIds (\ (used,bound) -> (nset `union` used, nset `union` bound) )
+smAddNamesIdSet nset = --trace ("addNamesIdSet: "++ show (size nset)) $
+   do modifyIds (\ (used,bound) -> (nset `union` used, bound) )
+smAddBoundNamesIdSet nset = --trace ("addBoundNamesIdSet: "++show (size nset)) $
+   do modifyIds (\ (used,bound) -> (nset `union` used, nset `union` bound) )