[have points-to analysis contain the full values of constant data
John Meacham <john@repetae.net>**20060127055937] hunk ./Grin/Grin.hs 596
-    deriving(Eq,Ord,Show)
+    deriving(Eq,Ord)
hunk ./Grin/Grin.hs 601
-data HeapValue = HV Int HeapType Item
+data HeapValue = HV Int (Either (HeapType,Item) Val)  -- either a heap location or a constant
hunk ./Grin/Grin.hs 605
-instance Show Item where
-    show (BasicValue ty) = "<" ++ show ty ++ ">"
-    show (HeapValue hv) = braces $ hcat $ punctuate "," (map show $ sortGroupUnderFG (\ (HV _ t _) -> t) (\ (HV x _ _) -> x) (Set.toList hv))
-    show (NodeValue hv) = braces $ hcat $ punctuate "," (map show (Set.toList hv))
-    show (TupledValue xs) = tupled (map show xs)
-
-instance Show NodeValue where
-    show (NV t as) = parens $ hsep (show t:map show as)
-
-instance Show HeapValue where
-    show (HV n t _) = show (t,n)
hunk ./Grin/Grin.hs 608
-    (HV x _ _) == (HV y _ _) = x == y
+    (HV x _) == (HV y _) = x == y
hunk ./Grin/Grin.hs 610
-    compare (HV x _ _) (HV y _ _) = compare x y
+    compare (HV x _) (HV y _) = compare x y
hunk ./Grin/PointsToAnalysis.hs 24
+import Grin.Show()
hunk ./Grin/PointsToAnalysis.hs 118
-setNodes xs = pruneNodes $ VsNodes (Map.fromList $ concat [ [ ((n,i),a) | a <- as | i <- [0..] ] | (n,as) <- xs]) (Set.fromList (fsts xs))
+setNodes xs = pruneNodes $ VsNodes (Map.fromList $ concat [ [ ((n,i),a) | a <- as | i <- naturals ] | (n,as) <- xs]) (Set.fromList (fsts xs))
hunk ./Grin/PointsToAnalysis.hs 168
+    ptConstMap :: Map.Map Int Val,
hunk ./Grin/PointsToAnalysis.hs 192
+    constValEq :: [(Int,Val)],
hunk ./Grin/PointsToAnalysis.hs 222
-    vs' = [ (v,if basicType ty then Basic else Down p t i) | Var v ty <- vs | i <- [0..] ]
+    vs' = [ (v,if basicType ty then Basic else Down p t i) | Var v ty <- vs | i <- naturals ]
hunk ./Grin/PointsToAnalysis.hs 227
-    vs' = [ (v,if basicType ty then Basic else DownTup p i) | Var v ty <- vs | i <- [0..] ]
+    vs' = [ (v,if basicType ty then Basic else DownTup p i) | Var v ty <- vs | i <- naturals ]
hunk ./Grin/PointsToAnalysis.hs 245
-        (heapEq',hc') = runState (sequence [ toHEq node >>= return . (,) h | (v,node) <- cafs | h <- [1..] ]) emptyHcHash
-        eq = mempty {
+        (((heapEq',feq),hc')) = runState (runWriterT $ sequence [ toHEq node >>= return . (,) h | (v,node) <- cafs | h <- [1..] ]) emptyHcHash
+        eq = feq {
hunk ./Grin/PointsToAnalysis.hs 292
+{-# NOINLINE grinInlineEvalApply #-}
hunk ./Grin/PointsToAnalysis.hs 402
-    f n = HV n (if n < 0 then Constant else hType) (valueSetToItem te pt TyNode vs) where   -- TODO heap locations of different types
+    f n | n < 0 = HV n (Right val) where
+        Just val = Map.lookup n (ptConstMap pt)
+    f n = HV n (Left (hType,(valueSetToItem te pt TyNode vs))) where   -- TODO heap locations of different types
hunk ./Grin/PointsToAnalysis.hs 520
-    (_,h) <- newConst' True v
+    (_,h) <- newConst' False v
+    tell mempty { constValEq = [(negate h,v)] }
+    toPos v -- XXX discard
hunk ./Grin/PointsToAnalysis.hs 524
---    p <- toPos v
---    newHeap Constant p
hunk ./Grin/PointsToAnalysis.hs 744
+    --CharIO.putStrLn "ConstValEq"
+    --mapM_ CharIO.print (snubUnder fst $ constValEq eq)
hunk ./Grin/PointsToAnalysis.hs 750
+        ptConstMap = Map.fromList (constValEq eq),
hunk ./Grin/Show.hs 3
-import Grin.Grin
-import Doc.Pretty
-import Doc.PPrint
-import Doc.DocLike
-import Atom
hunk ./Grin/Show.hs 4
-import Name.VConsts
-import Grin.Val
-import Number
hunk ./Grin/Show.hs 5
+import qualified Data.Set as Set
+
+import Atom
hunk ./Grin/Show.hs 10
-import qualified FlagDump as FD
+import Doc.DocLike
+import Doc.PPrint
+import Doc.Pretty
+import Grin.Grin
+import Grin.Val
+import Name.VConsts
+import Number
hunk ./Grin/Show.hs 18
+import qualified FlagDump as FD
hunk ./Grin/Show.hs 20
-instance PPrint Doc Val   where
+instance DocLike d => PPrint d Val   where
hunk ./Grin/Show.hs 23
+
hunk ./Grin/Show.hs 28
-pVar v  = pVal v <+> operator "<- "
+pVar v  = prettyVal v <+> operator "<- "
hunk ./Grin/Show.hs 30
-pVar' v  = pVal v <+> operator "<- "
+pVar' v  = prettyVal v <+> operator "<- "
hunk ./Grin/Show.hs 44
-tag = text
+tag x = text x
hunk ./Grin/Show.hs 50
-prettyVal = pVal
hunk ./Grin/Show.hs 56
-prettyExp vl (Return v) = vl <> keyword "return" <+> pVal v
-prettyExp vl (Store v) = vl <> keyword "store" <+> pVal v
-prettyExp vl (Fetch v) = vl <> keyword "fetch" <+> pVal v
+prettyExp vl (Return v) = vl <> keyword "return" <+> prettyVal v
+prettyExp vl (Store v) = vl <> keyword "store" <+> prettyVal v
+prettyExp vl (Fetch v) = vl <> keyword "fetch" <+> prettyVal v
hunk ./Grin/Show.hs 60
-prettyExp vl (App t [v] _) | t == funcEval = vl <> keyword "eval" <+> pVal v
-prettyExp vl (App t [a,b] _) | t == funcApply = vl <> keyword "apply" <+> pVal a <+> pVal b
-prettyExp vl (App a vs _)  = vl <> func (fromAtom a) <+> hsep (map pVal vs)
-prettyExp vl (Prim Primitive { primName = nm } vs)  = vl <> prim (fromAtom nm) <+> hsep (map pVal vs)
-prettyExp vl (Update x y) = vl <> keyword "update" <+> pVal x <+> pVal y
-prettyExp vl (Cast x _) = vl <> keyword "cast" <+> pVal x
-prettyExp vl (Case v vs) = vl <> keyword "case" <+> pVal v <+> keyword "of" <$> indent 2 (vsep (map f vs)) where
-    f (v :-> e) = pVal v <+> operator "->" <+> keyword "do" <$> indent 2 (prettyExp empty e)
+prettyExp vl (App t [v] _) | t == funcEval = vl <> keyword "eval" <+> prettyVal v
+prettyExp vl (App t [a,b] _) | t == funcApply = vl <> keyword "apply" <+> prettyVal a <+> prettyVal b
+prettyExp vl (App a vs _)  = vl <> func (fromAtom a) <+> hsep (map prettyVal vs)
+prettyExp vl (Prim Primitive { primName = nm } vs)  = vl <> prim (fromAtom nm) <+> hsep (map prettyVal vs)
+prettyExp vl (Update x y) = vl <> keyword "update" <+> prettyVal x <+> prettyVal y
+prettyExp vl (Cast x _) = vl <> keyword "cast" <+> prettyVal x
+prettyExp vl (Case v vs) = vl <> keyword "case" <+> prettyVal v <+> keyword "of" <$> indent 2 (vsep (map f vs)) where
+    f (v :-> e) = prettyVal v <+> operator "->" <+> keyword "do" <$> indent 2 (prettyExp empty e)
hunk ./Grin/Show.hs 69
-pVal s | Just st <- fromVal s = text $ show (st::String)
-pVal (NodeC t []) = parens $ tag (fromAtom t)
-pVal (NodeC t vs) = parens $ tag (fromAtom t) <+> hsep (map pVal vs)
-pVal (NodeV (V i) vs) = parens $ char 't' <> tshow i <+> hsep (map pVal vs)
-pVal (Tag t) = tag (fromAtom t)
-pVal (Var (V i) t)
+prettyVal :: DocLike d => Val -> d
+prettyVal s | Just st <- fromVal s = text $ show (st::String)
+prettyVal (NodeC t []) = parens $ tag (fromAtom t)
+prettyVal (NodeC t vs) = parens $ tag (fromAtom t) <+> hsep (map prettyVal vs)
+prettyVal (NodeV (V i) vs) = parens $ char 't' <> tshow i <+> hsep (map prettyVal vs)
+prettyVal (Tag t) = tag (fromAtom t)
+prettyVal (Var (V i) t)
hunk ./Grin/Show.hs 82
-pVal (Var (V i) _) = char 'v' <> tshow i
-pVal (Lit i t) | t == tCharzh, i >= 0x20 && i < 0x7f, Just x <- toIntegral i = tshow (chr x)
-pVal (Lit i _)  = tshow i
---pVal Unit = text "()"
-pVal (Tup xs)  = tupled $ map pVal xs
-pVal (Const v) = char '&' <> pVal v
-pVal (Addr _) = text "<ref>"
+prettyVal (Var (V i) _) = char 'v' <> tshow i
+prettyVal (Lit i t) | t == tCharzh, i >= 0x20 && i < 0x7f, Just x <- toIntegral i = tshow (chr x)
+prettyVal (Lit i _)  = tshow i
+--prettyVal Unit = text "()"
+prettyVal (Tup xs)  = tupled $ map prettyVal xs
+prettyVal (Const v) = char '&' <> prettyVal v
+prettyVal (Addr _) = text "<ref>"
hunk ./Grin/Show.hs 97
-prettyFun (n,(Tup as :-> e)) = func (fromAtom n) <+> hsep (map pVal as) <+> operator "=" <+> keyword "do" <$> indent 2 (prettyExp empty e)
+prettyFun (n,(Tup as :-> e)) = func (fromAtom n) <+> hsep (map prettyVal as) <+> operator "=" <+> keyword "do" <$> indent 2 (prettyExp empty e)
hunk ./Grin/Show.hs 110
+instance Show Item where
+    show (BasicValue ty) = "<" ++ show ty ++ ">"
+    show (HeapValue hv) = braces $ hcat $ punctuate "," (map show (Set.toList hv))
+    show (NodeValue hv) = braces $ hcat $ punctuate "," (map show (Set.toList hv))
+    show (TupledValue xs) = tupled (map show xs)
+
+instance Show NodeValue where
+    show (NV t as) = parens $ hsep (show t:map show as)
+
+instance Show HeapValue where
+    show (HV _ (Right v)) = prettyVal v
+    show (HV n (Left (ht,_))) = show ht ++ "-" ++ show n
+
+instance Show HeapType where
+    show Constant = "C"
+    show SharedEval = "Es"
+    show UnsharedEval = "Eu"
+    show Reference = "Ref"
+    show RecursiveThunk = "Rt"