Working on C++ code generator, need to sleep now though.

compiler/capnproto-compiler.cabal

@@ -7,18 +7,25 @@ author:         kenton
 executable capnproto-compiler
   hs-source-dirs:  src
   main-is:         Main.hs
-  build-depends:   
+  build-depends:
                    base >= 4,
                    parsec,
                    mtl,
-                   containers
+                   containers,
+                   file-embed,
+                   bytestring,
+                   Crypto,
+                   utf8-string,
+                   hastache
   ghc-options:     -Wall -fno-warn-missing-signatures
-  other-modules:   
+  other-modules:
                    Lexer,
                    Token,
                    Grammar,
                    Parser,
                    Compiler,
                    Semantics,
-                   Util
+                   Util,
+                   CxxGenerator,
+                   WireFormat
 

compiler/src/CxxGenerator.hs

+-- Copyright (c) 2013, Kenton Varda <temporal@gmail.com>
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are met:
+--
+-- 1. Redistributions of source code must retain the above copyright notice, this
+--    list of conditions and the following disclaimer.
+-- 2. Redistributions in binary form must reproduce the above copyright notice,
+--    this list of conditions and the following disclaimer in the documentation
+--    and/or other materials provided with the distribution.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module CxxGenerator(generateCxx) where
+
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.UTF8 as UTF8
+import Data.FileEmbed(embedFile)
+import Data.Char(ord)
+import qualified Data.Digest.MD5 as MD5
+import Text.Printf(printf)
+import Text.Hastache
+import Text.Hastache.Context
+
+import Semantics
+import Util
+
+-- MuNothing isn't considered a false value for the purpose of {{#variable}} expansion.  Use this
+-- instead.
+muNull = MuBool False;
+
+hashString :: String -> String
+hashString str =
+    concatMap (printf "%02x" . fromEnum) $
+    MD5.hash $
+    ByteString.unpack $
+    UTF8.fromString str
+
+isPrimitive (BuiltinType _) = True
+isPrimitive (EnumType _) = True
+isPrimitive (StructType _) = False
+isPrimitive (InterfaceType _) = False
+isPrimitive (ListType _) = False
+
+isStruct (StructType _) = True
+isStruct _ = False
+
+isList (ListType _) = True
+isList _ = False
+
+isPrimitiveList (ListType t) = isPrimitive t
+isPrimitiveList _ = False
+
+isStructList (ListType t) = isStruct t
+isStructList _ = False
+
+cxxTypeString (BuiltinType BuiltinVoid) = "void"
+cxxTypeString (BuiltinType BuiltinBool) = "bool"
+cxxTypeString (BuiltinType BuiltinInt8) = "int8_t"
+cxxTypeString (BuiltinType BuiltinInt16) = "int16_t"
+cxxTypeString (BuiltinType BuiltinInt32) = "int32_t"
+cxxTypeString (BuiltinType BuiltinInt64) = "int64_t"
+cxxTypeString (BuiltinType BuiltinUInt8) = "uint8_t"
+cxxTypeString (BuiltinType BuiltinUInt16) = "uint16_t"
+cxxTypeString (BuiltinType BuiltinUInt32) = "uint32_t"
+cxxTypeString (BuiltinType BuiltinUInt64) = "uint64_t"
+cxxTypeString (BuiltinType BuiltinFloat32) = "float"
+cxxTypeString (BuiltinType BuiltinFloat64) = "double"
+cxxTypeString (BuiltinType BuiltinText) = "TODO"
+cxxTypeString (BuiltinType BuiltinData) = "TODO"
+cxxTypeString (EnumType desc) = enumName desc
+cxxTypeString (StructType desc) = structName desc
+cxxTypeString (InterfaceType desc) = interfaceName desc
+cxxTypeString (ListType t) = concat ["::capnproto::List<", cxxTypeString t, ">"]
+
+cxxFieldSizeString Size0 = "VOID";
+cxxFieldSizeString Size1 = "BIT";
+cxxFieldSizeString Size8 = "BYTE";
+cxxFieldSizeString Size16 = "TWO_BYTES";
+cxxFieldSizeString Size32 = "FOUR_BYTES";
+cxxFieldSizeString Size64 = "EIGHT_BYTES";
+cxxFieldSizeString SizeReference = "REFERENCE";
+cxxFieldSizeString (SizeInlineComposite _ _) = "INLINE_COMPOSITE";
+
+cEscape [] = []
+cEscape (first:rest) = result where
+    eRest = cEscape rest
+    result = case first of
+        '\a' -> '\\':'a':eRest
+        '\b' -> '\\':'b':eRest
+        '\f' -> '\\':'f':eRest
+        '\n' -> '\\':'n':eRest
+        '\r' -> '\\':'r':eRest
+        '\t' -> '\\':'t':eRest
+        '\v' -> '\\':'v':eRest
+        '\'' -> '\\':'\'':eRest
+        '\"' -> '\\':'\"':eRest
+        '\\' -> '\\':'\\':eRest
+        '?'  -> '\\':'?':eRest
+        c | c < ' ' || c > '~' -> '\\':(printf "%03o" (ord c) ++ eRest)
+        c    -> c:eRest
+
+cxxValueString VoidDesc = error "Can't stringify void value."
+cxxValueString (BoolDesc    b) = if b then "true" else "false"
+cxxValueString (Int8Desc    i) = show i
+cxxValueString (Int16Desc   i) = show i
+cxxValueString (Int32Desc   i) = show i
+cxxValueString (Int64Desc   i) = show i ++ "ll"
+cxxValueString (UInt8Desc   i) = show i
+cxxValueString (UInt16Desc  i) = show i
+cxxValueString (UInt32Desc  i) = show i ++ "u"
+cxxValueString (UInt64Desc  i) = show i ++ "llu"
+cxxValueString (Float32Desc x) = show x ++ "f"
+cxxValueString (Float64Desc x) = show x
+cxxValueString (TextDesc    s) = "\"" ++ cEscape s ++ "\""
+cxxValueString (DataDesc    _) = error "Data defaults are encoded as bytes."
+cxxValueString (EnumValueValueDesc v) =
+    cxxTypeString (EnumType $ enumValueParent v) ++ "::" ++
+    toUpperCaseWithUnderscores (enumValueName v)
+cxxValueString (StructValueDesc _) = error "Struct defaults are encoded as bytes."
+cxxValueString (ListDesc _) = error "List defaults are encoded as bytes."
+
+cxxDefaultDefault (BuiltinType BuiltinVoid) = error "Can't stringify void value."
+cxxDefaultDefault (BuiltinType BuiltinBool) = "false"
+cxxDefaultDefault (BuiltinType BuiltinInt8) = "0"
+cxxDefaultDefault (BuiltinType BuiltinInt16) = "0"
+cxxDefaultDefault (BuiltinType BuiltinInt32) = "0"
+cxxDefaultDefault (BuiltinType BuiltinInt64) = "0"
+cxxDefaultDefault (BuiltinType BuiltinUInt8) = "0"
+cxxDefaultDefault (BuiltinType BuiltinUInt16) = "0"
+cxxDefaultDefault (BuiltinType BuiltinUInt32) = "0"
+cxxDefaultDefault (BuiltinType BuiltinUInt64) = "0"
+cxxDefaultDefault (BuiltinType BuiltinFloat32) = "0"
+cxxDefaultDefault (BuiltinType BuiltinFloat64) = "0"
+cxxDefaultDefault (BuiltinType BuiltinText) = "\"\""
+cxxDefaultDefault (BuiltinType BuiltinData) = error "Data defaults are encoded as bytes."
+cxxDefaultDefault (EnumType desc) = cxxValueString $ EnumValueValueDesc $ head $ enumValues desc
+cxxDefaultDefault (StructType _) = error "Struct defaults are encoded as bytes."
+cxxDefaultDefault (InterfaceType _) = error "Interfaces have no default value."
+cxxDefaultDefault (ListType _) = error "List defaults are encoded as bytes."
+
+elementType (ListType t) = t
+elementType _ = error "Called elementType on non-list."
+
+fieldContext parent desc = mkStrContext context where
+    context "fieldName" = MuVariable $ fieldName desc
+    context "fieldDecl" = MuVariable $ descToCode "" (DescField desc)
+    context "fieldTitleCase" = MuVariable $ toTitleCase $ fieldName desc
+    context "fieldUpperCase" = MuVariable $ toUpperCaseWithUnderscores $ fieldName desc
+    context "fieldIsPrimitive" = MuBool $ isPrimitive $ fieldType desc
+    context "fieldIsStruct" = MuBool $ isStruct $ fieldType desc
+    context "fieldIsList" = MuBool $ isList $ fieldType desc
+    context "fieldIsPrimitiveList" = MuBool $ isPrimitiveList $ fieldType desc
+    context "fieldIsStructList" = MuBool $ isStructList $ fieldType desc
+    context "fieldDefaultBytes" = muNull
+    context "fieldType" = MuVariable $ cxxTypeString $ fieldType desc
+    context "fieldOffset" = MuVariable $ fieldOffset desc
+    context "fieldDefaultValue" = case fieldDefaultValue desc of
+        Just v -> MuVariable $ cxxValueString v
+        Nothing -> MuVariable $ cxxDefaultDefault $ fieldType desc
+    context "fieldElementSize" =
+        MuVariable $ cxxFieldSizeString $ fieldSize $ elementType $ fieldType desc
+    context s = parent s
+
+structContext parent desc = mkStrContext context where
+    context "structName" = MuVariable $ structName desc
+    context "structFields" = MuList $ map (fieldContext context) $ structFields desc
+    context "structChildren" = MuList []  -- TODO
+    context s = parent s
+
+fileContext desc = mkStrContext context where
+    context "fileName" = MuVariable $ fileName desc
+    context "fileIncludeGuard" = MuVariable $
+        "CAPNPROTO_INCLUDED_" ++ hashString (fileName desc)
+    context "fileNamespaces" = MuList []  -- TODO
+    context "fileStructs" = MuList $ map (structContext context) $ fileStructs desc
+    context s = MuVariable $ concat ["@@@", s, "@@@"]
+
+headerTemplate :: String
+headerTemplate = UTF8.toString $(embedFile "src/c++-header.mustache")
+
+-- Sadly it appears that hashtache requires access to the IO monad, even when template inclusion
+-- is disabled.
+hastacheConfig :: MuConfig IO
+hastacheConfig = MuConfig
+    { muEscapeFunc = emptyEscape
+    , muTemplateFileDir = Nothing
+    , muTemplateFileExt = Nothing
+    , muTemplateRead = \_ -> return Nothing
+    }
+
+generateCxx file =
+    hastacheStr hastacheConfig (encodeStr headerTemplate) (fileContext file)

