[omit discriminator when it isn't important in structures
John Meacham <john@repetae.net>**20100319054850
 Ignore-this: 5b7eb5c905d946d4c32f3e1d06eb2e95
] hunk ./src/C/FromGrin2.hs 57
+-- special type representations when possible
+data TyRep
+    = TyRepRawTag    -- stored raw tag
+    | TyRepUntagged  -- memory, without a tag
+    | TyRepRawVal !Bool   -- stored raw argument and whether it is signed
+
hunk ./src/C/FromGrin2.hs 69
-    rCPR  :: Map.Map Atom Bool,
+    rCPR  :: Map.Map Atom TyRep,
+    rConst :: Set.Set Atom,
hunk ./src/C/FromGrin2.hs 80
-runC :: Grin -> C a -> (a,HcHash,Written)
-runC grin (C m) =  execUniq1 (runRWST m startEnv  emptyHcHash) where
+runC :: Grin -> C a -> ((a,HcHash,Written),Map.Map Atom TyRep)
+runC grin (C m) =  (execUniq1 (runRWST m startEnv emptyHcHash),ityrep) where
hunk ./src/C/FromGrin2.hs 83
+    ityrep = Map.mapMaybeWithKey tyRep tmap
hunk ./src/C/FromGrin2.hs 85
-        rCPR = cpr,
+        rCPR = ityrep,
hunk ./src/C/FromGrin2.hs 91
+        rConst = Map.keysSet $ Map.filter isConst ityrep,
hunk ./src/C/FromGrin2.hs 94
-    cpr = iw `Map.union` Map.insert cChar False (Map.fromList [ (a,False) | (a,TyTy { tySlots = [s], tySiblings = Just [a'] }) <- Map.assocs tmap, a == a', isJust (good s) ])
-    iw = if fopts FO.FullInt then mempty else Map.fromList [(cInt,True), (cWord,False)]
-    good s = do
+    isConst TyRepRawVal {} = True
+    isConst TyRepRawTag {} = True
+    isConst _ = False
+    tyRep k _ | k == cChar = Just $ TyRepRawVal False
+    tyRep k _ | not (fopts FO.FullInt), k == cWord = Just $ TyRepRawVal False
+    tyRep k _ | not (fopts FO.FullInt), k == cInt = Just $ TyRepRawVal True
+    tyRep k TyTy { tySlots = [s], tySiblings = Just [k'] } | k == k', good s = Just $ TyRepRawVal False
+    tyRep k tyty | null (tySlots tyty) = Just TyRepRawTag
+    tyRep k tyty | Just xs <- tySiblings tyty, all triv [ x | x <- xs, x /= k] = Just TyRepUntagged where
+        triv x = case Map.lookup x tmap of
+            Just t -> null (tySlots t)
+            Nothing -> False
+    tyRep _ _ = Nothing
+--    tyRep k tyty | tySiblings tyty == Just [k] = Just TyRepUntagged
+    --cpr = iw `Map.union` Map.insert cChar False (Map.fromList [ (a,False) | (a,TyTy { tySlots = [s], tySiblings = Just [a'] }) <- Map.assocs tmap, a == a', isJust (good s) ])
+    --iw = if fopts FO.FullInt then mempty else Map.fromList [(cInt,True), (cWord,False)]
+    good s = isJust $ do
hunk ./src/C/FromGrin2.hs 115
-        return True
+        return ()
hunk ./src/C/FromGrin2.hs 131
-    ans = vcat $ includes ++ [text "", enum_tag_t, header,cafs, buildConstants grin finalHcHash, body]
+    ans = vcat $ includes ++ [text "", enum_tag_t, header,cafs, buildConstants cpr grin finalHcHash, body]
hunk ./src/C/FromGrin2.hs 135
-    (cafs',finalHcHash,Written { wRequires = req, wFunctions = fm, wEnums = wenum, wStructures = sm, wTags = ts }) = runC grin $ go >> mapM convertCAF (grinCafs grin)
+    ((cafs',finalHcHash,Written { wRequires = req, wFunctions = fm, wEnums = wenum, wStructures = sm, wTags = ts }),cpr) = runC grin $ go >> mapM convertCAF (grinCafs grin)
hunk ./src/C/FromGrin2.hs 223
-        cpr <- asks rCPR
+        cpr <- asks rConst
hunk ./src/C/FromGrin2.hs 236
-        cpr <- asks rCPR
+        cpr <- asks rConst
hunk ./src/C/FromGrin2.hs 331
-    cpr <- asks rCPR
+    cpr <- asks rConst
hunk ./src/C/FromGrin2.hs 340
-        {-
-        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')
-        da ~(NodeC t as) e = do
-            tellTags t
-            declareStruct t
-            as' <- iDeclare $ mapM convertVal as
-            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 ./src/C/FromGrin2.hs 342
-            tellTags t2
-            return $ annotate (show p2) (f_assert ((constant $ enum (nodeTagName t2)) `eq` tag) & e)
-        tag = f_FETCH_TAG scrut
+            --tellTags t2
+            --return $ annotate (show p2) (f_assert ((constant $ enum (nodeTagName t2)) `eq` tag) & e)
+            return $ annotate (show p2) e
+        tag = if null fps then f_FETCH_RAW_TAG scrut else f_FETCH_TAG scrut
hunk ./src/C/FromGrin2.hs 520
-            Just signed -> do
+            Just (TyRepRawVal signed) -> do
hunk ./src/C/FromGrin2.hs 527
-            Nothing -> do
+            _ -> do
hunk ./src/C/FromGrin2.hs 600
-buildConstants grin fh = P.vcat (map cc (Grin.HashConst.toList fh)) where
+buildConstants cpr grin fh = P.vcat (map cc (Grin.HashConst.toList fh)) where
hunk ./src/C/FromGrin2.hs 605
-        Just TyTy { tySiblings = sibs } = findTyTy tyenv a
-        ntag = case sibs of
-            Just [a'] | a' == a -> []
+        --Just TyTy { tySiblings = sibs } = findTyTy tyenv a
+        ntag = case Map.lookup a cpr of
+            --Just [a'] | a' == a -> []
+            Just _ -> []
hunk ./src/C/FromGrin2.hs 615
-            Just e = fst3 . runC grin $ convertConst v
+            Just e = fst3 . fst . runC grin $ convertConst v
hunk ./src/C/FromGrin2.hs 733
+    cpr <- asks rCPR
hunk ./src/C/FromGrin2.hs 736
-    TyTy { tySiblings = sib } <- findTyTy tyenv t
-    tellTags t
-    case sib of
-        Just [n'] | n' == t -> return mempty
-        _ -> do return . toStatement $ f_SET_MEM_TAG e (constant (enum $ nodeTagName t))
+    --TyTy { tySiblings = sib } <- findTyTy tyenv t
+    case Map.lookup t cpr of
+        --Just [n'] | n' == t -> return mempty
+        Just _ -> return mempty
+        _ -> do
+            tellTags t
+            return . toStatement $ f_SET_MEM_TAG e (constant (enum $ nodeTagName t))
hunk ./src/C/FromGrin2.hs 796
+    cpr <- asks rCPR
hunk ./src/C/FromGrin2.hs 801
+                       | Just TyRepUntagged <- Map.lookup n cpr = ([],False)
hunk ./src/C/FromGrin2.hs 821
-        Nothing -> return Nothing
-        Just signed -> case v of
+        Just (TyRepRawVal signed) -> case v of
hunk ./src/C/FromGrin2.hs 832
+        _ -> return Nothing
hunk ./src/C/FromGrin2.hs 895
+f_FETCH_RAW_TAG e = functionCall (name "FETCH_RAW_TAG") [e]
+f_FETCH_MEM_TAG e = functionCall (name "FETCH_MEM_TAG") [e]
hunk ./src/Grin/HashConst.hs 21
-newConst :: MonadState HcHash m => Map.Map Atom a -> Val -> m (Bool,Int)
+newConst :: MonadState HcHash m => Set.Set Atom -> Val -> m (Bool,Int)
hunk ./src/Grin/HashConst.hs 31
-            g n@(Const (NodeC a _)) | a `Map.member` cpr = return $ Left n
-            g n@(NodeC a _) | a `Map.member` cpr  = return $ Left n
+            g n@(Const (NodeC a _)) | a `Set.member` cpr = return $ Left n
+            g n@(NodeC a _) | a `Set.member` cpr  = return $ Left n