[new dead code algorithm being used.
John Meacham <john@repetae.net>**20060126030505] hunk ./Grin/DeadCode.hs 4
-import Grin.Grin
-import qualified Stats
-import Atom
+import Data.Monoid
hunk ./Grin/DeadCode.hs 6
-import FreeVars
+import qualified Data.Set as Set
+
+import Atom
hunk ./Grin/DeadCode.hs 10
-import Data.Monoid
-import GenUtil
-import Util.Gen
-import Grin.Whiz
hunk ./Grin/DeadCode.hs 11
+import FreeVars
+import Grin.Grin
+import Grin.Whiz
+import CanType
+import Stats hiding(print)
+import Util.Gen
hunk ./Grin/DeadCode.hs 45
-    supplyReadValues usedArgs >>= mapM_ print
-    supplyReadValues usedFuncs >>= mapM_ print
-    supplyReadValues usedCafs >>= mapM_ print
-    return grin
+    --supplyReadValues usedFuncs >>= mapM_ print
+    ua <- supplyReadValues usedArgs
+    uc <- supplyReadValues usedCafs
+    let cafSet = fg uc
+        argSet = fg ua
+        fg xs = Set.fromList [ x | (x,True) <- xs ]
+    newCafs <- flip mconcatMapM (grinCafs grin) $ \ (x,y) -> do
+        u <- readSValue usedCafs x
+        if u then return [(x,y)] else return []
+    newFuncs <- flip mconcatMapM (grinFunctions grin) $ \ (x,y) -> do
+        u <- readSValue usedFuncs x
+        if not u then tick stats "Optimize.dead-code.func" >> return [] else do
+        r <- runStatIO stats $ removeDeadArgs postInline cafSet argSet (x,y)
+        return [r]
+
+    return grin { grinCafs = newCafs, grinFunctions = newFuncs }
hunk ./Grin/DeadCode.hs 62
-combineArgs fn as = [ ((fn,n),a) | (n,a) <- zip [0..] as]
+combineArgs fn as = [ ((fn,n),a) | (n,a) <- zip [0 :: Int ..] as]
hunk ./Grin/DeadCode.hs 91
-            doNode = undefined
-            h (p,e) = g e >> return (Just (p,e))
+            g (Store n) = addRule $ doNode n
+            g x@Fetch {} = mapM_ useVar (freeVars x)
+            g Error {} = return ()
+            -- TODO - handle function and case return values smartier.
+            g (Return n) = addRule $ doNode n
+            h' (p,e) = h (p,e) >> return (Just (p,e))
+            h (p,Store v) = addRule $ mconcat $ [ conditionalRule id  (varValue pv) (doNode v) | pv <- freeVars p]
+            h (p,Return v) = addRule $ mconcat $ [ conditionalRule id  (varValue pv) (doNode v) | pv <- freeVars p]
+            h (p,Fetch v) = addRule $ mconcat $ [ mconcatMap (implies (varValue pv) . varValue) (freeVars v) | pv <- freeVars p]
+            h (p,e) = g e
+            doNode (NodeC n as) | not postInline, Just (x,fn) <- tagUnfunction n  = mconcat $ implies fn' (sValue usedFuncs fn):[ mconcatMap (implies (sValue usedArgs fn) . varValue) (freeVars a) | (fn,a) <- combineArgs fn as]
+            doNode x = mconcatMap (implies fn' . varValue) (freeVars x)
hunk ./Grin/DeadCode.hs 114
-        (nl,_) <- whiz (\_ -> id) h f whizState (Tup as :-> body)
+        (nl,_) <- whiz (\_ -> id) h' f whizState (Tup as :-> body)
hunk ./Grin/DeadCode.hs 118
+removeDeadArgs :: MonadStats m => Bool -> (Set.Set Var) -> (Set.Set (Atom,Int)) -> (Atom,Lam) -> m (Atom,Lam)
+removeDeadArgs postInline usedCafs usedArgs (a,l) =  whizExps f l >>= return . (,) a where
+    f (App fn as ty) | fn `notElem` [funcApply, funcEval] = do
+        as <- dff fn as
+        as <- mapM clearCaf as
+        return $ App fn as ty
+    f (Return (NodeC fn as)) | Just fn' <- tagToFunction fn = do
+        as <- dff' fn' as
+        as <- mapM clearCaf as
+        return $ Return (NodeC fn as)
+    f (Store (NodeC fn as)) |  Just fn' <- tagToFunction fn = do
+        as <- dff' fn' as
+        as <- mapM clearCaf as
+        return $ Store (NodeC fn as)
+    f (Update (Var v (TyPtr TyNode)) _) | deadCaf v = do
+        mtick $ toAtom "Optimize.dead-code.caf-update"
+        return $ Return unit
+    f (Update p (NodeC fn as)) |  Just fn' <- tagToFunction fn = do
+        as <- dff' fn' as
+        as <- mapM clearCaf as
+        return $ Update p (NodeC fn as)
+    f x = return x
+    dff' fn as | postInline = return as
+    dff' fn as = dff fn as
+    dff fn as = mapM df  (zip as [0..]) where
+        deadVal (Lit 0 _) = True
+        deadVal x =  isHole x
+        df (a,i) | not (deadVal a) && not (Set.member (fn,i) usedArgs) = do
+            mtick $ toAtom "Optimize.dead-code.func-arg"
+            return $ properHole (getType a)
+        df (a,_)  = return a
+    clearCaf (Var v (TyPtr TyNode)) | deadCaf v = do
+        mtick $ toAtom "Optimize.dead-code.caf-arg"
+        return (properHole (TyPtr TyNode))
+    clearCaf (Tup xs) = do
+        xs <- mapM clearCaf xs
+        return $ Tup xs
+    clearCaf (NodeC a xs) = do
+        xs <- mapM clearCaf xs
+        return $ NodeC a xs
+    clearCaf (NodeV a xs) = do
+        xs <- mapM clearCaf xs
+        return $ NodeV a xs
+    clearCaf (Const a) = do
+        a <- clearCaf a
+        return $ Const a
+    clearCaf x = return x
+    deadCaf v =  v < v0 && not (v `Set.member` usedCafs)
hunk ./Grin/Grin.hs 16
+    properHole,
+    isHole,
hunk ./Grin/Grin.hs 344
+properHole x = case x of
+    TyPtr TyNode -> Const (properHole TyNode)
+    TyTag -> (Tag tagHole)
+    ty@(Ty _) -> (Lit 0 ty)
+    TyNode -> (NodeC tagHole [])
+
+isHole x = x `elem` map properHole [TyPtr TyNode, TyNode, TyTag]
hunk ./Grin/Simplify.hs 13
-import CharIO
hunk ./Grin/Simplify.hs 15
-import Doc.Pretty
-import Doc.PPrint
hunk ./Grin/Simplify.hs 17
-import Grin.Show
hunk ./Grin/Simplify.hs 42
+at_OptSimplifyHoleAssignment  = toAtom "Optimize.simplify.hole-assignment"
hunk ./Grin/Simplify.hs 94
+    gv (NodeC t xs,Return (NodeC t' [])) |  t' == tagHole = do
+            lift $ tick stats at_OptSimplifyHoleAssignment
+            gv (Tup xs, Return $ Tup $ Prelude.map (properHole . getType) xs)
hunk ./Grin/Simplify.hs 153
-doApply (NodeC t xs) y typ
-    | n == 1 = (App v (xs ++ [y]) typ)
-    | n > 1 = Return (NodeC (partialTag v (n - 1)) (xs ++ [y]))
-        where
-        Just (n,v) = tagUnfunction t
+doApply (NodeC t xs) y typ | Just (n,v) <- tagUnfunction t = case n of
+    1 -> (App v (xs ++ [y]) typ)
+    _ -> Return (NodeC (partialTag v (n - 1)) (xs ++ [y]))
hunk ./Main.hs 441
-        x <- deadFunctions stats' [funcMain] x
+        deadFunctions stats' [funcMain] x
+        x <- deadCode stats' [funcMain] x  -- XXX
hunk ./Util/Gen.hs 11
+mconcatMapM f xs = mapM f xs >>= return . mconcat
+