compiler/src/Lexer.hs

@@ -30,11 +30,11 @@ import qualified Text.Parsec.Token as T
 import Text.Parsec.Language (emptyDef)
 import Token
 import Data.Char (isUpper, isLower)
-import Data.List (find)
-import Data.Maybe (isJust)
 
 keywords =
-    [ (InKeyword, "in")
+    [ (TrueKeyword, "true")
+    , (FalseKeyword, "false")
+    , (InKeyword, "in")
     , (OfKeyword, "of")
     , (OnKeyword, "on")
     , (AsKeyword, "as")
@@ -96,7 +96,7 @@ hasUppercaseAcronym _ = False
 identifier :: Parser Token
 identifier = do
     text <- rawIdentifier
-    when (isJust $ find (== '_') text) $
+    when (elem '_' text) $
         fail "Identifiers containing underscores are reserved for the implementation.  Use \
              \camelCase style for multi-word names."
     when (hasUppercaseAcronym text) $

compiler/src/Main.hs

@@ -30,6 +30,8 @@ import Text.Parsec.Pos
 import Text.Parsec.Error
 import Text.Printf(printf)
 import qualified Data.List as List
+import CxxGenerator(generateCxx)
+import qualified Data.ByteString.Lazy.Char8 as LZ
 
 main::IO()
 main = do
@@ -39,7 +41,11 @@ main = do
 handleFile filename = do
     text <- readFile filename
     case parseAndCompileFile filename text of
-        Active desc [] -> print desc
+        Active desc [] -> do
+            print desc
+            cxx <- generateCxx desc
+            LZ.putStr cxx
+
         Active _ e -> mapM_ printError (List.sortBy compareErrors e)
         Failed e -> mapM_ printError (List.sortBy compareErrors e)
 

compiler/src/Parser.hs

@@ -48,6 +48,8 @@ tokenErrorString Period = "\".\""
 tokenErrorString EqualsSign = "\"=\""
 tokenErrorString MinusSign = "\"-\""
 tokenErrorString ExclamationPoint = "\"!\""
+tokenErrorString TrueKeyword = "keyword \"true\""
+tokenErrorString FalseKeyword = "keyword \"false\""
 tokenErrorString InKeyword = "keyword \"in\""
 tokenErrorString OfKeyword = "keyword \"of\""
 tokenErrorString OnKeyword = "keyword \"on\""
@@ -79,6 +81,10 @@ matchBracketedList t     = case locatedValue t of { (BracketedList     v) -> Jus
 matchLiteralInt t        = case locatedValue t of { (LiteralInt        v) -> Just v; _ -> Nothing }
 matchLiteralFloat t      = case locatedValue t of { (LiteralFloat      v) -> Just v; _ -> Nothing }
 matchLiteralString t     = case locatedValue t of { (LiteralString     v) -> Just v; _ -> Nothing }
+matchLiteralBool t = case locatedValue t of
+    TrueKeyword -> Just True
+    FalseKeyword -> Just False
+    _ -> Nothing
 matchSimpleToken expected t = if locatedValue t == expected then Just () else Nothing
 
 varIdentifier = tokenParser matchIdentifier
@@ -96,6 +102,7 @@ anyIdentifier = tokenParser matchIdentifier
 literalInt = tokenParser matchLiteralInt <?> "integer"
 literalFloat = tokenParser matchLiteralFloat <?> "floating-point number"
 literalString = tokenParser matchLiteralString <?> "string"
+literalBool = tokenParser matchLiteralBool <?> "boolean"
 
 atSign = tokenParser (matchSimpleToken AtSign) <?> "\"@\""
 colon = tokenParser (matchSimpleToken Colon) <?> "\":\""
@@ -231,7 +238,8 @@ fieldDecl statements = do
 negativeFieldValue = liftM (IntegerFieldValue . negate) literalInt
                  <|> liftM (FloatFieldValue . negate) literalFloat
 
-fieldValue = liftM IntegerFieldValue literalInt
+fieldValue = liftM BoolFieldValue literalBool
+         <|> liftM IntegerFieldValue literalInt
          <|> liftM FloatFieldValue literalFloat
          <|> liftM StringFieldValue literalString
          <|> liftM IdentifierFieldValue varIdentifier

compiler/src/Semantics.hs

@@ -147,6 +147,82 @@ data TypeDesc = BuiltinType BuiltinType
               | InterfaceType InterfaceDesc
               | ListType TypeDesc
 
+data PackingState = PackingState
+    { packingHole1 :: Integer
+    , packingHole8 :: Integer
+    , packingHole16 :: Integer
+    , packingHole32 :: Integer
+    , packingDataSize :: Integer
+    , packingReferenceCount :: Integer
+    }
+
+-- Represents the current packing state of a union.  The parameters are:
+-- - The offset of a 64-bit word in the data segment allocated to the union.
+-- - The offset of a reference allocated to the union.
+-- - The offset of a smaller piece of the data segment allocated to the union.  Such a smaller
+--   piece exists if one field in the union has lower number than the union itself -- in this case,
+--   this is the piece that had been allocated to that field, and is now retroactively part of the
+--   union.
+data UnionPackingState = UnionPackingState
+    { unionPackDataOffset :: Maybe Integer
+    , unionPackReferenceOffset :: Maybe Integer
+    , unionPackRetroactiveSlot :: Maybe (Integer, FieldSize)
+    }
+
+data FieldSize = Size0 | Size1 | Size8 | Size16 | Size32 | Size64 | SizeReference
+               | SizeInlineComposite Integer Integer
+
+fieldSize (BuiltinType BuiltinVoid) = Size0
+fieldSize (BuiltinType BuiltinBool) = Size1
+fieldSize (BuiltinType BuiltinInt8) = Size8
+fieldSize (BuiltinType BuiltinInt16) = Size16
+fieldSize (BuiltinType BuiltinInt32) = Size32
+fieldSize (BuiltinType BuiltinInt64) = Size64
+fieldSize (BuiltinType BuiltinUInt8) = Size8
+fieldSize (BuiltinType BuiltinUInt16) = Size16
+fieldSize (BuiltinType BuiltinUInt32) = Size32
+fieldSize (BuiltinType BuiltinUInt64) = Size64
+fieldSize (BuiltinType BuiltinFloat32) = Size32
+fieldSize (BuiltinType BuiltinFloat64) = Size64
+fieldSize (BuiltinType BuiltinText) = SizeReference
+fieldSize (BuiltinType BuiltinData) = SizeReference
+fieldSize (EnumType _) = Size16  -- TODO: ??
+fieldSize (StructType _) = SizeReference
+fieldSize (InterfaceType _) = SizeReference
+fieldSize (ListType _) = SizeReference
+
+fieldValueSize VoidDesc = Size0
+fieldValueSize (BoolDesc _) = Size1
+fieldValueSize (Int8Desc _) = Size8
+fieldValueSize (Int16Desc _) = Size16
+fieldValueSize (Int32Desc _) = Size32
+fieldValueSize (Int64Desc _) = Size64
+fieldValueSize (UInt8Desc _) = Size8
+fieldValueSize (UInt16Desc _) = Size16
+fieldValueSize (UInt32Desc _) = Size32
+fieldValueSize (UInt64Desc _) = Size64
+fieldValueSize (Float32Desc _) = Size32
+fieldValueSize (Float64Desc _) = Size64
+fieldValueSize (TextDesc _) = SizeReference
+fieldValueSize (DataDesc _) = SizeReference
+fieldValueSize (EnumValueValueDesc _) = Size16
+fieldValueSize (StructValueDesc _) = SizeReference
+fieldValueSize (ListDesc _) = SizeReference
+
+elementSize (StructType StructDesc { structPacking =
+        PackingState { packingDataSize = ds, packingReferenceCount = rc } }) =
+    SizeInlineComposite ds rc
+elementSize t = fieldSize t
+
+sizeInBits Size0 = 0
+sizeInBits Size1 = 1
+sizeInBits Size8 = 8
+sizeInBits Size16 = 16
+sizeInBits Size32 = 32
+sizeInBits Size64 = 64
+sizeInBits SizeReference = 64
+sizeInBits (SizeInlineComposite d r) = (d + r) * 64
+
 -- Render the type descriptor's name as a string, appropriate for use in the given scope.
 typeName :: Desc -> TypeDesc -> String
 typeName _ (BuiltinType t) = builtinTypeName t  -- TODO:  Check for shadowing.
@@ -220,6 +296,7 @@ data EnumValueDesc = EnumValueDesc
 data StructDesc = StructDesc
     { structName :: String
     , structParent :: Desc
+    , structPacking :: PackingState
     , structFields :: [FieldDesc]
     , structUnions :: [UnionDesc]
     , structNestedAliases :: [AliasDesc]
@@ -230,12 +307,23 @@ data StructDesc = StructDesc
     , structOptions :: OptionMap
     , structMemberMap :: MemberMap
     , structStatements :: [CompiledStatement]
+
+    -- Don't use these directly, use the members of FieldDesc and UnionDesc.
+    -- These fields are exposed here only because I was too lazy to create a way to pass them on
+    -- the side when compiling members of a struct.
+    , structFieldPackingMap :: Map.Map Integer (Integer, PackingState)
+    , structUnionPackingMap :: Map.Map Integer UnionPackingState
     }
 
 data UnionDesc = UnionDesc
     { unionName :: String
     , unionParent :: StructDesc
     , unionNumber :: Integer
+    , unionTagOffset :: Integer
+    , unionTagPacking :: PackingState
+    , unionDataOffset :: Maybe Integer
+    , unionReferenceOffset :: Maybe Integer
+    , unionRetroactiveSlot :: Maybe (Integer, FieldSize)
     , unionFields :: [FieldDesc]
     , unionOptions :: OptionMap
     , unionStatements :: [CompiledStatement]
@@ -245,6 +333,8 @@ data FieldDesc = FieldDesc
     { fieldName :: String
     , fieldParent :: StructDesc
     , fieldNumber :: Integer
+    , fieldOffset :: Integer
+    , fieldPacking :: PackingState    -- PackingState for the struct *if* this were the final field.
     , fieldUnion :: Maybe UnionDesc
     , fieldType :: TypeDesc
     , fieldDefaultValue :: Maybe ValueDesc
@@ -313,15 +403,23 @@ descToCode indent (DescEnumValue desc) = printf "%s%s = %d%s" indent
 descToCode indent (DescStruct desc) = printf "%sstruct %s%s" indent
     (structName desc)
     (blockCode indent (structStatements desc))
-descToCode indent (DescField desc) = printf "%s%s@%d%s: %s%s%s" indent
+descToCode indent (DescField desc) = printf "%s%s@%d%s: %s%s;  # %s\n" indent
     (fieldName desc) (fieldNumber desc)
     (case fieldUnion desc of { Nothing -> ""; Just u -> " in " ++ unionName u})
     (typeName (DescStruct (fieldParent desc)) (fieldType desc))
     (case fieldDefaultValue desc of { Nothing -> ""; Just v -> " = " ++ valueString v; })
-    (maybeBlockCode indent $ fieldStatements desc)
-descToCode indent (DescUnion desc) = printf "%sunion %s@%d%s" indent
+    (case fieldSize $ fieldType desc of
+        SizeReference -> printf "ref[%d]" $ fieldOffset desc
+        SizeInlineComposite _ _ -> "??"
+        s -> let
+            bits = (sizeInBits s)
+            offset = fieldOffset desc
+            in printf "bits[%d, %d)" (offset * bits) ((offset + 1) * bits))
+--    (maybeBlockCode indent $ fieldStatements desc)
+descToCode indent (DescUnion desc) = printf "%sunion %s@%d;  # [%d, %d)\n" indent
     (unionName desc) (unionNumber desc)
-    (maybeBlockCode indent $ unionStatements desc)
+    (unionTagOffset desc * 8) (unionTagOffset desc * 8 + 8)
+--    (maybeBlockCode indent $ unionStatements desc)
 descToCode indent (DescInterface desc) = printf "%sinterface %s%s" indent
     (interfaceName desc)
     (blockCode indent (interfaceStatements desc))

compiler/src/Token.hs

@@ -44,6 +44,8 @@ data Token = Identifier String
            | LiteralInt Integer
            | LiteralFloat Double
            | LiteralString String
+           | TrueKeyword
+           | FalseKeyword
            | AtSign
            | Colon
            | Period

compiler/src/Util.hs

@@ -23,11 +23,21 @@
 
 module Util where
 
+import Data.Char (isUpper, toUpper)
+
 delimit _ [] = ""
 delimit delimiter (h:t) = h ++ concatMap (delimiter ++) t
 
---delimit delimiter list = concat $ loop list where
---    loop ("":t) = loop t
---    loop (a:"":t) = loop (a:t)
---    loop (a:b:t) = a:delimiter:loop (b:t)
---    loop a = a
+splitName :: String -> [String]
+splitName (a:rest@(b:_)) | isUpper b = [a]:splitName rest
+splitName (a:rest) = case splitName rest of
+    firstWord:moreWords -> (a:firstWord):moreWords
+    [] -> [[a]]
+splitName [] = []
+
+toTitleCase :: String -> String
+toTitleCase (a:rest) = toUpper a:rest
+toTitleCase [] = []
+
+toUpperCaseWithUnderscores :: String -> String
+toUpperCaseWithUnderscores name = delimit "_" $ map (map toUpper) $ splitName name

compiler/src/WireFormat.hs

+-- Copyright (c) 2013, Kenton Varda <temporal@gmail.com>
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are met:
+--
+-- 1. Redistributions of source code must retain the above copyright notice, this
+--    list of conditions and the following disclaimer.
+-- 2. Redistributions in binary form must reproduce the above copyright notice,
+--    this list of conditions and the following disclaimer in the documentation
+--    and/or other materials provided with the distribution.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+module WireFormat where
+
+import Data.List(sortBy, minimum)
+import Data.Maybe(maybe)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Semantics
+
+-- Is this field a non-retroactive member of a union?  If so, its default value is not written.
+isNonRetroUnionMember (FieldDesc {fieldNumber = n, fieldUnion = Just u}) = n > unionNumber u
+isNonRetroUnionMember _ = False
+
+-- What is this union's default tag value?  If there is a retroactive field, it is that field's
+-- number, otherwise it is the union's number (meaning no field set).
+unionDefault desc = max (minimum $ map fieldNumber $ unionFields desc) (unionNumber desc)
+
+encodeStruct desc assignments = result where
+    explicitlyAssignedNums = Set.fromList [fieldNumber desc | (desc, _) <- assignments]
+    explicitlyAssignedUnions = Set.fromList
+        [unionNumber u | (FieldDesc {fieldUnion = Just u}, _) <- assignments]
+
+    -- Was this field explicitly assigned, or was another member of the same union explicitly
+    -- assigned?  If so, its default value is not written.
+    isExplicitlyAssigned (FieldDesc {fieldNumber = n, fieldUnion = u}) =
+        Set.member n explicitlyAssignedNums ||
+        maybe False (flip Set.member explicitlyAssignedUnions . unionNumber) u
+
+    -- Values explicitly assigned.
+    explicitValues = [(fieldOffset f, v) | (f, v) <- assignments]
+
+    -- Values from defaults.
+    defaultValues = [(o, v)
+        | field@(FieldDesc { fieldOffset = o, fieldDefaultValue = Just v}) <- structFields desc
+        , not $ isExplicitlyAssigned field
+        , not $ isNonRetroUnionMember field ]
+
+    -- Values of union tags.
+    unionValues = [(unionTagOffset u, UInt8Desc n)
+                  | (FieldDesc {fieldUnion = Just u, fieldNumber = n}, _) <- assignments]
+
+    -- Default values of union dacs.
+    unionDefaultValues = [(unionTagOffset u, unionDefault u) | u <- structUnions desc
+                         , not $ Set.member (unionNumber u) explicitlyAssignedUnions]
+
+    allValues = explicitValues ++ defaultValues ++ unionValues ++ unionDefaultValues
+
+    allData = [ (o * sizeInBits (fieldValueSize v)) v
+              | (o, v) <- allValues, fieldValueSize v /= SizeReference ]
+    allReferences = [ (o, v) | (o, v) <- allValues, fieldValueSize v == SizeReference ]
+
+    compareValues (o1, _) (o2, _) = compare o1 o2
+    sortedData = sortBy compareValues allData
+    sortedReferences = sortBy compareValues allReferences
+
+    result = encodeData sortedData ++ encodeReferences sortedReferences

compiler/src/c++-header.mustache

+// Generated code, DO NOT EDIT {{! unless you are editing the template, of course }}
+
+#include <capnproto/wire-format.h>
+
+#ifndef {{fileIncludeGuard}}
+#define {{fileIncludeGuard}}
+
+{{#fileNamespaces}}
+namespace {{namespaceName}} {
+{{/fileNamespaces}}
+
+{{#fileStructs}}
+struct {{structName}} {
+  class Reader;
+  class Builder;
+
+{{#structChildren}}
+  struct {{structChildName}};
+{{/structChildren}}
+
+{{#structFields}}
+{{#fieldDefaultBytes}}
+  static const ::capnproto::internal::AlignedData<{{defaultWordCount}}> DEFAULT_{{fieldUpperCase}};
+{{/fieldDefaultBytes}}
+{{/structFields}}
+};
+{{/fileStructs}}
+
+{{#fileStructs}}
+class {{structName}}::Reader {
+public:
+  Reader() = default;
+  inline Reader(::capnproto::internal::StructReader base): _reader(base) {}
+
+{{#structFields}}
+  // {{fieldDecl}}
+{{#fieldIsPrimitive}}
+  inline {{fieldType}} get{{fieldTitleCase}}() {
+    return _reader.getDataField<{{fieldType}}>(
+        {{fieldOffset}} * ::capnproto::ELEMENTS, {{fieldDefaultValue}});
+  }
+{{/fieldIsPrimitive}}
+{{#fieldIsStruct}}
+  inline {{fieldType}}::Reader get{{fieldTitleCase}}() {
+    {{! TODO:  Support per-field default values. }}
+    return {{fieldType}}::Reader(_reader.getStructField(
+        {{fieldOffset}} * ::capnproto::REFERENCES,
+        {{#fieldDefaultBytes}}DEFAULT_{{fieldUpperCase}}{{/fieldDefaultBytes}}
+        {{^fieldDefaultBytes}}{{fieldType}}::DEFAULT.words{{/fieldDefaultBytes}}));
+  }
+{{/fieldIsStruct}}
+{{#fieldIsList}}
+  inline {{fieldType}}::Reader get{{fieldTitleCase}}() {
+    return {{fieldType}}::Reader(_reader.getListField(
+        {{fieldOffset}} * ::capnproto::REFERENCES,
+        {{#fieldDefaultBytes}}DEFAULT_{{fieldUpperCase}}.words{{/fieldDefaultBytes}}
+        {{^fieldDefaultBytes}}nullptr{{/fieldDefaultBytes}}));
+  }
+{{/fieldIsList}}
+
+{{/structFields}}
+
+private:
+  ::capnproto::internal::StructReader _reader;
+};
+{{/fileStructs}}
+
+{{#fileStructs}}
+class {{structName}}::Builder {
+public:
+  Builder() = default;
+  inline Builder(::capnproto::internal::StructBuilder base): _builder(base) {}
+
+{{#structFields}}
+  // {{fieldDecl}}
+{{#fieldDefaultBytes}}
+  static const ::capnproto::internal::AlignedData<{{defaultWordCount}}> DEFAULT_{{fieldUpperCase}};
+{{/fieldDefaultBytes}}
+{{#fieldIsPrimitive}}
+  inline {{fieldType}} get{{fieldTitleCase}}() {
+    return _builder.getDataField<{{fieldType}}>({{fieldOffset}} * ::capnproto::ELEMENTS);
+  }
+  inline void set{{fieldTitleCase}}({{fieldType}} value) {
+    return _builder.setDataField<{{fieldType}}>(
+        {{fieldOffset}} * ::capnproto::ELEMENTS, value);
+  }
+{{/fieldIsPrimitive}}
+{{#fieldIsStruct}}
+  inline {{fieldType}}::Builder init{{fieldTitleCase}}() {
+    return {{fieldType}}::Builder(_builder.initStructField(
+        {{fieldOffset}} * ::capnproto::REFERENCES, {{fieldType}}::DEFAULT.words));
+  }
+  inline {{fieldType}}::Builder get{{fieldTitleCase}}() {
+    {{! TODO:  Support per-field default values. }}
+    return {{fieldType}}::Builder(_builder.getStructField(
+        {{fieldOffset}} * ::capnproto::REFERENCES,
+        {{#fieldDefaultBytes}}DEFAULT_{{fieldUpperCase}}{{/fieldDefaultBytes}}
+        {{^fieldDefaultBytes}}{{fieldType}}::DEFAULT.words{{/fieldDefaultBytes}}));
+  }
+{{/fieldIsStruct}}
+{{#fieldIsPrimitiveList}}
+  inline {{fieldType}}::Builder init{{fieldTitleCase}}(unsigned int size) {
+    return {{fieldType}}::Builder(_builder.initListField(
+        {{fieldOffset}} * ::capnproto::REFERENCES, ::capnproto::FieldSize::{{fieldElementSize}},
+        size * ::capnproto::ELEMENTS));
+  }
+  inline {{fieldType}}::Builder get{{fieldTitleCase}}() {
+    return {{fieldType}}::Builder(_builder.getListField(
+        {{fieldOffset}} * ::capnproto::REFERENCES,
+        {{#fieldDefaultBytes}}DEFAULT_{{fieldUpperCase}}.words{{/fieldDefaultBytes}}
+        {{^fieldDefaultBytes}}nullptr{{/fieldDefaultBytes}}));
+  }
+{{/fieldIsPrimitiveList}}
+{{#fieldIsStructList}}
+  inline {{fieldType}}::Builder init{{fieldTitleCase}}(unsigned int size) {
+    return {{fieldType}}::Builder(_builder.initStructListField(
+        {{fieldOffset}} * ::capnproto::REFERENCES, size * ::capnproto::ELEMENTS,
+        {{fieldType}}::DEFAULT.words));
+  }
+  inline {{fieldType}}::Builder get{{fieldTitleCase}}() {
+    return {{fieldType}}::Builder(_builder.getListField(
+        {{fieldOffset}} * ::capnproto::REFERENCES,
+        {{#fieldDefaultBytes}}DEFAULT_{{fieldUpperCase}}.words{{/fieldDefaultBytes}}
+        {{^fieldDefaultBytes}}nullptr{{/fieldDefaultBytes}}));
+  }
+{{/fieldIsStructList}}
+
+{{/structFields}}
+
+private:
+  ::capnproto::internal::StructBuilder _builder;
+};
+{{/fileStructs}}
+
+{{#fileNamespaces}}
+}  // namespace
+{{/fileNamespaces}}
+
+#endif  // {{fileIncludeGuard}}