[fix major 'minus' bug. add some debugging, code cleanups, fix cheap generation bug, remove redundant rules
John Meacham <john@repetae.net>**20050913023209] hunk ./Grin/PointsToAnalysis.hs 87
-data ValueSet = VsEmpty | VsNodes (Map.Map (Atom,Int) ValueSet) (Set.Set Atom)  | VsHeaps !(Set.Set Int) | VsBas
+data ValueSet = VsEmpty | VsNodes (Map.Map (Atom,Int) ValueSet) (Set.Set Atom)  | VsHeaps !(Set.Set Int) | VsBas String
hunk ./Grin/PointsToAnalysis.hs 107
-vsBas = VsBas
+vsBas = VsBas ""
hunk ./Grin/PointsToAnalysis.hs 120
-    mappend VsBas VsBas = VsBas
+    mappend (VsBas a) (VsBas b) | a == b = VsBas a
+    mappend (VsBas a) (VsBas b) = VsBas (a ++ b)
hunk ./Grin/PointsToAnalysis.hs 135
-    minus VsBas VsBas = VsEmpty
+    minus (VsBas _) (VsBas _) = VsEmpty
hunk ./Grin/PointsToAnalysis.hs 138
-            do v' <- Map.lookup (a,i) n2
-               let m =  v `minus` v'
-               if isBottom m then [] else [((a,i),m)]
+            case Map.lookup (a,i) n2 of
+                Just v' ->  [((a,i),v `minus` v')]
+                Nothing ->  [((a,i),v)]
hunk ./Grin/PointsToAnalysis.hs 146
-    showsPrec x VsBas = \xs -> 'B':'a':'s':xs
+    showsPrec x (VsBas a) = \xs -> '(':'B':'a':'s':':':a ++ ")" ++ xs
hunk ./Grin/PointsToAnalysis.hs 250
+        let vm = Map.fromList (varEq neq)
+            (HcHash _ mp) = hc
+            cheaps = sort [ ((-x),setNodes [(t,(map z xs))]) | (HcNode t xs,x) <- Map.toList mp ] where
+            z (Right n) = setHeaps [(-n)]
+            z (Left (Var v _)) = case Map.lookup v vm of
+                Just (Ptr h) -> setHeaps [h]
+                _ -> error "cheaps"
+            z (Left x) = VsBas (show x)
+        mapM_ CharIO.print $ sort $ cheaps
hunk ./Grin/PointsToAnalysis.hs 305
-        tags v = if x == vsBas then Nothing else Just [ t | t <- Set.toList vs] where
+        tags v = if isVsBas x then Nothing else Just [ t | t <- Set.toList vs] where
hunk ./Grin/PointsToAnalysis.hs 449
-constPos (Tuple []) = return vsBas
+constPos (Tuple []) = return $ VsBas "()"
hunk ./Grin/PointsToAnalysis.hs 471
-        z (Left _) = vsBas
+        z (Left (Var v _)) = case Map.lookup v varMap of
+            Just (_,(Ptr h)) -> setHeaps [h]
+            _ -> error "cheaps"
+        z (Left i) = VsBas (show i)
hunk ./Grin/PointsToAnalysis.hs 485
-                --conditionalRule (Set.member a . getNodes) p' $ do self `isSuperSetOf` t' -- TODO
-                self `isSuperSetOf` t'
+                conditionalRule (Set.member a . getNodes) p' $ do self `isSuperSetOf` t' -- TODO
+                --self `isSuperSetOf` t'
hunk ./Grin/PointsToAnalysis.hs 492
-                    --conditionalRule (Set.member a . getNodes) p' $ do self `isSuperSetOf` w'  -- TODO
-                    self `isSuperSetOf` w'
-                self `isSuperSetOf` e' -- TODO make this better
-                -- conditionalRule (\x -> not $ or [ Set.member a (getNodes x) | (a,_) <- vs]) p' $ do self `isSuperSetOf` e'  -- TODO, should only fire once
+                    conditionalRule (Set.member a . getNodes) p' $ do self `isSuperSetOf` w'  -- TODO
+                    --self `isSuperSetOf` w'
+                --self `isSuperSetOf` e' -- TODO make this better
+                conditionalRule (\x -> not $ or [ Set.member a (getNodes x) | (a,_) <- vs]) p' $ do self `isSuperSetOf` e'  -- TODO, should only fire once
hunk ./Grin/PointsToAnalysis.hs 518
-                    as = Map.fromList $ concat [
-                            do nn <- incp n
-                               return ((nn,i),v)
-                        | ((n,i),v) <- Map.toList (getNodeArgs v)]
+                    as = Map.fromList $  [ ((nn,i),v) | ((n,i),v) <- Map.toList (getNodeArgs v), nn <- incp n ]
hunk ./Grin/PointsToAnalysis.hs 524
-                        let mm = Map.fromList $ concat [ Map.lookup (on,i) (getNodeArgs v) >>= return . ((,) (n,i)) |  i <- [0 .. length ts ]]
-                        self `isSuperSetOf` value (pruneNodes $ VsNodes mm mempty)
+                        --let mm = Map.fromList $ concat [ Map.lookup (on,i) (getNodeArgs v) >>= return . ((,) (n,i)) |  i <- [0 .. length ts ]]
+                        --self `isSuperSetOf` value (pruneNodes $ VsNodes mm mempty)
hunk ./Grin/PointsToAnalysis.hs 528
-                    sequence_ $ concat [  papp'' n i a | ((n,i),a) <- Map.toList (getNodeArgs v) ]
-                    sequence_ $ concat [  papp' n x'  | n <- Set.toList (getNodes v) ]
+                        return ()
+                    flip mapM_ (Set.toList (getNodes v)) $ \n -> do
+                         case tagUnfunction n of
+                            Just (1,fn) -> self `isSuperSetOf` (fst $ runIdentity $ Map.lookup fn funcMap)
+                            _ -> return ()
+                    --sequence_ $ concat [  papp'' n i a | ((n,i),a) <- Map.toList (getNodeArgs v) ]
hunk ./Grin/PointsToAnalysis.hs 543
-                as'' <- mapM newVal as ;
+                as'' <- mapM newVal as
hunk ./Grin/PointsToAnalysis.hs 556
-                    (ts,_) <- findArgsType (grinTypeEnv grin) fn
-                    av <- getArg fn (length ts - 1)
-                    av `isSuperSetOf` x'
+                    --(ts,_) <- findArgsType (grinTypeEnv grin) fn
+                    --av <- getArg fn (length ts - 1)
+                    --av `isSuperSetOf` x'
hunk ./Grin/PointsToAnalysis.hs 570
-        procApply p1 p2 = do
-            p1' <- newVal p1
-            p2' <- newVal p2
+        procApply xp1 xp2 = do
+            p1' <- newVal xp1
+            p2' <- newVal xp2
hunk ./Grin/PointsToAnalysis.hs 579
-                                Nothing -> return ()
-                                Just arg -> arg `isSuperSetOf` value v
+                                Just arg -> do
+                                    CharIO.print ("arg", (xp1,xp2), (fn,i), v)
+                                    arg `isSuperSetOf` value v
+                                _  -> return ()
hunk ./Grin/PointsToAnalysis.hs 590
-                                Nothing -> return ()
+                                _ -> return ()
hunk ./Grin/PointsToAnalysis.hs 601
-        simplePos (Variable v) = liftM fst $ Map.lookup v varMap
-        simplePos (Func v) = liftM fst $  Map.lookup v funcMap
+        simplePos (Variable v) = case Map.lookup v varMap of
+            Just (x,_) -> return x
+            Nothing -> error "varMap has no var"
+        simplePos (Func v) = case Map.lookup v funcMap of
+            Just (x,_) -> return x
+            Nothing -> error "funcMap has no var"
hunk ./Grin/PointsToAnalysis.hs 641
+
+    CharIO.putStrLn "argMap"
+    argMap <- readIORef argMap
+    mapM_  (\ (ai,x) -> readValue x >>= \x' -> CharIO.print (ai,x')) (Map.toList argMap)