[remove old NodeV, Tup, Tag, TyTag, and Ty constructors in Grin.
John Meacham <john@repetae.net>**20070605062417] hunk ./C/FromGrin2.hs 149
---convertVal (Tup [x]) = convertVal x
hunk ./C/FromGrin2.hs 166
---convertVal (Tup xs) = do
---    ts <- mapM convertType (map getType xs)
---    xs <- mapM convertVal xs
---    return (structAnon (zip xs ts))
-convertVal (Tag t) = do tellTags t ; return $ constant (enum $ nodeTagName t)
hunk ./C/FromGrin2.hs 187
-convertType TyTag = return tag_t
hunk ./C/FromGrin2.hs 190
-convertType (Ty t) = return (basicType (toString t))
hunk ./C/FromGrin2.hs 191
---convertType (TyTup []) = return voidType
---convertType (TyTup [x]) = convertType x
---convertType (TyTup xs) = do
---    xs <- mapM convertType xs
---    return (anonStructType xs)
hunk ./C/FromGrin2.hs 237
-convertBody (Return [v] :>>= [(NodeV t [])] :-> e') = do
-    v' <- convertVal v
-    t' <- convertVal (Var t TyTag)
-    return $ t' =* getWhat v'
hunk ./C/FromGrin2.hs 267
-    let ptrs = [Ty $ toAtom "HsPtr", Ty $ toAtom "HsFunPtr"]
-        scrut' = (if t `elem` ptrs then cast uintptr_t scrut else scrut)
-        cp (Lit i _) = constant (number $ fromIntegral i)
-        cp (Tag t) = constant (enum (nodeTagName t))
+    let cp (Lit i _) = constant (number $ fromIntegral i)
hunk ./C/FromGrin2.hs 269
-             | otherwise = annotate (show p2) (f_assert ((cp p2) `eq` scrut') & e)
+             | otherwise = annotate (show p2) (f_assert ((cp p2) `eq` scrut) & e)
hunk ./C/FromGrin2.hs 272
-    return $ profile_case_inc & cif (cp p1 `eq` scrut') e1' (am e2')
+    return $ profile_case_inc & cif (cp p1 `eq` scrut) e1' (am e2')
hunk ./C/FromGrin2.hs 298
-    let ptrs = [Ty $ toAtom "HsPtr", Ty $ toAtom "HsFunPtr"]
-        scrut' = (if t `elem` ptrs then cast uintptr_t scrut else scrut)
-        da ([v@(Var {})] :-> e) = do
+    let da ([v@(Var {})] :-> e) = do
hunk ./C/FromGrin2.hs 305
-        da ([Tag t] :-> e) = do
-            e' <- convertBody e
-            return $ (Just (enum (nodeTagName t)), e')
hunk ./C/FromGrin2.hs 307
-    return $ profile_case_inc & switch' scrut' ls'
+    return $ profile_case_inc & switch' scrut ls'
hunk ./C/FromGrin2.hs 315
-        f TyTag  = return $ constant (enum $ nodeTagName tagHole)
hunk ./C/FromGrin2.hs 497
---convertConst (Tup [x]) = convertConst x
---convertConst (Tup []) = return emptyExpression
-convertConst (Tag t) = return $ constant (enum $ nodeTagName t)
hunk ./Grin/DeadCode.hs 81
-    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 153
-            doConst (NodeV n as) = mconcatMap doConst as
hunk ./Grin/DeadCode.hs 198
---    clearCaf (Tup xs) = do
---        xs <- mapM clearCaf xs
---        return $ Tup xs
hunk ./Grin/DeadCode.hs 201
-    clearCaf (NodeV a xs) = do
-        xs <- mapM clearCaf xs
-        return $ NodeV a xs
hunk ./Grin/Grin.hs 9
-    --HeapType(..),
hunk ./Grin/Grin.hs 10
---    HeapValue(HV),
---    Item(..),
hunk ./Grin/Grin.hs 11
---    NodeValue(NV),
hunk ./Grin/Grin.hs 23
---    combineItems,
hunk ./Grin/Grin.hs 37
---    itemTag,
hunk ./Grin/Grin.hs 52
---    valToItem,
hunk ./Grin/Grin.hs 184
-    | NodeV !Var [Val]        -- ^ Complete node with variable tag
-    | Tag !Tag                -- ^ Single tag
hunk ./Grin/Grin.hs 195
-    TyTag                      -- ^ a lone tag
-    | TyPtr Ty                 -- ^ pointer to a heap location which contains its argument
+    TyPtr Ty                 -- ^ pointer to a heap location which contains its argument
hunk ./Grin/Grin.hs 197
-    | Ty Atom                  -- ^ a basic type
hunk ./Grin/Grin.hs 256
-    show TyTag = "T"
-    show (Ty a) = fromAtom a
hunk ./Grin/Grin.hs 269
-    showsPrec _ (NodeV (V i) vs) = parens $ char 't' <> tshow i <+> hsep (map shows vs)
-    showsPrec _ (Tag t) = (fromAtom t)
hunk ./Grin/Grin.hs 271
-        | TyPtr t <- t = char 'p' <> shows (Var (V i) t)
-        | TyNode <- t = char 'n' <> tshow i
-        | t == tCharzh = char 'c' <> tshow i
-        | t == tIntzh  = char 'i' <> tshow i
-        | Ty _ <- t  = char 'l' <> tshow i
-        | TyTag <- t  = char 't' <> tshow i
+        | TyPtr TyNode <- t = text "ni" <> tshow i
+        | TyNode <- t = text "nd" <> tshow i
+        | TyPtr (TyPtr TyNode) <- t = text "np" <> tshow i
+        | TyPrim Op.TyBool <- t  = char 'b' <> tshow i
+        | TyPrim (Op.TyBits _ Op.HintFloat) <- t  = char 'f' <> tshow i
+        | TyPrim (Op.TyBits _ Op.HintCharacter) <- t  = char 'c' <> tshow i
+        | TyPrim (Op.TyBits (Op.Bits 8)  _) <- t  = char 'o' <> tshow i      -- octet
+        | TyPrim (Op.TyBits (Op.Bits 16)  _) <- t  = char 'h' <> tshow i     -- half
+        | TyPrim (Op.TyBits (Op.Bits 32)  _) <- t  = char 'w' <> tshow i     -- word
+        | TyPrim (Op.TyBits (Op.Bits 64)  _) <- t  = char 'd' <> tshow i     -- doubleword
+        | TyPrim (Op.TyBits (Op.Bits 128)  _) <- t  = char 'q' <> tshow i    -- quadword
+        | TyPrim (Op.TyBits (Op.BitsArch Op.BitsPtr)  _) <- t  = char 'p' <> tshow i
+        | TyPrim (Op.TyBits (Op.BitsArch Op.BitsMax)  _) <- t  = char 'm' <> tshow i
+        | TyPrim (Op.TyBits _ _) <- t  = char 'l' <> tshow i
hunk ./Grin/Grin.hs 400
-valIsNF (Tag _) = True
hunk ./Grin/Grin.hs 406
-    TyTag -> (Tag tagHole)
-    ty@(Ty _) -> (Lit 0 ty)
hunk ./Grin/Grin.hs 409
-isHole x = x `elem` map properHole [TyPtr TyNode, TyNode, TyTag]
+isHole x = x `elem` map properHole [TyPtr TyNode, TyNode]
hunk ./Grin/Grin.hs 472
-    getType (Tag _) = TyTag
hunk ./Grin/Grin.hs 475
-    getType (NodeV {}) = TyNode
hunk ./Grin/Grin.hs 492
-    freeVars (NodeV v xs) = Set.insert v $ freeVars xs
hunk ./Grin/Grin.hs 499
-    freeVars (NodeV v xs) = Set.insert (v,TyTag) $ freeVars xs
hunk ./Grin/Grin.hs 556
-    freeVars (NodeV _ xs) = freeVars xs
hunk ./Grin/Grin.hs 557
-    freeVars (Tag t) = Set.singleton t
hunk ./Grin/Grin.hs 588
--- Points to information
-{-
-
-data HeapType = Constant | SharedEval | UnsharedEval | Reference | RecursiveThunk
-    deriving(Eq,Ord)
-
-
-data Item = HeapValue (Set.Set HeapValue) | NodeValue (Set.Set NodeValue) | BasicValue Ty | TupledValue [Item]
-    deriving(Ord,Eq)
-data HeapValue = HV Int (Either (HeapType,Item) Val)  -- either a heap location or a constant
-data NodeValue = NV Tag [Item]
-    deriving(Ord,Eq)
-
-valToItem (Index v _) = valToItem v
-valToItem (Const v) = HeapValue (Set.singleton (HV (-1) (Right v)))
-valToItem (NodeC t as) = NodeValue (Set.singleton (NV t (map valToItem as)))
-valToItem (Lit _ ty) = BasicValue ty
---valToItem (Tup as) = TupledValue (map valToItem as)
-valToItem ~(Tag _) = BasicValue TyTag
-
-itemTag = BasicValue TyTag
-
-instance CanType Item Ty where
-    getType (HeapValue _) = TyPtr TyNode
-    getType NodeValue {} = TyNode
-    getType (BasicValue ty) = ty
---    getType (TupledValue xs) = TyTup (map getType xs)
-
-
--- heap locations are given a unique integer to break cycles.
-instance Eq HeapValue where
-    (HV x _) == (HV y _) = x == y
-instance Ord HeapValue where
-    compare (HV x _) (HV y _) = compare x y
-
-combineItem :: Item -> Item -> Item
-combineItem (BasicValue ty) (BasicValue ty') | ty == ty' = BasicValue ty
-combineItem (HeapValue s1) (HeapValue s2) = HeapValue (Set.union s1 s2)
-combineItem ~(NodeValue ns1) ~(NodeValue ns2) = NodeValue ns where
-    ns2map = Map.fromAscList [ (t,NV t as)| NV t as <- (Set.toAscList ns2)]
-    ns = Set.fromAscList [ NV t1 (zipWith combineItem as1 as2) | NV t1 as1 <- Set.toAscList ns1, NV _ as2 <- Map.lookup t1 ns2map  ] `Set.union` ns1
-
-combineItems :: [Item] -> Item
-combineItems [] = error "cannot combine no items"
-combineItems xs = foldl1 combineItem xs
-
-
-instance Tuple Val where
-    tupleMany vs = Tup vs
-
-instance Tuple Ty where
-    tupleMany ts = TyTup ts
-
-
-instance FromTuple Val where
-    fromTuple (Tup vs) = vs
-    fromTuple v = [v]
-
-instance FromTuple Ty where
-    fromTuple (TyTup ts) = ts
-    fromTuple v = [v]
-
-
-instance Tuple Item where
-    tupleMany vs = TupledValue vs
-
-instance FromTuple Item where
-    fromTuple (TupledValue ts) = ts
-    fromTuple x = [x]
--}
-
hunk ./Grin/Grin.hs 594
---isTup Tup {} = True
---isTup _ = False
hunk ./Grin/HashConst.hs 34
-            g (Tag t)
-                | fuzzy = return $ Left (Tag tagHole)
-                | otherwise = return $ Left (Tag t)
hunk ./Grin/Lint.hs 185
-    f (Tag _) = return TyTag
hunk ./Grin/Lint.hs 191
-    f (NodeV _v as) = do
-        mapM_ f as
-        return TyNode
hunk ./Grin/NodeAnalyze.hs 269
-    convertVal Tag {} = return $ Left VIgnore
hunk ./Grin/Noodle.hs 86
-    --f lf (Return (Tag t)) = return [t]
hunk ./Grin/Noodle.hs 105
---valIsConstant (Tup xs) = all valIsConstant xs
-valIsConstant (NodeC t _) | isMutableNodeTag t = False
hunk ./Grin/Noodle.hs 106
-valIsConstant Tag {} = True
hunk ./Grin/Noodle.hs 113
--- | Is type mutable (currently IORef)
-isMutableNodeTag :: Tag -> Bool
-isMutableNodeTag _ = False
---isMutableNodeTag t = t ==  convertName dc_Ref
-
-valIsMutable (NodeC t _) = isMutableNodeTag t || t == tagHole
---valIsMutable NodeC {} = False
-valIsMutable _ = True
hunk ./Grin/Noodle.hs 119
-isOmittable (Store (NodeC n _)) | isMutableNodeTag n || n == tagHole = False
hunk ./Grin/Noodle.hs 187
-    f lf (Return [(NodeV t as)]) = tells (ReturnNode (Nothing,map getType as))
hunk ./Grin/Optimize.hs 182
-        h (Store (NodeC t xs)) | not (isMutableNodeTag t), t `member` sset = do
+        h (Store (NodeC t xs)) | t `member` sset = do
hunk ./Grin/Show.hs 133
-prettyVal (NodeV (V i) vs) = parens $ char 't' <> tshow i <+> hsep (map prettyVal vs)
hunk ./Grin/Show.hs 134
-prettyVal (Tag t) = tag (fromAtom t)
-prettyVal (Var (V i) t)
-    | TyPtr TyNode <- t = text "ni" <> tshow i
-    | TyNode <- t = text "nd" <> tshow i
-    | TyPtr (TyPtr TyNode) <- t = text "np" <> tshow i
-    | TyPrim Op.TyBool <- t  = char 'b' <> tshow i
-    | TyPrim (Op.TyBits _ Op.HintFloat) <- t  = char 'f' <> tshow i
-    | TyPrim (Op.TyBits _ Op.HintCharacter) <- t  = char 'c' <> tshow i
-    | TyPrim (Op.TyBits (Op.Bits 8)  _) <- t  = char 'o' <> tshow i      -- octet
-    | TyPrim (Op.TyBits (Op.Bits 16)  _) <- t  = char 'h' <> tshow i     -- half
-    | TyPrim (Op.TyBits (Op.Bits 32)  _) <- t  = char 'w' <> tshow i     -- word
-    | TyPrim (Op.TyBits (Op.Bits 64)  _) <- t  = char 'd' <> tshow i     -- doubleword
-    | TyPrim (Op.TyBits (Op.Bits 128)  _) <- t  = char 'q' <> tshow i    -- quadword
-    | TyPrim (Op.TyBits (Op.BitsArch Op.BitsPtr)  _) <- t  = char 'p' <> tshow i
-    | TyPrim (Op.TyBits (Op.BitsArch Op.BitsMax)  _) <- t  = char 'm' <> tshow i
-    | TyPrim (Op.TyBits _ _) <- t  = char 'l' <> tshow i
-prettyVal (Var (V i) _) = char 'v' <> tshow i
+prettyVal v@Var {} = tshow v
hunk ./Grin/Show.hs 169
-{-
-showSome xs = f 7 xs [] where
-    f 0 _ xs = reverse ("...":xs)
-    f _ [] xs = reverse xs
-    f n (x:xs) rs = f (n - 1) xs (x:rs)
-
-instance Show Item where
-    show (BasicValue ty) = "<" ++ show ty ++ ">"
-    show (HeapValue hv) = braces $ hcat $ punctuate "," (showSome $ map show (Set.toList hv))
-    show (NodeValue hv) = braces $ hcat $ punctuate "," (showSome $ 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 (Const 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"
-
--}
hunk ./Grin/Simplify.hs 86
-    gs (Store n) | valIsNF n, not (valIsMutable n) = do
+    gs (Store n) | valIsNF n = do
hunk ./Grin/Simplify.hs 120
---    gv (NodeV v [],Return (NodeC t' [])) = do
---            lift $ tick stats at_OptSimplifyEnumAssignment
---            gv (Var v TyTag, Return (Tag t'))
---    gv (NodeV v [],Return (NodeV v' [])) = do
---            lift $ tick stats at_OptSimplifyEnumAssignment
---            gv (Var v TyTag, Return (Var v' TyTag))
hunk ./Grin/Simplify.hs 198
-varBind (Tag i) (Tag i') | i == i' = return mempty
hunk ./Grin/Simplify.hs 208
-varBind' (Tag i) (Tag i') | i == i' = return mempty
hunk ./Grin/Simplify.hs 236
---    f lf (Return (NodeV t [])) | postEval = return [UnboxTag]
hunk ./Grin/Simplify.hs 258
---    f (Return (NodeV t [])) = Return (Var t TyTag)
hunk ./Grin/Simplify.hs 279
-isKnown Tag {} = True
hunk ./Grin/Simplify.hs 301
---    f (Return t@NodeV {} :>>= v@Var {} :-> Update w v' :>>= lr) | v == v' = do
---        mtick "Optimize.optimize.return-update"
---        f (Return t :>>= v :-> Update w t :>>= lr)
hunk ./Grin/Simplify.hs 534
---    knownCase (Tag t) as = do
---        mtick $ "Optimize.optimize.known-case-tag.{" ++ show t
---        let f [] =  Error "known-case: No known case" (getType (Case (Tag t) as))
---            f ((v@[Var {}] :-> b):_) = Return (Tag t) :>>= v :-> b
-----            f ((Tag t' :-> b):_) | t == t' = b
---            f (_:as) = f as
---        return $ f as
hunk ./Grin/Val.hs 18
+import qualified C.Op as Op
hunk ./Grin/Val.hs 62
-    toUnVal c =   Lit (fromIntegral $ ord c) (Ty cChar)
+    toUnVal c =   Lit (fromIntegral $ ord c) tIntzh
hunk ./Grin/Whiz.hs 211
---    f (Tup vs) = do
---        vs' <- mapM f vs
---        return $ Tup vs'
-    f (NodeV t vs) | Just (Var t' _) <- Map.lookup t env = do
-        vs' <- mapM f vs
-        return $ NodeV t' vs'
-    f (NodeV t vs) = do
-        vs' <- mapM f vs
-        return $ NodeV t vs'
hunk ./Grin/Whiz.hs 225
---    f (Tup vs) = do
---        vs' <- mapM f vs
---        return $ Tup vs'
-    f (NodeV t vs) = do
-        t' <- lift $ newVarName t
-        tell (Map.singleton t (Var t' TyTag))
-        vs' <- mapM f vs
-        return $ NodeV t' vs'