[add linear heap location analysis and use it to improve points-to information
John Meacham <john@repetae.net>**20060125041250] hunk ./Grin/Linear.hs 9
+import GenUtil
hunk ./Grin/Linear.hs 11
-data W = One | Omega
+data W = Zero | One | Omega
hunk ./Grin/Linear.hs 15
-    bottom = One
-    isBottom One = True
+    bottom = Zero
+    isBottom Zero = True
hunk ./Grin/Linear.hs 23
+{-# NOINLINE grinLinear #-}
hunk ./Grin/Linear.hs 31
+    as <- supplyReadValues argSupply
+    mapM_ print $ sortGroupUnderFG fst (snd . snd)  [ (n,(a,v)) | ((n,a),v) <- as ]
hunk ./Grin/Linear.hs 58
-    h Store { expValue = NodeC a vs } | tagIsSuspFunction a =  fuse (tagFlipFunction a) vs
-    h Update { expValue = NodeC a vs } | tagIsSuspFunction a =  fuse (tagFlipFunction a) vs
-    h Return { expValue = NodeC a vs } | tagIsSuspFunction a =  fuse (tagFlipFunction a) vs
+    -- h Store { expValue = NodeC a vs } | tagIsSuspFunction a =  fuse (tagFlipFunction a) vs
+    -- h Update { expValue = NodeC a vs } | tagIsSuspFunction a =  fuse (tagFlipFunction a) vs
+    -- h Return { expValue = NodeC a vs } | tagIsSuspFunction a =  fuse (tagFlipFunction a) vs
hunk ./Grin/Linear.hs 68
-    h Store { } = return ()
+    h Store {} = return ()
hunk ./Grin/Linear.hs 77
-            Just (_,v) -> lift $ toOmega v
+            Just (_,v) -> toOmega v
hunk ./Grin/Linear.hs 83
-        ea <- lift $ supplyValue argSupply an
+        ea <-  supplyValue argSupply an
hunk ./Grin/Linear.hs 86
-            Just (_,ev) -> lift $ addRule $ ev `isSuperSetOf` ea
+            Just (_,ev) -> addRule $ ev `isSuperSetOf` ea
hunk ./Grin/Linear.hs 92
-            Just (0,e) -> modify (Map.insert v (1,e))
-            Just (1,e) -> lift $ toOmega e
+            Just (0,e) -> do
+                addRule $ e `isSuperSetOf` value One
+                modify (Map.insert v (1,e))
+            Just (1,e) -> toOmega e
hunk ./Grin/PointsToAnalysis.hs 31
+import Util.Gen
hunk ./Grin/PointsToAnalysis.hs 309
-                    [] ->  return $ (Return vr :>>= createEval NoUpdate typeEnv (tagsp v)) :>>= vb :-> Error "Update: no alternatives" (getType e)
+                    [] ->  return $ (Return vr :>>= createEval NoUpdate typeEnv (tagsp v)) -- :>>= vb :-> Error "Update: no alternatives" (getType e)
hunk ./Grin/PointsToAnalysis.hs 555
-                    addRule $ modifiedSuperSetOf self p' (\n -> pruneNodes $ VsNodes (Map.filterWithKey (\ (t,_) _ -> tagIsWHNF t) (getNodeArgs n)) (Set.filter tagIsWHNF (getNodes n)))
+                    let evaledSuperSetOf a b =  modifiedSuperSetOf a b (\n -> pruneNodes $ VsNodes (Map.filterWithKey (\ (t,_) _ -> tagIsWHNF t) (getNodeArgs n)) (Set.filter tagIsWHNF (getNodes n)))
+                    addRule $ evaledSuperSetOf self p'
hunk ./Grin/PointsToAnalysis.hs 558
+                        addRule $ mconcatMap (self `evaledSuperSetOf`) (fsts [ runIdentity $ Map.lookup (tagFlipFunction n) funcMap | n <- (Set.toList $ getNodes p), tagIsSuspFunction n ])
hunk ./Grin/PointsToAnalysis.hs 641
-                    Just (e',(x,_)) | True || x /= UnsharedEval -> addRule $ dynamicRule e' $ \e ->
-                        mconcat $ flip map (fsts [ runIdentity $ Map.lookup (tagFlipFunction n) funcMap | n <- (Set.toList $ getNodes e), tagIsSuspFunction n ]) $ \z ->
-                            e' `isSuperSetOf` z
+                    Just (e',(x,_)) | x /= UnsharedEval -> addRule $ dynamicRule e' $ \e ->
+                        mconcatMap (e' `isSuperSetOf`) (fsts [ runIdentity $ Map.lookup (tagFlipFunction n) funcMap | n <- (Set.toList $ getNodes e), tagIsSuspFunction n ])