[have the dead code pass keep track of which functions have been suspended and which have been partially applied
John Meacham <john@repetae.net>**20060129050424] hunk ./Grin/DeadCode.hs 14
-import Support.CanType
hunk ./Grin/DeadCode.hs 15
+import Support.CanType
hunk ./Grin/DeadCode.hs 32
+    pappFuncs <- newValue fixer bottom
+    suspFuncs <- newValue fixer bottom
hunk ./Grin/DeadCode.hs 45
-    mapM_ (go fixer usedFuncs usedArgs usedCafs postInline) (grinFunctions grin)
+    mapM_ (go fixer pappFuncs suspFuncs usedFuncs usedArgs usedCafs postInline) (grinFunctions grin)
hunk ./Grin/DeadCode.hs 47
-    --supplyReadValues usedFuncs >>= mapM_ print
hunk ./Grin/DeadCode.hs 49
+    uf <- supplyReadValues usedFuncs
hunk ./Grin/DeadCode.hs 52
+        funSet = fg uf
hunk ./Grin/DeadCode.hs 55
-        u <- readSValue usedCafs x
-        if u then return [(x,y)] else return []
+        if x `Set.member` cafSet then return [(x,y)] else tick stats "Optimize.dead-code.caf" >> return []
hunk ./Grin/DeadCode.hs 57
-        u <- readSValue usedFuncs x
-        --if not u then tick stats ("Optimize.dead-code.func.{" ++ show x) >> return [] else do
-        if not u then tick stats "Optimize.dead-code.func" >> return [] else do
+        if not $ x `Set.member` funSet then tick stats "Optimize.dead-code.func" >> return [] else do
hunk ./Grin/DeadCode.hs 60
-
-    return grin { grinCafs = newCafs, grinFunctions = newFuncs }
+    pappFuncs <- readValue pappFuncs
+    suspFuncs <- readValue suspFuncs
+    --putStrLn "partialapplied:"
+    --mapM_ print $ Set.toList pappFuncs
+    --putStrLn "suspended:"
+    --mapM_ print $ Set.toList suspFuncs
+    --putStrLn "none:"
+    --mapM_ print $ Set.toList $ funSet Set.\\ suspFuncs Set.\\ pappFuncs
+    return grin {
+        grinCafs = newCafs,
+        grinFunctions = newFuncs,
+        grinPartFunctions = pappFuncs,
+        grinSuspFunctions = suspFuncs
+        }
hunk ./Grin/DeadCode.hs 77
-go fixer usedFuncs usedArgs usedCafs postInline (fn,~(Tup as) :-> body) = ans where
+go fixer pappFuncs suspFuncs usedFuncs usedArgs usedCafs postInline (fn,~(Tup as) :-> body) = ans where
hunk ./Grin/DeadCode.hs 115
-            --h (p,Fetch v) = addRule $ mconcat $ [ mconcatMap (implies (varValue pv) . varValue) (freeVars v) | pv <- freeVars p]
-            --h (p,Cast v _) = addRule $ mconcat $ [ mconcatMap (implies (varValue pv) . varValue) (freeVars v) | pv <- freeVars p]
hunk ./Grin/DeadCode.hs 116
-            doNode (NodeC n as) | not postInline, Just (x,fn) <- tagUnfunction n  = mappend (mconcatMap doConst as) $ mconcat (implies fn' (sValue usedFuncs fn):[ mconcatMap (implies (sValue usedArgs fn) . varValue) (freeVars a) | (fn,a) <- combineArgs fn as])
+            doNode (NodeC n as) | not postInline, Just (x,fn) <- tagUnfunction n  = let
+                consts = (mconcatMap doConst as)
+                usedfn = implies fn' (sValue usedFuncs fn)
+                suspfn | x > 0 = conditionalRule id fn' (pappFuncs `isSuperSetOf` value (Set.singleton fn))
+                       | otherwise = conditionalRule id fn' (suspFuncs `isSuperSetOf` value (Set.singleton fn))
+                in mappend consts $ mconcat (usedfn:suspfn:[ mconcatMap (implies (sValue usedArgs fn) . varValue) (freeVars a) | (fn,a) <- combineArgs fn as])
hunk ./Grin/DeadCode.hs 130
-
-{-
-            g (Store (NodeC x vs)) | Just a <- tagToFunction x = tell (Seq.fromList $ concat [ [ (x,Passed [(a,i)]) | x <- freeVars v] | v <- vs | i <- [0..] ])
-            g (Return (NodeC x vs)) | Just a <- tagToFunction x = tell (Seq.fromList $ concat [ [ (x,Passed [(a,i)]) | x <- freeVars v] | v <- vs | i <- [0..] ])
-            g (Update _ (NodeC x vs)) | Just a <- tagToFunction x = tell (Seq.fromList $ concat [ [ (x,Passed [(a,i)]) | x <- freeVars v] | v <- vs | i <- [0..] ])
-            g (Case e _) = tell (Seq.fromList [ (v,Used) | v <- freeVars e ])
-            g e = tell (Seq.fromList [ (v,Used) | v <- freeVars e ])
-            g _ = return ()
-            -}
-
hunk ./Grin/Grin.hs 207
+    grinSuspFunctions :: Set.Set Atom,
+    grinPartFunctions :: Set.Set Atom,
hunk ./Grin/Grin.hs 220
+    grinSuspFunctions = mempty,
+    grinPartFunctions = mempty,