[make the C code generator understand unboxed tuples
John Meacham <john@repetae.net>**20051005052149] hunk ./C/FromGrin.hs 92
---cVal (Tup xs) = do
---    xs' <- mapM cVal xs
---    ts <-   mapM (toType . getType) xs
---    t <-   newAnonStruct ts
---    tup <-  newAuto t
---    addStmts [ anonField tup i `CSAssign` x  | i <- [0..] | x <- xs' ]
---    return tup
+cVal (Tup []) = return $ CEDoc "/* () */"
+cVal (Tup xs) = do
+    xs' <- mapM cVal xs
+    ts <-   mapM (toType . getType) xs
+    t <-   newAnonStruct ts
+    tup <-  newAuto t
+    addStmts [ anonField tup i `CSAssign` x  | i <- [0..] | x <- xs' ]
+    return tup
hunk ./C/FromGrin.hs 103
-cVal x = return $  CEDoc  ("/* cVal: " ++ show x  ++ " */")
+cVal x = return $  CEDoc  ("/* ERROR cVal: " ++ show x  ++ " */")
hunk ./C/FromGrin.hs 113
-    let n = "auto" ++ n
+    let n = "auto" ++ nn
hunk ./C/FromGrin.hs 157
-    return $ CECast t' (CEDoc "0")
+    case t' of
+        CTypeStruct _ -> newAuto t'
+        _ -> return $ CECast t' (CEDoc "0")
hunk ./C/FromGrin.hs 284
+cb (e :>>= Tup [x] :-> e') = cb (e :>>= x :-> e')
+cb (e :>>= Tup xs :-> e') = do
+    (rs,ret) <- lift $ runSubCGen $ do
+        ts <- mapM (toType . getType) xs
+        st <- newAnonStruct ts
+        ret <- newAuto st
+        return ret
+    ss <- local (const (TodoExp ret)) (cb e)
+    ss' <- cb e'
+    vs <- mapM cVal xs
+    vds <- mapM declVar xs
+    return $ vds ++ rs ++ ss ++ [ v `CSAssign` anonField ret i | v <- vs | i <- [0..] ]  ++ ss'
+
+{-
+    return []
+
+    v' <- cVal v
+    ss <- local (const (TodoExp v')) (cb e)
+    ss' <- cb e'
+    v'' <- declVar v
+    return (v'':ss ++ ss')
+    -}
hunk ./C/FromGrin.hs 361
-    ans = vcat $ map include (snub $ reqIncludes req) ++ [text "",et,text ""] ++ map cs tags ++ [text "",cn,text "",so,text "",text "/* Begin CAFS */"] ++ map ccaf (grinCafs grin) ++ [text "", consts, text "",text  "/* Begin Functions */"] ++ map prettyFuncP funcs ++ (map prettyFunc funcs)
+    ans = vcat $ map include (snub $ reqIncludes req) ++ [text "",et,text ""] ++ decls' ++ map cs tags ++ [text "",cn,text "",so,text "",text "/* Begin CAFS */"] ++ map ccaf (grinCafs grin) ++ [text "", consts, text "",text  "/* Begin Functions */"] ++ map prettyFuncP funcs ++ (map prettyFunc funcs)
hunk ./C/FromGrin.hs 366
-    so = prettyDecl $ CFunc size_t "jhc_sizeof" [(tag_t,"tag")] [CSDoc $ "switch(tag) {\n" ++ concatMap cs (fsts tags) ++ "}\n_exit(33);"] where
+    so = prettyDecl $ CFunc size_t "jhc_sizeof" [(tag_t,"tag")] [CSDoc $ "switch(tag) {\n" ++ concatMap cs (fsts tags) ++ "}\n_exit(33);"]  where
hunk ./C/FromGrin.hs 369
+    decls' = map prettyDecl decls
hunk ./C/FromGrin.hs 371
-    ((funcs',CGenState { genStateRequires = req, genStateDecls = d }),fh) = runState  (runCGen 1 (mapM (cfunc $ grinTypeEnv grin) $ grinFunctions grin)) emptyHcHash
+    ((funcs',CGenState { genStateRequires = req, genStateDecls = decls }),fh) = runState  (runCGen 1 (mapM (cfunc $ grinTypeEnv grin) $ grinFunctions grin)) emptyHcHash
hunk ./C/Gen.hs 171
-    CGenState { genUnique = v } <- get
-    --(r,CGenState { genStateDecls = d, genStateStatements = s, genUnique = v' }) <- lift $ runCGen v x -- runStateT x ([],[],v)
-    (r,CGenState { genStateDecls = d, genStateStatements = s, genUnique = v' }) <- lift $ runStateT x cGenState { genUnique = v }
+    CGenState { genUnique = v, genStateAnonStructs = anonS } <- get
+    (r,CGenState { genStateRequires = req, genStateAnonStructs = as, genStateDecls = d, genStateStatements = s, genUnique = v' }) <- lift $ runStateT x cGenState { genUnique = v, genStateAnonStructs = anonS }
hunk ./C/Gen.hs 174
-    modify (\cg -> cg { genUnique = v' })
+    modify (genUnique_s v' . genStateRequires_u (mappend req) . genStateAnonStructs_s as)
hunk ./C/Gen.hs 193
-
-{-
-
-instance Monad m => Unique (CGen m) where
-    modifyGetUniqueState f = do
-	modify (\(x,y,z) -> (x,y,f z))
-	(_,_,z) <- get
-	return z
-
-instance Monad m => UniqueProducer (CGen m) where
-    newUniq = newUniq_d
--}