[patch up argument points-to info after deleting args
John Meacham <john@repetae.net>**20060129095254] hunk ./Grin/DeadCode.hs 59
-    newCafs <- flip mconcatMapM (grinCafs grin) $ \ (x,y) -> do
-        if x `Set.member` cafSet then return [(x,y)] else tick stats "Optimize.dead-code.caf" >> return []
+    newCafs <- flip mconcatMapM (grinCafs grin) $ \ (x,y) -> if x `Set.member` cafSet then return [(x,y)] else tick stats "Optimize.dead-code.caf" >> return []
hunk ./Grin/DeadCode.hs 74
+    let newArgTags = concatMap foo (Map.toList $ grinArgTags grin)
+        foo (fn,ts) | not $ fn `Set.member` funSet = []
+        foo (fn,ts) | fn `Set.member` directFuncs = [(fn,concatMap da (zip ts naturals))] where
+            da (t,i) | Set.member (fn,i) argSet = [t]
+                     | otherwise =  []
+        foo (fn,ts) = [(fn,ts)]
+
hunk ./Grin/DeadCode.hs 94
+        grinArgTags = Map.fromList newArgTags,
hunk ./Grin/Grin.hs 205
-    grinArgTags :: Map.Map (Atom,Int) Item,
+    grinArgTags :: Map.Map Atom [Item],
hunk ./Grin/PointsToAnalysis.hs 386
+        convertArgs fa = Map.fromList $ map f (Map.keys $ ptFunc pt) where
+            f atom = (atom,[ uncurry vsToItem $ Map.findWithDefault (t,VsEmpty) (atom,i) fa  |  t <- ts | i <- naturals]) where
+                Just (ts,_) = findArgsType te atom
hunk ./Grin/PointsToAnalysis.hs 391
-    return grin { grinPhase = PostInlineEval, grinFunctions = funcs, grinArgTags = Map.map (\ (t,v) -> vsToItem t v) $ ptFuncArgs pt, grinReturnTags = Map.mapWithKey (funcReturn te pt) $ ptFunc pt }
+    return grin { grinPhase = PostInlineEval, grinFunctions = funcs, grinArgTags = convertArgs $ ptFuncArgs pt, grinReturnTags = Map.mapWithKey (funcReturn te pt) $ ptFunc pt }
hunk ./Grin/Show.hs 123
-    show (HV _ (Right v)) = prettyVal v
+    show (HV _ (Right v)) = prettyVal (Const v)
hunk ./Main.hs 14
-import Support.CanType(getType)
hunk ./Main.hs 15
+import C.Prims
hunk ./Main.hs 18
-import C.Prims
hunk ./Main.hs 38
-import Support.FreeVars
hunk ./Main.hs 45
+import Grin.Unboxing
hunk ./Main.hs 53
+import Support.CanType(getType)
+import Support.FreeVars
+import Support.ShowTable
+import Util.Graph
+import Version
hunk ./Main.hs 68
-import Grin.Unboxing
-import Util.Graph
-import Version
hunk ./Main.hs 463
+    --printTable "Return points-to" (grinReturnTags x)
+    --printTable "Argument points-to" (grinArgTags x)
hunk ./Main.hs 472
-    mapM_ putStrLn (buildShowTableLL $ Map.toList $ grinReturnTags x)
+    --mapM_ putStrLn (buildShowTableLL $ Map.toList $ grinReturnTags x)
hunk ./Main.hs 479
+    printTable "Return points-to" (grinReturnTags x)
+    printTable "Argument points-to" (grinArgTags x)
hunk ./Support/ShowTable.hs 3
+import Monad
+import List
hunk ./Support/ShowTable.hs 14
-instance (Show a,Show b) => Map.Map a b where
+instance (Show a,Show b) => ShowTable (Map.Map a b) where
hunk ./Support/ShowTable.hs 17
-instance Show a => Set.Set a where
+instance Show a => ShowTable (Set.Set a) where
hunk ./Support/ShowTable.hs 24
-    mapM_ putStrLn [ "  " ++ x ++ " - " ++ y | (x,y) <- showTablePairs x]
+    mapM_ putStrLn $ sort [ "  " ++ x ++ (if null y then "" else " - " ++ y) | (x,y) <- showTablePairs x]