[rearrange structure in generated c code to make them more compact and group GC followed pointers together
John Meacham <john@repetae.net>**20080313182657] hunk ./C/FromGrin2.hs 88
-    (header,body) = generateC False (Map.elems fm) (Map.elems sm)
+    (header,body) = generateC (Map.elems fm) (Map.elems sm)
hunk ./C/FromGrin2.hs 521
-    cc nn@(HcNode a [],i) = comm nn $$ def where
-        def = text "#define c" <> tshow i <+> text "(sptr_t)" <> tshow (f_RAWWHAT (constant $ enum (nodeTagName a)))
-
hunk ./C/FromGrin2.hs 522
-        cd = text "static const  struct " <> tshow (nodeStructName a) <+> text "_c" <> tshow i <+> text "= {" <> hsep (punctuate P.comma (ntag ++ rs)) <> text "};"
+        cd = text "static const struct" <+> tshow (nodeStructName a) <+> text "_c" <> tshow i <+> text "= {" <> hsep (punctuate P.comma (ntag ++ rs)) <> text "};"
hunk ./C/FromGrin2.hs 526
-            _ -> [tshow (nodeTagName a)]
+            _ -> [text ".what =" <+> tshow (nodeTagName a)]
hunk ./C/FromGrin2.hs 528
-        rs = [ f z undefined |  z <- zs ]
-        f (Right i) = text $ 'c':show i
-        f (Left (Var n _)) = tshow $ varName n
-        f (Left v) = text (show $ drawG (fst3 $ runC grin e)) where
+        rs = [ f z i |  (z,i) <- zip zs [ 1 :: Int .. ]]
+        f (Right i) a = text ".a" <> tshow a <+> text "=" <+> text ('c':show i)
+        f (Left (Var n _)) a = text ".a" <> tshow a <+> text "=" <+> tshow (varName n)
+        f (Left v) a = text ".a" <> tshow a <+> text "=" <+> text (show $ drawG (fst3 $ runC grin e)) where
hunk ./C/FromGrin2.hs 708
-    let tag | tagIsSuspFunction n = [(name "head",fptr_t)]
-            | null ts = []
-            | Just [n'] <- ss, n == n' = []
-            | otherwise = [(name "what",what_t)]
-        fields = (tag ++ zip [ name $ 'a':show i | i <-  [(1 :: Int) ..] ] ts')
-    unless (null fields) $ tell mempty { wStructures = Map.singleton (nodeStructName n) $ Structure { structureName = nodeStructName n, structureFields = fields, structureAligned = True } }
+    let (dis,needsDis) | tagIsSuspFunction n = ([(name "head",fptr_t)],False)
+                       | null ts = ([],False)
+                       | Just [n'] <- ss, n == n' = ([],False)
+                       | otherwise = ([],True)
+        fields = (dis ++ zip [ name $ 'a':show i | i <-  [(1 :: Int) ..] ] ts')
+        theStruct = basicStructure {
+            structureName = nodeStructName n,
+            structureFields = fields,
+            structureAligned = True,
+            structureHasDiscriminator = not $ null dis,
+            structureNeedsDiscriminator = needsDis
+            }
+    unless (null fields) $ tell mempty { wStructures = Map.singleton (structureName theStruct) theStruct }
hunk ./C/FromGrin2.hs 799
-what_t    = basicType "what_t"
hunk ./C/Generate.hs 4
+    basicStructure,
hunk ./C/Generate.hs 574
-    structureAligned :: Bool
+    structureNeedsDiscriminator :: Bool,    -- ^ emit a macro that declares a discriminator when needed
+    structureHasDiscriminator   :: Bool,    -- ^ the first field must appear first in the on memory layout, don't move it.
+    structureAligned :: Bool                -- ^ this structure needs to be aligned to a pointer boundry, even if it woudn't be otherwise.
hunk ./C/Generate.hs 579
-generateC :: Bool              -- ^ whether to add tag nodes
-    -> [Function]              -- ^ functions
+basicStructure = Structure {
+    structureName = error "basicStructure: Name",
+    structureFields = [],
+    structureNeedsDiscriminator = False,
+    structureHasDiscriminator   = False,
+    structureAligned            = False
+    }
+
+generateC
+    :: [Function]              -- ^ functions
hunk ./C/Generate.hs 591
-generateC genTag fs ss = ans where
+generateC fs ss = ans where
hunk ./C/Generate.hs 596
-        shead2 <- declStructs genTag ss
+        shead2 <- declStructs ss
hunk ./C/Generate.hs 600
-    anons = [ Structure { structureName = n, structureFields = fields ts, structureAligned = False }  | (ts,n) <- Map.toList ass ] where
+    anons = [ basicStructure { structureName = n, structureFields = fields ts }  | (ts,n) <- Map.toList ass ] where
hunk ./C/Generate.hs 603
-    G anons' = declStructs False anons
+    G anons' = declStructs anons
hunk ./C/Generate.hs 605
-
-    declStructs ht ss = liftM vsep $ forM ss $ \ Structure { structureName = n, structureFields = ts } -> do
-            ts' <- forM ts $ \ (n,t) -> do
-                t <- draw t
-                return $ t <+> tshow n <> semi
-            return $ text "struct" <+> tshow n <+> lbrace $$ nest 4 (vcat $ (if ht then text "tag_t tag;" else empty):ts') $$ rbrace <> semi
hunk ./C/Generate.hs 607
+    declStructs ss = liftM vsep $ forM ss $ \ s@Structure { structureName = n, structureFields = ts } -> do
+        let tsort [] = []
+            tsort (t:ts) | structureHasDiscriminator s = t:rsort ts
+                         | otherwise = rsort (t:ts)
+            rsort = sortUnder (cmp . snd)
+            numGC = length [ () | (_,TB _ True) <- ts ]
+            ppri = if numGC /= 0 then 2 else 5
+            -- pointers first, garbage collected, then rest
+            cmp (TB _ True) = (1::Int)
+            cmp TFunPtr {}  = ppri
+            cmp TPtr {}     = ppri
+            cmp (TB s _)    = maybe 5  id (lookup s tmap)
+            cmp _ = 5
+            tmap = [ "uintmax_t" ==> 3, "uintptr_t" ==> ppri, "double" ==> 4, "uint32_t" ==> 6, "float" ==> 6, "uint16_t" ==> 7, "uint8_t" ==> 8]
+            x ==> y = (x,y)
+
+        ts' <- forM (tsort ts) $ \ (n,t) -> do
+            t <- draw t
+            return $ t <+> tshow n <> semi
+        return $ text "struct" <+> tshow n <+> lbrace $$ nest 4 (vcat $ (if structureNeedsDiscriminator s  then text "what_t what;" else empty):ts') $$ rbrace <> semi
+