[modify hashconster to know we don't need to allocate nodes that have no fields, modify code to always emit heap-less nodes when the node has no arguments
John Meacham <john@repetae.net>**20080311170446] {
hunk ./C/FromGrin2.hs 88
-    ans = vcat $ includes ++ [text "", enum_tag_t, header, cafs,buildConstants (grinTypeEnv grin) finalHcHash, body]
+    ans = vcat $ includes ++ [text "", enum_tag_t, header, cafs,buildConstants grin finalHcHash, body]
hunk ./C/FromGrin2.hs 103
-        let tset = Set.fromList [ n | (HcNode n (_:_),_) <- Grin.HashConst.toList h]
-            tset' = Set.fromList [ n | (HcNode n [],_) <- Grin.HashConst.toList h]
+        let tset = Set.fromList [ n | (HcNode n (_:_),_) <- hconsts]
+            tset' = Set.fromList [ n | (HcNode n [],_) <- hconsts]
+            hconsts = Grin.HashConst.toList h
+        mapM_ tellAllTags [ v  | (HcNode _ vs,_) <- hconsts, Left v <- vs]
hunk ./C/FromGrin2.hs 166
-convertVal v | Just e <- convertConst v = return e
+convertVal v | Just e <- convertConst v = e
hunk ./C/FromGrin2.hs 506
-buildConstants tyenv fh = P.vcat (map cc (Grin.HashConst.toList fh)) where
+buildConstants grin fh = P.vcat (map cc (Grin.HashConst.toList fh)) where
+    tyenv = grinTypeEnv grin
hunk ./C/FromGrin2.hs 522
-        f (Left v) = text (show $ drawG e) where
+        f (Left v) = text (show $ drawG (fst3 $ runC grin e)) where
hunk ./C/FromGrin2.hs 525
-convertConst :: Monad m => Val -> m Expression
-convertConst (Const (NodeC h _)) | h == tagHole = return (cast sptr_t (f_VALUE (constant $ number 0)))
-convertConst (Lit i (TyPrim Op.TyBool)) = return $ if i == 0 then constant cFalse else constant cTrue
-convertConst (Lit i (TyPrim (Op.TyBits _ Op.HintFloat))) = return (constant $ floating (realToFrac i))
-convertConst (Lit i _) = return (constant $ number (fromIntegral i))
-convertConst (ValPrim (APrim p _) [] _) = case p of
-    CConst s _ -> return $ expressionRaw s
-    AddrOf t -> return $ expressionRaw ('&':unpackPS t)
-    PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimSizeOf } -> return $ expressionRaw ("sizeof(" ++ tyToC Op.HintUnsigned arg ++ ")")
-    PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimMinBound } -> return $ expressionRaw ("prim_minbound(" ++ tyToC Op.HintUnsigned arg ++ ")")
-    PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimMaxBound } -> return $ expressionRaw ("prim_maxbound(" ++ tyToC Op.HintUnsigned arg ++ ")")
-    PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimUMaxBound } -> return $ expressionRaw ("prim_umaxbound(" ++ tyToC Op.HintUnsigned arg ++ ")")
-    PrimString s -> return $ cast (basicType "uintptr_t") (expressionRaw (show s))
-    x -> return $ err (show x)
-convertConst (ValPrim (APrim p _) [x] (TyPrim opty)) = do
-    x' <- convertConst x
-    case p of
-        Op (Op.UnOp n ta) r -> primUnOp n ta r x'
-        Op (Op.ConvOp n ta) r -> return $ castFunc n ta r x'
-        x -> return $ err (show x)
-convertConst (ValPrim (APrim p _) [x,y] _) = do
-    x' <- convertConst x
-    y' <- convertConst y
-    case p of
-        Op (Op.BinOp n ta tb) r -> primBinOp n ta tb r x' y'
+convertConst :: Val -> Maybe (C Expression)
+convertConst (Const (NodeC n [])) = Just $ do tellTags n ; return (cast sptr_t $ f_RAWWHAT (constant $ enum (nodeTagName n)))
+convertConst (NodeC n [])  = Just $ do tellTags n ;  return (f_RAWWHAT (constant $ enum (nodeTagName n)))
+convertConst v = fmap return (f v) where
+    f :: Val -> Maybe Expression
+    f (Lit i (TyPrim Op.TyBool)) = return $ if i == 0 then constant cFalse else constant cTrue
+    f (Lit i (TyPrim (Op.TyBits _ Op.HintFloat))) = return (constant $ floating (realToFrac i))
+    f (Lit i _) = return (constant $ number (fromIntegral i))
+    f (ValPrim (APrim p _) [] _) = case p of
+        CConst s _ -> return $ expressionRaw s
+        AddrOf t -> return $ expressionRaw ('&':unpackPS t)
+        PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimSizeOf } -> return $ expressionRaw ("sizeof(" ++ tyToC Op.HintUnsigned arg ++ ")")
+        PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimMinBound } -> return $ expressionRaw ("prim_minbound(" ++ tyToC Op.HintUnsigned arg ++ ")")
+        PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimMaxBound } -> return $ expressionRaw ("prim_maxbound(" ++ tyToC Op.HintUnsigned arg ++ ")")
+        PrimTypeInfo { primArgTy = arg, primTypeInfo = PrimUMaxBound } -> return $ expressionRaw ("prim_umaxbound(" ++ tyToC Op.HintUnsigned arg ++ ")")
+        PrimString s -> return $ cast (basicType "uintptr_t") (expressionRaw (show s))
hunk ./C/FromGrin2.hs 542
-convertConst x = fail "convertConst"
+    f (ValPrim (APrim p _) [x] (TyPrim opty)) = do
+        x' <- f x
+        case p of
+            Op (Op.UnOp n ta) r -> primUnOp n ta r x'
+            Op (Op.ConvOp n ta) r -> return $ castFunc n ta r x'
+            x -> return $ err (show x)
+    f (ValPrim (APrim p _) [x,y] _) = do
+        x' <- f x
+        y' <- f y
+        case p of
+            Op (Op.BinOp n ta tb) r -> primBinOp n ta tb r x' y'
+            x -> return $ err (show x)
+    f x = fail "f"
hunk ./C/FromGrin2.hs 645
+
+tellAllTags :: Val -> C ()
+tellAllTags (NodeC n vs) = tellTags n >> mapM_ tellAllTags vs
+tellAllTags n = mapValVal tt n >> return () where
+    tt v = tellAllTags v >> return v
+
hunk ./C/FromGrin2.hs 657
-        Just [n'] | n' == t ->  return ()
+--        Just [n'] | n' == t ->  return ()
hunk ./C/FromGrin2.hs 705
-    Just [n'] | n' == a -> return $ Just (f_VALUE (constant $ number 0))
+--    Just [n'] | n' == a -> return $ Just (f_VALUE (constant $ number 0))
hunk ./Grin/HashConst.hs 1
-module Grin.HashConst where
+module Grin.HashConst(newConst,HcHash(),HcNode(..),toList,emptyHcHash) where
hunk ./Grin/HashConst.hs 20
-{-# INLINE newConst #-}
-{-# INLINE newConst' #-}
hunk ./Grin/HashConst.hs 33
+            g n@(Const (NodeC _ [])) = return $ Left n
+            g n@(NodeC _ []) = return $ Left n
}
