[add Omit optimizaiton to Grin.SSimplify, clean up code some
John Meacham <john@repetae.net>**20070605015341] hunk ./Grin/SSimplify.hs 14
+import Support.FreeVars
hunk ./Grin/SSimplify.hs 31
-    envScope :: IM.IntMap Binding,
hunk ./Grin/SSimplify.hs 44
-newtype S a = S (RWS SEnv Stats.Stat SState a)
-    deriving(Monad,Functor,MonadReader SEnv,MonadState SState)
+newtype S a = S (RWS SEnv SCol SState a)
+    deriving(Monad,Functor,MonadWriter SCol, MonadReader SEnv,MonadState SState)
hunk ./Grin/SSimplify.hs 48
-    mtickStat s = S (tell s)
-    mticks' n a = S (tell $ Stats.singleStat n a)
+    mtickStat s = S (tell mempty { colStats = s })
+    mticks' n a = S (tell mempty { colStats = Stats.singleStat n a })
hunk ./Grin/SSimplify.hs 52
-data Binding = IsBoundTo Val | Promote Val | Demote Val
-
+tellFV v = tell mempty { colFreeVars = freeVars v }
hunk ./Grin/SSimplify.hs 57
-    let (fs,_,stats) = runRWS fun mempty SState { usedVars = mempty }
+    let (fs,_,SCol { colStats = stats}) = runRWS fun mempty SState { usedVars = mempty }
hunk ./Grin/SSimplify.hs 72
-    e <- local (env' `mappend`) $ simpExp e
+    let f col = col { colFreeVars = colFreeVars col Set.\\ freeVars ps }
+    (e,col) <- censor f $ listen $ local (env' `mappend`) $ simpExp e
+    ps <- mapM (zeroVars (`Set.member` colFreeVars col)) ps
hunk ./Grin/SSimplify.hs 95
-        z <- local (\s -> s { envCSE = Map.fromList [ (x,(toAtom name,y)) | (x,y) <- xs] `Map.union` envCSE s }) cont
+        (z,col) <- listen $ local (\s -> s { envCSE = Map.fromList [ (x,(toAtom name,y)) | (x,y) <- xs] `Map.union` envCSE s }) cont
hunk ./Grin/SSimplify.hs 97
-        return $ e :>>= (p :-> z)
+        if isOmittable e && Set.null (freeVars p `Set.intersection` colFreeVars col) then do
+            mtick "Simplify.Omit.Bind"
+            return z
+         else return $ e :>>= (p :-> z)
hunk ./Grin/SSimplify.hs 116
-extScope :: Var -> Binding -> SEnv -> SEnv
-extScope (V vn) v s = s { envScope = IM.insert vn v (envScope s) }
hunk ./Grin/SSimplify.hs 161
-        --x <- simpBind (p,a)
-        --z <- local (const env'') $ f b xs
---        case x of
---            Just (p',a') -> do
---                return $ a' :>>= (p' :-> z)
---            Nothing -> do
---                return z
hunk ./Grin/SSimplify.hs 180
-        as <- mapM dc as
+        as <- mapM simpLam as
hunk ./Grin/SSimplify.hs 185
-        let f def@FuncDef { funcDefName = n, funcDefBody = b } = do
-                b <- dc b
-                return $ createFuncDef True n b
-        defs <- mapM f defs
+        defs <- simpFuncs defs
hunk ./Grin/SSimplify.hs 189
-    dc (p :-> e) = do
-        (p,env') <- renamePattern p
-        env <- ask
-        let env'' = env' `mappend` env
-        z <- local (const env'') $ f e []
-        return (p :-> z)
hunk ./Grin/SSimplify.hs 192
-applySubstE x = f x where
-    g = applySubst
-    f (App a vs t) = do
-        vs' <- mapM g vs
-        return $ App a vs' t
-    f (Return vs) = return Return `ap` mapM g vs
-    f (Prim x vs t) = do
-        vs <- mapM g vs
-        return $ Prim x vs t
-    f (Store v) = return Store `ap` g v
-    f e@Alloc { expValue = v, expCount = c } = do
-        v <- g v
-        c <- g c
-        return e { expValue = v, expCount = c }
-    f (Fetch v) = return Fetch `ap` g v
-    f (Update a b) = return Update `ap` g a `ap` g b
-    f e@Error {} = return e
---    f (Case e as) = do
---        e <- g e
---        return $ Case e as
---    f lt@Let {} = return lt
-    f x = error $ "applySubstE: " ++ show x
+applySubstE x = mapExpVal applySubst x
hunk ./Grin/SSimplify.hs 198
-            Just n -> return n
-            Nothing -> return var
-    f (NodeC t vs) = return (NodeC t) `ap` mapM f vs
-    f (Index a b) = return Index `ap` f a `ap` f b
-    f (Const v) = return Const `ap` f v
-    f (ValPrim p vs ty) = return (ValPrim p) `ap` mapM f vs `ap` return ty
-    f x = return x
+            Just n -> tellFV n >> return n
+            Nothing -> tellFV var >> return var
+    f x = mapValVal f x
+
+zeroVars fn x = f x where
+    f (Var v ty) | fn v || v == v0 = return (Var v ty)
+                 | otherwise = do mtick $ "Simplify.ZeroVar.{" ++ show (Var v ty); return (Var v0 ty)
+    f x = mapValVal f x