[add support for storing small integer values directly in nodes.
John Meacham <john@repetae.net>**20080322225801] hunk ./C/FromGrin2.hs 21
-import Cmm.Number
hunk ./C/FromGrin2.hs 59
+    rCPR  :: Set.Set Atom,
hunk ./C/FromGrin2.hs 70
-runC grin (C m) =  execUniq1 (runRWST m Env { rGrin = grin, rDeclare = False, rTodo = TodoExp [], rEMap = mempty, rInscope = mempty } emptyHcHash)
+runC grin (C m) =  execUniq1 (runRWST m Env { rCPR = cpr, rGrin = grin, rDeclare = False, rTodo = TodoExp [], rEMap = mempty, rInscope = mempty } emptyHcHash) where
+    TyEnv tmap = grinTypeEnv grin
+    cpr = Set.fromList [ a | (a,TyTy { tySlots = [s], tySiblings = Just [a'] }) <- Map.assocs tmap, a == a', isJust (good s) ]
+    good s = do
+        ct <- Op.toCmmTy s
+        b <- Op.cmmTyBits ct
+        guard $ b <= 30
+        Op.HintNone <- Op.cmmTyHint ct
+        return True
hunk ./C/FromGrin2.hs 178
+        cpr <- asks rCPR
hunk ./C/FromGrin2.hs 185
-                        (_,i) <- newConst h
+                        (_,i) <- newConst cpr h
hunk ./C/FromGrin2.hs 188
-                (_,i) <- newConst h
+                (_,i) <- newConst cpr h
hunk ./C/FromGrin2.hs 191
+        cpr <- asks rCPR
hunk ./C/FromGrin2.hs 196
-                (_,i) <- newConst h
+                (_,i) <- newConst cpr h
hunk ./C/FromGrin2.hs 285
+    cpr <- asks rCPR
hunk ./C/FromGrin2.hs 293
+        da ~(NodeC t as) e = nodeAssign v t as e
+        {-
+        da (NodeC t [a]) e | t `Set.member` cpr = do
+            a' <- iDeclare $ convertVal a
+            let tmp = concrete t  scrut
+                ass = mconcat [if needed a then a' =* (project' (arg i) tmp) else mempty | a' <- as' | a <- as | i <- [(1 :: Int) ..] ]
+                fve = freeVars e
+                needed ~(Var v _) = v `Set.member` fve
+            e' <- convertBody e
+            return (ass & e')
hunk ./C/FromGrin2.hs 313
+            -}
hunk ./C/FromGrin2.hs 469
-nodeAssign v t as e' = do
-    declareStruct t
-    v' <- convertVal v
-    as' <- iDeclare $ mapM convertVal as
-    let ass = concat [perhapsM (a `Set.member` fve) $ a' =* (project' (arg i) (concrete t v')) | a' <- as' | Var a _ <- as |  i <- [( 1 :: Int) ..] ]
-        fve = freeVars e'
-    ss' <- convertBody e'
-    return $ mconcat ass & ss'
+nodeAssign :: Val -> Atom -> [Val] -> Exp -> C Statement
+nodeAssign v t as e' = cna where
+    cna = do
+        cpr <- asks rCPR
+        if t `Set.notMember` cpr then na else do
+        v' <- convertVal v
+        [arg] <- return as
+        t <- convertType $ getType arg
+        arg' <- iDeclare $ convertVal arg
+        let s = arg' =* cast t (f_GETVALUE v')
+        ss <- convertBody e'
+        return $ s & ss
+    na = do
+        declareStruct t
+        v' <- convertVal v
+        as' <- iDeclare $ mapM convertVal as
+        let ass = concat [perhapsM (a `Set.member` fve) $ a' =* (project' (arg i) (concrete t v')) | a' <- as' | Var a _ <- as |  i <- [( 1 :: Int) ..] ]
+            fve = freeVars e'
+        ss' <- convertBody e'
+        return $ mconcat ass & ss'
hunk ./C/FromGrin2.hs 569
-convertConst (NodeC n as) = basicNode n as
+convertConst (NodeC n as) | all valIsConstant as = basicNode n as
hunk ./C/FromGrin2.hs 714
-      Just e -> return (mempty,e)
+      Just e -> return (mempty,if ty == wptr_t then e else cast ty e)
hunk ./C/FromGrin2.hs 759
-basicNode a [Lit v ty] = do
-    tyenv <- asks (grinTypeEnv . rGrin)
-    return $ do
-        TyTy { tySiblings = s } <- findTyTy tyenv a
-        [n'] <- s
-        guard $ n' == a
-        b <- Op.cmmTyBits ty
-        guard $ b <= 30
-        Op.HintNone <- Op.cmmTyHint ty
-        v <- toIntegral v
-        Just (f_VALUE (constant $ number v))
+basicNode a [v] = do
+    cpr <- asks rCPR
+    if a `Set.notMember` cpr then return Nothing else do
+        v <- convertVal v
+        return $ Just (f_VALUE v)
hunk ./C/FromGrin2.hs 804
+f_GETVALUE e  = functionCall (name "GETVALUE") [e]
hunk ./Grin/HashConst.hs 5
+import qualified Data.Set as Set
hunk ./Grin/HashConst.hs 21
-newConst :: MonadState HcHash m => Val -> m (Bool,Int)
-newConst n = f n where
+newConst :: MonadState HcHash m => Set.Set Atom -> Val -> m (Bool,Int)
+newConst cpr n = f n where
hunk ./Grin/HashConst.hs 31
+            g n@(Const (NodeC a _)) | a `Set.member` cpr = return $ Left n
+            g n@(NodeC a _) | a `Set.member` cpr  = return $ Left n
hunk ./data/rts/jhc_rts2.c 13
+#define GETVALUE(n)  ((uintptr_t)(n) >> 2)