Redo IDs. They now look like ordinals, except that they are 64-bit unique integers.

c++/src/capnproto/c++.capnp

@@ -21,7 +21,7 @@
 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-$id("v3JF2GP4Supe9JSSJ3pnSdUqhJI");
+@0xbdf87d7bb8304e81;
 $namespace("capnproto::annotations");
 
 annotation namespace(file): Text;

c++/src/capnproto/test-import.capnp

@@ -21,6 +21,8 @@
 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+@0xf36d7b330303c66e;
+
 using Test = import "test.capnp";
 
 struct TestImport {

c++/src/capnproto/test.capnp

@@ -21,6 +21,8 @@
 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+@0xd508eebdc2dc42b8;
+
 using Cxx = import "c++.capnp";
 
 # Use a namespace likely to cause trouble if the generated code doesn't use fully-qualified

compiler/capnproto-compiler.cabal

@@ -29,7 +29,8 @@ executable capnpc
                    filepath,
                    directory,
                    syb,
-                   transformers
+                   transformers,
+                   entropy
   ghc-options:     -Wall -fno-warn-missing-signatures
   other-modules:
                    Lexer,

compiler/src/Compiler.hs

@@ -25,18 +25,21 @@ module Compiler (Status(..), parseAndCompileFile) where
 
 import Grammar
 import Semantics
-import Token(Located(Located), locatedPos, locatedValue)
+import Token(Located(Located), locatedValue)
 import Parser(parseFile)
-import Control.Monad(when, unless)
+import Control.Monad(when, unless, liftM)
 import qualified Data.Map as Map
 import Data.Map((!))
 import qualified Data.Set as Set
 import qualified Data.List as List
-import Data.Maybe(mapMaybe, fromMaybe, listToMaybe, catMaybes, isJust)
+import Data.Maybe(mapMaybe, fromMaybe, isJust, isNothing)
+import Data.Word(Word64, Word8)
 import Text.Parsec.Pos(SourcePos, newPos)
 import Text.Parsec.Error(ParseError, newErrorMessage, Message(Message, Expect))
 import Text.Printf(printf)
-import Util(delimit)
+import qualified Data.Digest.MD5 as MD5
+import qualified Codec.Binary.UTF8.String as UTF8
+import Util(delimit, intToBytes)
 
 ------------------------------------------------------------------------------------------
 -- Error helpers
@@ -164,8 +167,7 @@ builtinTypeMap = Map.fromList
      [("List", DescBuiltinList),
       ("Inline", DescBuiltinInline),
       ("InlineList", DescBuiltinInlineList),
-      ("InlineData", DescBuiltinInlineData),
-      ("id", DescBuiltinId)])
+      ("InlineData", DescBuiltinInlineData)])
 
 ------------------------------------------------------------------------------------------
 
@@ -364,43 +366,30 @@ compileType scope (TypeExpression n params) = do
                 printf "'%s' doesn't take parameters." (declNameString n)
 
 compileAnnotation :: Desc -> AnnotationTarget -> Annotation
-                  -> Status (Maybe AnnotationDesc, ValueDesc)
+                  -> Status (AnnotationDesc, ValueDesc)
 compileAnnotation scope kind (Annotation name (Located pos value)) = do
     nameDesc <- lookupDesc scope name
     case nameDesc of
-        DescBuiltinId -> do
-            compiledValue <- compileValue pos (BuiltinType BuiltinText) value
-            return (Nothing, compiledValue)
         DescAnnotation annDesc -> do
             unless (Set.member kind (annotationTargets annDesc))
                 (makeError (declNamePos name)
                 $ printf "'%s' cannot be used on %s." (declNameString name) (show kind))
             compiledValue <- compileValue pos (annotationType annDesc) value
-            return (Just annDesc, compiledValue)
+            return (annDesc, compiledValue)
         _ -> makeError (declNamePos name)
            $ printf "'%s' is not an annotation." (declNameString name)
 
 compileAnnotations :: Desc -> AnnotationTarget -> [Annotation]
-                   -> Status (Maybe String, AnnotationMap)  -- (id, other annotations)
+                   -> Status AnnotationMap
 compileAnnotations scope kind annotations = do
     let compileLocated ann@(Annotation name _) =
             fmap (Located $ declNamePos name) $ compileAnnotation scope kind ann
 
     compiled <- doAll $ map compileLocated annotations
 
-    -- Makes a map entry for the annotation keyed by ID.  Throws out annotations with no ID.
-    let ids = [ Located pos i | Located pos (Nothing, TextDesc i) <- compiled ]
-        theId = fmap locatedValue $ listToMaybe ids
-        dupIds = map (flip makeError "Duplicate annotation 'id'." . locatedPos) $ List.drop 1 ids
-
-        -- For the annotations other than "id", we want to build a map keyed by annotation ID.
-        -- We drop any annotation that doesn't have an ID.
-        locatedEntries = catMaybes
-            [ annotationById pos (desc, v) | Located pos (Just desc, v) <- compiled ]
-        annotationById pos ann@(desc, _) =
-            case descAutoId (DescAnnotation desc) of
-                Just globalId -> Just (Located pos (globalId, ann))
-                Nothing -> Nothing
+    -- Makes a map entry for the annotation keyed by ID.
+    let locatedEntries = [ Located pos (annotationId desc, (desc, v))
+                         | Located pos (desc, v) <- compiled ]
 
         -- TODO(cleanup):  Generalize duplicate detection.
         sortedLocatedEntries = detectDup $ List.sortBy compareIds locatedEntries
@@ -411,9 +400,16 @@ compileAnnotations scope kind annotations = do
         detectDup [] = []
 
     finalEntries <- doAll sortedLocatedEntries
-    _ <- doAll dupIds
 
-    return (theId, Map.fromList finalEntries)
+    return $ Map.fromList finalEntries
+
+childId :: String -> Maybe (Located Word64) -> Desc -> Word64
+childId _ (Just (Located _ myId)) _ = myId
+childId name Nothing parent = let
+    hash = MD5.hash (intToBytes (descId parent) 8 ++ UTF8.encode name)
+    addByte :: Word64 -> Word8 -> Word64
+    addByte b v = b * 256 + fromIntegral v
+    in foldl addByte 0 (take 8 hash)
 
 ------------------------------------------------------------------------------------------
 
@@ -801,27 +797,26 @@ compileDecl scope (ConstantDecl (Located _ name) t annotations (Located valuePos
     CompiledStatementStatus name (do
         typeDesc <- compileType scope t
         valueDesc <- compileValue valuePos typeDesc value
-        (theId, compiledAnnotations) <- compileAnnotations scope ConstantAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope ConstantAnnotation annotations
         return (DescConstant ConstantDesc
             { constantName = name
-            , constantId = theId
             , constantParent = scope
             , constantType = typeDesc
             , constantValue = valueDesc
             , constantAnnotations = compiledAnnotations
             }))
 
-compileDecl scope (EnumDecl (Located _ name) annotations decls) =
+compileDecl scope (EnumDecl (Located _ name) maybeTypeId annotations decls) =
     CompiledStatementStatus name (feedback (\desc -> do
         (members, memberMap) <- compileChildDecls desc decls
         requireNoDuplicateNames decls
         let numbers = [ num | EnumerantDecl _ num _ <- decls ]
         requireSequentialNumbering "Enumerants" numbers
         requireOrdinalsInRange numbers
-        (theId, compiledAnnotations) <- compileAnnotations scope EnumAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope EnumAnnotation annotations
         return (DescEnum EnumDesc
             { enumName = name
-            , enumId = theId
+            , enumId = childId name maybeTypeId scope
             , enumParent = scope
             , enumerants = [d | DescEnumerant d <- members]
             , enumAnnotations = compiledAnnotations
@@ -832,10 +827,9 @@ compileDecl scope (EnumDecl (Located _ name) annotations decls) =
 compileDecl scope@(DescEnum parent)
             (EnumerantDecl (Located _ name) (Located _ number) annotations) =
     CompiledStatementStatus name (do
-        (theId, compiledAnnotations) <- compileAnnotations scope EnumerantAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope EnumerantAnnotation annotations
         return (DescEnumerant EnumerantDesc
             { enumerantName = name
-            , enumerantId = theId
             , enumerantParent = parent
             , enumerantNumber = number
             , enumerantAnnotations = compiledAnnotations
@@ -843,14 +837,14 @@ compileDecl scope@(DescEnum parent)
 compileDecl _ (EnumerantDecl (Located pos name) _ _) =
     CompiledStatementStatus name (makeError pos "Enumerants can only appear inside enums.")
 
-compileDecl scope (StructDecl (Located _ name) isFixed annotations decls) =
+compileDecl scope (StructDecl (Located _ name) maybeTypeId isFixed annotations decls) =
     CompiledStatementStatus name (feedback (\desc -> do
         (members, memberMap) <- compileChildDecls desc decls
         requireNoDuplicateNames decls
         let fieldNums = extractFieldNumbers decls
         requireSequentialNumbering "Fields" fieldNums
         requireOrdinalsInRange fieldNums
-        (theId, compiledAnnotations) <- compileAnnotations scope StructAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope StructAnnotation annotations
         let (dataSize, pointerCount, fieldPackingMap) = packFields fields unions
             fields = [d | DescField d <- members]
             unions = [d | DescUnion d <- members]
@@ -859,7 +853,7 @@ compileDecl scope (StructDecl (Located _ name) isFixed annotations decls) =
         return (let
             in DescStruct StructDesc
             { structName = name
-            , structId = theId
+            , structId = childId name maybeTypeId scope
             , structParent = scope
             , structDataSize = finalDataSize
             , structPointerCount = finalPointerCount
@@ -880,12 +874,11 @@ compileDecl scope@(DescStruct parent)
             orderedFieldNumbers = List.sort $ map fieldNumber fields
             discriminantMap = Map.fromList $ zip orderedFieldNumbers [0..]
         requireNoMoreThanOneFieldNumberLessThan name numPos number fields
-        (theId, compiledAnnotations) <- compileAnnotations scope UnionAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope UnionAnnotation annotations
         return (let
             DataOffset Size16 tagOffset = structFieldPackingMap parent ! number
             in DescUnion UnionDesc
             { unionName = name
-            , unionId = theId
             , unionParent = parent
             , unionNumber = number
             , unionTagOffset = tagOffset
@@ -925,11 +918,10 @@ compileDecl scope
                     _ -> return ())
                 return result
             Nothing -> return Nothing
-        (theId, compiledAnnotations) <- compileAnnotations scope FieldAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope FieldAnnotation annotations
         return (let
             in DescField FieldDesc
             { fieldName = name
-            , fieldId = theId
             , fieldParent = parent
             , fieldNumber = number
             , fieldOffset = structFieldPackingMap parent ! number
@@ -939,17 +931,17 @@ compileDecl scope
             , fieldAnnotations = compiledAnnotations
             }))
 
-compileDecl scope (InterfaceDecl (Located _ name) annotations decls) =
+compileDecl scope (InterfaceDecl (Located _ name) maybeTypeId annotations decls) =
     CompiledStatementStatus name (feedback (\desc -> do
         (members, memberMap) <- compileChildDecls desc decls
         requireNoDuplicateNames decls
         let numbers = [ num | MethodDecl _ num _ _ _ <- decls ]
         requireSequentialNumbering "Methods" numbers
         requireOrdinalsInRange numbers
-        (theId, compiledAnnotations) <- compileAnnotations scope InterfaceAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope InterfaceAnnotation annotations
         return (DescInterface InterfaceDesc
             { interfaceName = name
-            , interfaceId = theId
+            , interfaceId = childId name maybeTypeId scope
             , interfaceParent = scope
             , interfaceMethods = [d | DescMethod    d <- members]
             , interfaceAnnotations = compiledAnnotations
@@ -962,10 +954,9 @@ compileDecl scope@(DescInterface parent)
     CompiledStatementStatus name (feedback (\desc -> do
         paramDescs <- doAll (map (compileParam desc) (zip [0..] params))
         returnTypeDesc <- compileType scope returnType
-        (theId, compiledAnnotations) <- compileAnnotations scope MethodAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope MethodAnnotation annotations
         return (DescMethod MethodDesc
             { methodName = name
-            , methodId = theId
             , methodParent = parent
             , methodNumber = number
             , methodParams = paramDescs
@@ -975,13 +966,13 @@ compileDecl scope@(DescInterface parent)
 compileDecl _ (MethodDecl (Located pos name) _ _ _ _) =
     CompiledStatementStatus name (makeError pos "Methods can only appear inside interfaces.")
 
-compileDecl scope (AnnotationDecl (Located _ name) typeExp annotations targets) =
+compileDecl scope (AnnotationDecl (Located _ name) maybeTypeId typeExp annotations targets) =
     CompiledStatementStatus name (do
         typeDesc <- compileType scope typeExp
-        (theId, compiledAnnotations) <- compileAnnotations scope AnnotationAnnotation annotations
+        compiledAnnotations <- compileAnnotations scope AnnotationAnnotation annotations
         return (DescAnnotation AnnotationDesc
             { annotationName = name
-            , annotationId = theId
+            , annotationId = childId name maybeTypeId scope
             , annotationParent = scope
             , annotationType = typeDesc
             , annotationAnnotations = compiledAnnotations
@@ -994,10 +985,9 @@ compileParam scope@(DescMethod parent)
     defaultDesc <- case defaultValue of
         Just (Located pos value) -> fmap Just (compileValue pos typeDesc value)
         Nothing -> return Nothing
-    (theId, compiledAnnotations) <- compileAnnotations scope ParamAnnotation annotations
+    compiledAnnotations <- compileAnnotations scope ParamAnnotation annotations
     return ParamDesc
         { paramName = name
-        , paramId = theId
         , paramParent = parent
         , paramNumber = ordinal
         , paramType = typeDesc
@@ -1006,15 +996,14 @@ compileParam scope@(DescMethod parent)
         }
 compileParam _ _ = error "scope of parameter was not a method"
 
-compileFile name decls annotations importMap =
+compileFile name theId decls annotations importMap =
     feedback (\desc -> do
         (members, memberMap) <- compileChildDecls (DescFile desc) decls
         requireNoDuplicateNames decls
-        (theId, compiledAnnotations)
-            <- compileAnnotations (DescFile desc) FileAnnotation annotations
+        compiledAnnotations <- compileAnnotations (DescFile desc) FileAnnotation annotations
         return FileDesc
             { fileName = name
-            , fileId = theId
+            , fileId = locatedValue theId
             , fileImports = Map.elems importMap
             , fileRuntimeImports =
                 Set.fromList $ map fileName $ concatMap descRuntimeImports members
@@ -1029,7 +1018,7 @@ dedup = Set.toList . Set.fromList
 
 emptyFileDesc filename = FileDesc
     { fileName = filename
-    , fileId = Nothing
+    , fileId = 0x0
     , fileImports = []
     , fileRuntimeImports = Set.empty
     , fileAnnotations = Map.empty
@@ -1042,9 +1031,10 @@ parseAndCompileFile :: Monad m
                     => FilePath                                -- Name of this file.
                     -> String                                  -- Content of this file.
                     -> (String -> m (Either FileDesc String))  -- Callback to import other files.
+                    -> m Word64                                -- Callback to generate a random id.
                     -> m (Status FileDesc)                     -- Compiled file and/or errors.
-parseAndCompileFile filename text importCallback = do
-    let (decls, annotations, parseErrors) = parseFile filename text
+parseAndCompileFile filename text importCallback randomCallback = do
+    let (maybeFileId, decls, annotations, parseErrors) = parseFile filename text
         importNames = dedup $ concatMap declImports decls
         doImport (Located pos name) = do
             result <- importCallback name
@@ -1055,6 +1045,11 @@ parseAndCompileFile filename text importCallback = do
 
     importStatuses <- mapM doImport importNames
 
+    let dummyPos = newPos filename 1 1
+    theFileId <- case maybeFileId of
+        Nothing -> liftM (Located dummyPos) randomCallback
+        Just i -> return i
+
     return (do
         -- We are now in the Status monad.
 
@@ -1075,5 +1070,11 @@ parseAndCompileFile filename text importCallback = do
         -- of one bad import.
         imports <- doAll importStatuses
 
+        -- Report lack of an id.
+        when (isNothing maybeFileId) $
+            makeError dummyPos $
+                printf "File does not declare an ID.  I've generated one for you.  Add this line \
+                       \to your file: @0x%016x;" (locatedValue theFileId)
+
         -- Compile the file!
-        compileFile filename decls annotations $ Map.fromList imports)
+        compileFile filename theFileId decls annotations $ Map.fromList imports)

compiler/src/CxxGenerator.hs

@@ -31,7 +31,7 @@ import Data.Word(Word8)
 import qualified Data.Digest.MD5 as MD5
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Data.Maybe(catMaybes, fromMaybe)
+import Data.Maybe(catMaybes)
 import Data.Binary.IEEE754(floatToWord, doubleToWord)
 import Text.Printf(printf)
 import Text.Hastache
@@ -51,7 +51,7 @@ muNull = MuBool False;
 -- Using a single-element list has the same effect, though.
 muJust c = MuList [c]
 
-namespaceAnnotationId = "v3JF2GP4Supe9JSSJ3pnSdUqhJI.namespace"
+namespaceAnnotationId = 0xb9c6f99ebf805f2c
 
 fileNamespace desc = fmap testAnnotation $ Map.lookup namespaceAnnotationId $ fileAnnotations desc
 
@@ -422,7 +422,7 @@ fileContext desc = mkStrContext context where
     context "fileName" = MuVariable $ fileName desc
     context "fileBasename" = MuVariable $ takeBaseName $ fileName desc
     context "fileIncludeGuard" = MuVariable $
-        "CAPNPROTO_INCLUDED_" ++ hashString (fileName desc ++ ':':fromMaybe "" (fileId desc))
+        "CAPNPROTO_INCLUDED_" ++ hashString (fileName desc ++ ':':show (fileId desc))
     context "fileNamespaces" = MuList $ map (namespaceContext context) namespace
     context "fileEnums" = MuList $ map (enumContext context) [e | DescEnum e <- fileMembers desc]
     context "fileTypes" = MuList $ map (typeContext context) flattenedMembers

compiler/src/Grammar.hs

@@ -25,6 +25,7 @@ module Grammar where
 
 import Token (Located)
 import Data.Maybe (maybeToList)
+import Data.Word (Word64)
 
 data DeclName = AbsoluteName (Located String)
               | RelativeName (Located String)
@@ -100,43 +101,45 @@ instance Show AnnotationTarget where
 
 data Declaration = UsingDecl (Located String) DeclName
                  | ConstantDecl (Located String) TypeExpression [Annotation] (Located FieldValue)
-                 | EnumDecl (Located String) [Annotation] [Declaration]
+                 | EnumDecl (Located String) (Maybe (Located Word64)) [Annotation] [Declaration]
                  | EnumerantDecl (Located String) (Located Integer) [Annotation]
-                 | StructDecl (Located String) (Maybe (Located (Integer, Integer)))
-                              [Annotation] [Declaration]
+                 | StructDecl (Located String) (Maybe (Located Word64))
+                              (Maybe (Located (Integer, Integer))) [Annotation] [Declaration]
                  | FieldDecl (Located String) (Located Integer)
                              TypeExpression [Annotation] (Maybe (Located FieldValue))
                  | UnionDecl (Located String) (Located Integer) [Annotation] [Declaration]
-                 | InterfaceDecl (Located String) [Annotation] [Declaration]
+                 | InterfaceDecl (Located String) (Maybe (Located Word64))
+                                 [Annotation] [Declaration]
                  | MethodDecl (Located String) (Located Integer) [ParamDecl]
                               TypeExpression [Annotation]
-                 | AnnotationDecl (Located String) TypeExpression [Annotation] [AnnotationTarget]
+                 | AnnotationDecl (Located String) (Maybe (Located Word64)) TypeExpression
+                                  [Annotation] [AnnotationTarget]
                  deriving (Show)
 
 declarationName :: Declaration -> Maybe (Located String)
-declarationName (UsingDecl n _)          = Just n
-declarationName (ConstantDecl n _ _ _)   = Just n
-declarationName (EnumDecl n _ _)         = Just n
-declarationName (EnumerantDecl n _ _)    = Just n
-declarationName (StructDecl n _ _ _)     = Just n
-declarationName (FieldDecl n _ _ _ _)    = Just n
-declarationName (UnionDecl n _ _ _)      = Just n
-declarationName (InterfaceDecl n _ _)    = Just n
-declarationName (MethodDecl n _ _ _ _)   = Just n
-declarationName (AnnotationDecl n _ _ _) = Just n
+declarationName (UsingDecl n _)            = Just n
+declarationName (ConstantDecl n _ _ _)     = Just n
+declarationName (EnumDecl n _ _ _)         = Just n
+declarationName (EnumerantDecl n _ _)      = Just n
+declarationName (StructDecl n _ _ _ _)     = Just n
+declarationName (FieldDecl n _ _ _ _)      = Just n
+declarationName (UnionDecl n _ _ _)        = Just n
+declarationName (InterfaceDecl n _ _ _)    = Just n
+declarationName (MethodDecl n _ _ _ _)     = Just n
+declarationName (AnnotationDecl n _ _ _ _) = Just n
 
 declImports :: Declaration -> [Located String]
 declImports (UsingDecl _ name) = maybeToList (declNameImport name)
 declImports (ConstantDecl _ t ann _) = typeImports t ++ concatMap annotationImports ann
-declImports (EnumDecl _ ann decls) = concatMap annotationImports ann ++ concatMap declImports decls
+declImports (EnumDecl _ _ ann decls) = concatMap annotationImports ann ++ concatMap declImports decls
 declImports (EnumerantDecl _ _ ann) = concatMap annotationImports ann
-declImports (StructDecl _ _ ann decls) = concatMap annotationImports ann ++
-                                         concatMap declImports decls
+declImports (StructDecl _ _ _ ann decls) = concatMap annotationImports ann ++
+                                           concatMap declImports decls
 declImports (FieldDecl _ _ t ann _) = typeImports t ++ concatMap annotationImports ann
 declImports (UnionDecl _ _ ann decls) = concatMap annotationImports ann ++
                                         concatMap declImports decls
-declImports (InterfaceDecl _ ann decls) = concatMap annotationImports ann ++
-                                          concatMap declImports decls
+declImports (InterfaceDecl _ _ ann decls) = concatMap annotationImports ann ++
+                                            concatMap declImports decls
 declImports (MethodDecl _ _ params t ann) =
     concat [concatMap paramImports params, typeImports t, concatMap annotationImports ann]
-declImports (AnnotationDecl _ t ann _) = typeImports t ++ concatMap annotationImports ann
+declImports (AnnotationDecl _ _ t ann _) = typeImports t ++ concatMap annotationImports ann

compiler/src/Main.hs

@@ -29,8 +29,9 @@ import System.Exit(exitFailure, exitSuccess)
 import System.IO(hPutStr, stderr)
 import System.FilePath(takeDirectory)
 import System.Directory(createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
+import System.Entropy(getEntropy)
 import Control.Monad
-import Control.Monad.IO.Class(liftIO)
+import Control.Monad.IO.Class(MonadIO, liftIO)
 import Control.Exception(IOException, catch)
 import Control.Monad.Trans.State(StateT, state, modify, execStateT)
 import Prelude hiding (catch)
@@ -42,6 +43,8 @@ import Text.Printf(printf)
 import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy.Char8 as LZ
+import Data.ByteString(unpack)
+import Data.Word(Word64, Word8)
 import Semantics
 
 import CxxGenerator(generateCxx)
@@ -54,6 +57,7 @@ data Opt = SearchPathOpt FilePath
          | OutputOpt String (Maybe GeneratorFn) FilePath
          | VerboseOpt
          | HelpOpt
+         | GenIdOpt
 
 main :: IO ()
 main = do
@@ -66,6 +70,7 @@ main = do
               \directory).  LANG may be any of:\n\
               \  " ++ unwords (Map.keys generatorFns))
          , Option "v" ["verbose"] (NoArg VerboseOpt) "Write information about parsed files."
+         , Option "i" ["generate-id"] (NoArg GenIdOpt) "Generate a new unique ID."
          , Option "h" ["help"] (NoArg HelpOpt) "Print usage info and exit."
          ]
     let usage = usageInfo
@@ -88,11 +93,16 @@ main = do
         exitFailure)
 
     let isHelp = not $ null [opt | opt@HelpOpt <- options]
-
     when isHelp (do
         putStr usage
         exitSuccess)
 
+    let isGenId = not $ null [opt | opt@GenIdOpt <- options]
+    when isGenId (do
+        i <- generateId
+        _ <- printf "@0x%016x\n" i
+        exitSuccess)
+
     let isVerbose = not $ null [opt | opt@VerboseOpt <- options]
     let outputs = [(fn, dir) | OutputOpt _ (Just fn) dir <- options]
     let searchPath = [dir | SearchPathOpt dir <- options]
@@ -187,6 +197,16 @@ readAndParseFile isVerbose searchPath filename = do
         Right err -> return $ Right err
         Left text -> parseFile isVerbose searchPath filename text
 
+generateId :: MonadIO m => m Word64
+generateId = do
+    byteString <- liftIO $ getEntropy 8
+    let i | ix < 2^(63::Integer) = ix + 2^(63::Integer)
+          | otherwise = ix
+        ix = foldl addByte 0 (unpack byteString)
+        addByte :: Word64 -> Word8 -> Word64
+        addByte b v = b * 256 + fromIntegral v
+    return i
+
 parseFile isVerbose searchPath filename text = do
     let importCallback name = do
             let candidates = relativePath filename searchPath name
@@ -195,7 +215,7 @@ parseFile isVerbose searchPath filename text = do
                 Nothing -> return $ Right "File not found."
                 Just path -> importFile isVerbose searchPath path
 
-    status <- parseAndCompileFile filename text importCallback
+    status <- parseAndCompileFile filename text importCallback generateId
     case status of
         Active desc [] -> do
             when isVerbose (liftIO $ print desc)

compiler/src/Parser.hs

@@ -24,8 +24,10 @@
 module Parser (parseFile) where
 
 import Data.Generics
-import Data.Maybe(fromMaybe)
+import Data.Maybe(fromMaybe, listToMaybe)
+import Data.Word(Word64)
 import Text.Parsec hiding (tokens)
+import Text.Parsec.Error(newErrorMessage, Message(Message))
 import Token
 import Grammar
 import Lexer (lexer)
@@ -40,7 +42,7 @@ tokenErrorString (ParenthesizedList _) = "parenthesized list"
 tokenErrorString (BracketedList _) = "bracketed list"
 tokenErrorString (LiteralInt i) = "integer literal " ++ show i
 tokenErrorString (LiteralFloat f) = "float literal " ++ show f
-tokenErrorString (LiteralString s) = "string literal " ++  show s
+tokenErrorString (LiteralString s) = "string literal " ++ show s
 tokenErrorString AtSign = "\"@\""
 tokenErrorString Colon = "\":\""
 tokenErrorString DollarSign = "\"$\""
@@ -89,6 +91,13 @@ matchLiteralBool t = case locatedValue t of
     _ -> Nothing
 matchSimpleToken expected t = if locatedValue t == expected then Just () else Nothing
 
+matchLiteralId :: Located Token -> Maybe Word64
+matchLiteralId (Located _ (LiteralInt i))
+    | i >= (2^(63 :: Integer)) &&
+      i <  (2^(64 :: Integer))
+    = Just (fromIntegral i)
+matchLiteralId _ = Nothing
+
 varIdentifier = tokenParser matchIdentifier
             <|> (tokenParser matchTypeIdentifier >>=
                  fail "Non-type identifiers must start with lower-case letter.")
@@ -104,6 +113,7 @@ anyIdentifier = tokenParser matchIdentifier
 literalInt = tokenParser (matchUnary LiteralInt) <?> "integer"
 literalFloat = tokenParser (matchUnary LiteralFloat) <?> "floating-point number"
 literalString = tokenParser (matchUnary LiteralString) <?> "string"
+literalId = tokenParser matchLiteralId <?> "id (generate using capnpc -i)"
 literalBool = tokenParser matchLiteralBool <?> "boolean"
 literalVoid = tokenParser (matchSimpleToken VoidKeyword) <?> "\"void\""
 
@@ -166,6 +176,8 @@ nameWithOrdinal = do
     ordinal <- located literalInt
     return (name, ordinal)
 
+declId = atSign >> literalId
+
 annotation :: TokenParser Annotation
 annotation = do
     dollarSign
@@ -175,10 +187,15 @@ annotation = do
                   <|> return VoidFieldValue)
     return (Annotation name value)
 
-topLine :: Maybe [Located Statement] -> TokenParser (Either Declaration Annotation)
-topLine Nothing = liftM Left (usingDecl <|> constantDecl <|> annotationDecl)
-              <|> liftM Right annotation
-topLine (Just statements) = liftM Left $ typeDecl statements
+data TopLevelDecl = TopLevelDecl Declaration
+                  | TopLevelAnnotation Annotation
+                  | TopLevelId (Located Word64)
+
+topLine :: Maybe [Located Statement] -> TokenParser TopLevelDecl
+topLine Nothing = liftM TopLevelId (located declId)
+              <|> liftM TopLevelDecl (usingDecl <|> constantDecl <|> annotationDecl)
+              <|> liftM TopLevelAnnotation annotation
+topLine (Just statements) = liftM TopLevelDecl $ typeDecl statements
 
 usingDecl = do
     usingKeyword
@@ -214,9 +231,10 @@ typeDecl statements = enumDecl statements
 enumDecl statements = do
     enumKeyword
     name <- located typeIdentifier
+    typeId <- optionMaybe $ located declId
     annotations <- many annotation
     children <- parseBlock enumLine statements
-    return (EnumDecl name annotations children)
+    return (EnumDecl name typeId annotations children)
 
 enumLine :: Maybe [Located Statement] -> TokenParser Declaration
 enumLine Nothing = enumerantDecl
@@ -230,10 +248,11 @@ enumerantDecl = do
 structDecl statements = do
     structKeyword
     name <- located typeIdentifier
+    typeId <- optionMaybe $ located declId
     fixed <- optionMaybe fixedSpec
     annotations <- many annotation
     children <- parseBlock structLine statements
-    return (StructDecl name fixed annotations children)
+    return (StructDecl name typeId fixed annotations children)
 
 fixedSpec = do
     fixedKeyword
@@ -312,9 +331,10 @@ fieldAssignment = do
 interfaceDecl statements = do
     interfaceKeyword
     name <- located typeIdentifier
+    typeId <- optionMaybe $ located declId
     annotations <- many annotation
     children <- parseBlock interfaceLine statements
-    return (InterfaceDecl name annotations children)
+    return (InterfaceDecl name typeId annotations children)
 
 interfaceLine :: Maybe [Located Statement] -> TokenParser Declaration
 interfaceLine Nothing = usingDecl <|> constantDecl <|> methodDecl <|> annotationDecl
@@ -339,12 +359,13 @@ paramDecl = do
 annotationDecl = do
     annotationKeyword
     name <- located varIdentifier
+    annId <- optionMaybe $ located declId
     targets <- try (parenthesized asterisk >> return allAnnotationTargets)
            <|> parenthesizedList annotationTarget
     colon
     t <- typeExpression
     annotations <- many annotation
-    return (AnnotationDecl name t annotations targets)
+    return (AnnotationDecl name annId t annotations targets)
 allAnnotationTargets = [minBound::AnnotationTarget .. maxBound::AnnotationTarget]
 
 annotationTarget = (exactIdentifier "file" >> return FileAnnotation)
@@ -404,15 +425,23 @@ parseStatement parser (Located _ (Line tokens)) =
 parseStatement parser (Located _ (Block tokens statements)) =
     parseCollectingErrors (parser (Just statements)) tokens
 
-parseFileTokens :: [Located Statement] -> ([Declaration], [Annotation], [ParseError])
-parseFileTokens statements = (decls, annotations, errors) where
-    results :: [Either ParseError (Either Declaration Annotation, [ParseError])]
+parseFileTokens :: [Located Statement]
+                -> (Maybe (Located Word64), [Declaration], [Annotation], [ParseError])
+parseFileTokens statements = (fileId, decls, annotations, errors) where
+    results :: [Either ParseError (TopLevelDecl, [ParseError])]
     results = map (parseStatement topLine) statements
-    errors = concatMap extractErrors results
-    decls = [ decl | Right (Left decl, _) <- results ]
-    annotations = [ ann | Right (Right ann, _) <- results ]
-
-parseFile :: String -> String -> ([Declaration], [Annotation], [ParseError])
+    errors = concatMap extractErrors results ++ idErrors
+    decls = [ decl | Right (TopLevelDecl decl, _) <- results ]
+    annotations = [ ann | Right (TopLevelAnnotation ann, _) <- results ]
+    ids = [ i | Right (TopLevelId i, _) <- results ]
+    fileId = listToMaybe ids
+    idErrors | length ids <= 1 = []
+             | otherwise = map makeDupeIdError ids
+    makeDupeIdError (Located pos _) =
+        newErrorMessage (Message "File declares multiple ids.") pos
+
+parseFile :: String -> String
+          -> (Maybe (Located Word64), [Declaration], [Annotation], [ParseError])
 parseFile filename text = case parse lexer filename text of
-    Left e -> ([], [], [e])
+    Left e -> (Nothing, [], [], [e])
     Right statements -> parseFileTokens statements

compiler/src/Semantics.hs

@@ -66,7 +66,6 @@ data Desc = DescFile FileDesc
           | DescBuiltinInline
           | DescBuiltinInlineList
           | DescBuiltinInlineData
-          | DescBuiltinId
 
 descName (DescFile      _) = "(top-level)"
 descName (DescUsing     d) = usingName d
@@ -85,34 +84,13 @@ descName DescBuiltinList = "List"
 descName DescBuiltinInline = "Inline"
 descName DescBuiltinInlineList = "InlineList"
 descName DescBuiltinInlineData = "InlineData"
-descName DescBuiltinId = "id"
 
 descId (DescFile      d) = fileId d
-descId (DescUsing     _) = Nothing
-descId (DescConstant  d) = constantId d
 descId (DescEnum      d) = enumId d
-descId (DescEnumerant d) = enumerantId d
 descId (DescStruct    d) = structId d
-descId (DescUnion     d) = unionId d
-descId (DescField     d) = fieldId d
 descId (DescInterface d) = interfaceId d
-descId (DescMethod    d) = methodId d
-descId (DescParam     d) = paramId d
 descId (DescAnnotation d) = annotationId d
-descId (DescBuiltinType _) = Nothing
-descId DescBuiltinList = Nothing
-descId DescBuiltinInline = Nothing
-descId DescBuiltinInlineList = Nothing
-descId DescBuiltinInlineData = Nothing
-descId DescBuiltinId = Just "0U0T3e_SnatEfk6UcH2tcjTt1E0"
-
--- Gets the ID if explicitly defined, or generates it by appending ".name" to the parent's ID.
--- If no ancestor has an ID, still returns Nothing.
-descAutoId d = case descId d of
-    Just i -> Just i
-    Nothing -> case d of
-        DescFile _ -> Nothing
-        _ -> fmap (++ '.':descName d) $ descAutoId $ descParent d
+descId _ = error "This construct does not have an ID."
 
 descParent (DescFile      _) = error "File descriptor has no parent."
 descParent (DescUsing     d) = usingParent d
@@ -131,7 +109,6 @@ descParent DescBuiltinList = error "Builtin type has no parent."
 descParent DescBuiltinInline = error "Builtin type has no parent."
 descParent DescBuiltinInlineList = error "Builtin type has no parent."
 descParent DescBuiltinInlineData = error "Builtin type has no parent."
-descParent DescBuiltinId = error "Builtin annotation has no parent."
 
 descFile (DescFile d) = d
 descFile desc = descFile $ descParent desc
@@ -153,7 +130,6 @@ descAnnotations DescBuiltinList = Map.empty
 descAnnotations DescBuiltinInline = Map.empty
 descAnnotations DescBuiltinInlineList = Map.empty
 descAnnotations DescBuiltinInlineData = Map.empty
-descAnnotations DescBuiltinId = Map.empty
 
 descRuntimeImports (DescFile      _) = error "Not to be called on files."
 descRuntimeImports (DescUsing     d) = usingRuntimeImports d
@@ -172,7 +148,6 @@ descRuntimeImports DescBuiltinList = []
 descRuntimeImports DescBuiltinInline = []
 descRuntimeImports DescBuiltinInlineList = []
 descRuntimeImports DescBuiltinInlineData = []
-descRuntimeImports DescBuiltinId = []
 
 type MemberMap = Map.Map String (Maybe Desc)
 
@@ -398,7 +373,7 @@ descQualifiedName scope desc = descQualifiedName (descParent scope) desc
 
 data FileDesc = FileDesc
     { fileName :: String
-    , fileId :: Maybe String
+    , fileId :: Word64
     , fileImports :: [FileDesc]
     -- Set of imports which are used at runtime, i.e. not just for annotations.
     -- The set contains file names matching files in fileImports.
@@ -419,7 +394,6 @@ usingRuntimeImports _ = []
 
 data ConstantDesc = ConstantDesc
     { constantName :: String
-    , constantId :: Maybe String
     , constantParent :: Desc
     , constantType :: TypeDesc
     , constantAnnotations :: AnnotationMap
@@ -430,7 +404,7 @@ constantRuntimeImports desc = typeRuntimeImports $ constantType desc
 
 data EnumDesc = EnumDesc
     { enumName :: String
-    , enumId :: Maybe String
+    , enumId :: Word64
     , enumParent :: Desc
     , enumerants :: [EnumerantDesc]
     , enumAnnotations :: AnnotationMap
@@ -442,7 +416,6 @@ enumRuntimeImports desc = concatMap descRuntimeImports $ enumMembers desc
 
 data EnumerantDesc = EnumerantDesc
     { enumerantName :: String
-    , enumerantId :: Maybe String
     , enumerantParent :: EnumDesc
     , enumerantNumber :: Integer
     , enumerantAnnotations :: AnnotationMap
@@ -452,7 +425,7 @@ enumerantRuntimeImports _ = []
 
 data StructDesc = StructDesc
     { structName :: String
-    , structId :: Maybe String
+    , structId :: Word64
     , structParent :: Desc
     , structDataSize :: DataSectionSize
     , structPointerCount :: Integer
@@ -473,7 +446,6 @@ structRuntimeImports desc = concatMap descRuntimeImports $ structMembers desc
 
 data UnionDesc = UnionDesc
     { unionName :: String
-    , unionId :: Maybe String
     , unionParent :: StructDesc
     , unionNumber :: Integer
     , unionTagOffset :: Integer
@@ -490,7 +462,6 @@ unionRuntimeImports desc = concatMap descRuntimeImports $ unionMembers desc
 
 data FieldDesc = FieldDesc
     { fieldName :: String
-    , fieldId :: Maybe String
     , fieldParent :: StructDesc
     , fieldNumber :: Integer
     , fieldOffset :: FieldOffset
@@ -504,7 +475,7 @@ fieldRuntimeImports desc = typeRuntimeImports $ fieldType desc
 
 data InterfaceDesc = InterfaceDesc
     { interfaceName :: String
-    , interfaceId :: Maybe String
+    , interfaceId :: Word64
     , interfaceParent :: Desc
     , interfaceMethods :: [MethodDesc]
     , interfaceAnnotations :: AnnotationMap
@@ -516,7 +487,6 @@ interfaceRuntimeImports desc = concatMap descRuntimeImports $ interfaceMembers d
 
 data MethodDesc = MethodDesc
     { methodName :: String
-    , methodId :: Maybe String
     , methodParent :: InterfaceDesc
     , methodNumber :: Integer
     , methodParams :: [ParamDesc]
@@ -529,7 +499,6 @@ methodRuntimeImports desc = typeRuntimeImports (methodReturnType desc) ++
 
 data ParamDesc = ParamDesc
     { paramName :: String
-    , paramId :: Maybe String
     , paramParent :: MethodDesc
     , paramNumber :: Integer
     , paramType :: TypeDesc
@@ -544,20 +513,18 @@ data AnnotationDesc = AnnotationDesc
     , annotationParent :: Desc
     , annotationType :: TypeDesc
     , annotationAnnotations :: AnnotationMap
-    , annotationId :: Maybe String
+    , annotationId :: Word64
     , annotationTargets :: Set.Set AnnotationTarget
     }
 
 annotationRuntimeImports desc = typeRuntimeImports $ annotationType desc
 
-type AnnotationMap = Map.Map String (AnnotationDesc, ValueDesc)
+type AnnotationMap = Map.Map Word64 (AnnotationDesc, ValueDesc)
 
 descToCode :: String -> Desc -> String
-descToCode indent self@(DescFile desc) = printf "# %s\n%s%s%s"
+descToCode indent self@(DescFile desc) = printf "# %s\n@0x%016x;\n%s%s"
     (fileName desc)
-    (case fileId desc of
-        Just i -> printf "$id(%s);\n" $ show i
-        Nothing -> "")
+    (fileId desc)
     (concatMap ((++ ";\n") . annotationCode self) $ Map.toList $ fileAnnotations desc)
     (concatMap (descToCode indent) (fileMembers desc))
 descToCode indent (DescUsing desc) = printf "%susing %s = %s;\n" indent
@@ -568,16 +535,18 @@ descToCode indent self@(DescConstant desc) = printf "%sconst %s: %s = %s%s;\n" i
     (typeName (descParent self) (constantType desc))
     (valueString (constantValue desc))
     (annotationsCode self)
-descToCode indent self@(DescEnum desc) = printf "%senum %s%s {\n%s%s}\n" indent
+descToCode indent self@(DescEnum desc) = printf "%senum %s @0x%016x%s {\n%s%s}\n" indent
     (enumName desc)
+    (enumId desc)
     (annotationsCode self)
     (blockCode indent (enumMembers desc))
     indent
 descToCode indent self@(DescEnumerant desc) = printf "%s%s @%d%s;\n" indent
     (enumerantName desc) (enumerantNumber desc)
     (annotationsCode self)
-descToCode indent self@(DescStruct desc) = printf "%sstruct %s%s%s {\n%s%s}\n" indent
+descToCode indent self@(DescStruct desc) = printf "%sstruct %s @0x%016x%s%s {\n%s%s}\n" indent
     (structName desc)
+    (structId desc)
     (if structIsFixedWidth desc
         then printf " fixed(%s, %d pointers) "
             (dataSectionSizeString $ structDataSize desc)
@@ -609,8 +578,9 @@ descToCode indent self@(DescUnion desc) = printf "%sunion %s@%d%s {  # [%d, %d)\
     (unionTagOffset desc * 16) (unionTagOffset desc * 16 + 16)
     (blockCode indent $ unionMembers desc)
     indent
-descToCode indent self@(DescInterface desc) = printf "%sinterface %s%s {\n%s%s}\n" indent
+descToCode indent self@(DescInterface desc) = printf "%sinterface %s @0x%016x%s {\n%s%s}\n" indent
     (interfaceName desc)
+    (interfaceId desc)
     (annotationsCode self)
     (blockCode indent (interfaceMembers desc))
     indent
@@ -626,8 +596,9 @@ descToCode _ self@(DescParam desc) = printf "%s: %s%s%s"
         Just v -> printf " = %s" $ valueString v
         Nothing -> "")
     (annotationsCode self)
-descToCode indent self@(DescAnnotation desc) = printf "%sannotation %s: %s on(%s)%s;\n" indent
+descToCode indent self@(DescAnnotation desc) = printf "%sannotation %s @0x%016x: %s on(%s)%s;\n" indent
     (annotationName desc)
+    (annotationId desc)
     (typeName (descParent self) (annotationType desc))
     (delimit ", " $ map show $ Set.toList $ annotationTargets desc)
     (annotationsCode self)
@@ -636,7 +607,6 @@ descToCode _ DescBuiltinList = error "Can't print code for builtin type."
 descToCode _ DescBuiltinInline = error "Can't print code for builtin type."
 descToCode _ DescBuiltinInlineList = error "Can't print code for builtin type."
 descToCode _ DescBuiltinInlineData = error "Can't print code for builtin type."
-descToCode _ DescBuiltinId = error "Can't print code for builtin annotation."
 
 maybeBlockCode :: String -> [Desc] -> String
 maybeBlockCode _ [] = ";\n"
@@ -645,18 +615,14 @@ maybeBlockCode indent statements = printf " {\n%s%s}\n" (blockCode indent statem
 blockCode :: String -> [Desc] -> String
 blockCode indent = concatMap (descToCode ("  " ++ indent))
 
-annotationCode :: Desc -> (String, (AnnotationDesc, ValueDesc)) -> String
+annotationCode :: Desc -> (Word64, (AnnotationDesc, ValueDesc)) -> String
 annotationCode scope (_, (desc, VoidDesc)) =
     printf "$%s" (descQualifiedName scope (DescAnnotation desc))
 annotationCode scope (_, (desc, val)) =
     printf "$%s(%s)" (descQualifiedName scope (DescAnnotation desc)) (valueString val)
 
-annotationsCode desc = let
-    nonIds = concatMap ((' ':) . annotationCode (descParent desc)) $ Map.toList
-           $ descAnnotations desc
-    in case descId desc of
-        Just i -> printf " $id(%s)%s" (show i) nonIds
-        Nothing -> nonIds
+annotationsCode desc = concatMap ((' ':) . annotationCode (descParent desc)) $ Map.toList
+                     $ descAnnotations desc
 
 instance Show FileDesc where { show desc = descToCode "" (DescFile desc) }
 instance Show UsingDesc where { show desc = descToCode "" (DescUsing desc) }

compiler/src/Util.hs

@@ -25,6 +25,8 @@ module Util where
 
 import Data.Char (isUpper, toUpper)
 import Data.List (intercalate, isPrefixOf)
+import Data.Bits(shiftR, Bits)
+import Data.Word(Word8)
 
 --delimit _ [] = ""
 --delimit delimiter (h:t) = h ++ concatMap (delimiter ++) t
@@ -50,3 +52,8 @@ toTitleCase [] = []
 
 toUpperCaseWithUnderscores :: String -> String
 toUpperCaseWithUnderscores name = delimit "_" $ map (map toUpper) $ splitName name
+
+intToBytes :: (Integral a, Bits a) => a -> Int -> [Word8]
+intToBytes i count = map (byte i) [0..(count - 1)] where
+    byte :: (Integral a, Bits a) => a -> Int -> Word8
+    byte i2 amount = fromIntegral (shiftR i2 (amount * 8))

compiler/src/WireFormat.hs

@@ -25,18 +25,13 @@ module WireFormat(encodeMessage) where
 
 import Data.List(sortBy, genericLength, genericReplicate)
 import Data.Word
-import Data.Bits(shiftL, shiftR, Bits, setBit, xor)
+import Data.Bits(shiftL, Bits, setBit, xor)
 import Data.Function(on)
 import Semantics
 import Data.Binary.IEEE754(floatToWord, doubleToWord)
 import Text.Printf(printf)
 import qualified Codec.Binary.UTF8.String as UTF8
-
-byte :: (Integral a, Bits a) => a -> Int -> Word8
-byte i amount = fromIntegral (shiftR i (amount * 8))
-
-bytes :: (Integral a, Bits a) => a -> Int -> [Word8]
-bytes i count = map (byte i) [0..(count - 1)]
+import Util(intToBytes)
 
 padToWord b = let
     trailing = mod (length b) 8
@@ -55,19 +50,19 @@ xorData _ _ = error "Value type mismatch when xor'ing."
 encodeDataValue :: TypeDesc -> ValueDesc -> EncodedData
 encodeDataValue _ VoidDesc = EncodedBytes []
 encodeDataValue _ (BoolDesc v) = EncodedBit v
-encodeDataValue _ (Int8Desc v) = EncodedBytes $ bytes v 1
-encodeDataValue _ (Int16Desc v) = EncodedBytes $ bytes v 2
-encodeDataValue _ (Int32Desc v) = EncodedBytes $ bytes v 4
-encodeDataValue _ (Int64Desc v) = EncodedBytes $ bytes v 8
-encodeDataValue _ (UInt8Desc v) = EncodedBytes $ bytes v 1
-encodeDataValue _ (UInt16Desc v) = EncodedBytes $ bytes v 2
-encodeDataValue _ (UInt32Desc v) = EncodedBytes $ bytes v 4
-encodeDataValue _ (UInt64Desc v) = EncodedBytes $ bytes v 8
-encodeDataValue _ (Float32Desc v) = EncodedBytes $ bytes (floatToWord v) 4
-encodeDataValue _ (Float64Desc v) = EncodedBytes $ bytes (doubleToWord v) 8
+encodeDataValue _ (Int8Desc v) = EncodedBytes $ intToBytes v 1
+encodeDataValue _ (Int16Desc v) = EncodedBytes $ intToBytes v 2
+encodeDataValue _ (Int32Desc v) = EncodedBytes $ intToBytes v 4
+encodeDataValue _ (Int64Desc v) = EncodedBytes $ intToBytes v 8
+encodeDataValue _ (UInt8Desc v) = EncodedBytes $ intToBytes v 1
+encodeDataValue _ (UInt16Desc v) = EncodedBytes $ intToBytes v 2
+encodeDataValue _ (UInt32Desc v) = EncodedBytes $ intToBytes v 4
+encodeDataValue _ (UInt64Desc v) = EncodedBytes $ intToBytes v 8
+encodeDataValue _ (Float32Desc v) = EncodedBytes $ intToBytes (floatToWord v) 4
+encodeDataValue _ (Float64Desc v) = EncodedBytes $ intToBytes (doubleToWord v) 8
 encodeDataValue _ (TextDesc _) = error "Not fixed-width data."
 encodeDataValue _ (DataDesc _) = error "Not fixed-width data."
-encodeDataValue _ (EnumerantValueDesc v) = EncodedBytes $ bytes (enumerantNumber v) 2
+encodeDataValue _ (EnumerantValueDesc v) = EncodedBytes $ intToBytes (enumerantNumber v) 2
 encodeDataValue _ (StructValueDesc _) = error "Not fixed-width data."
 encodeDataValue _ (ListDesc _) = error "Not fixed-width data."
 
@@ -132,23 +127,23 @@ packPointers size items o = loop 0 items (o + size - 1) where
     loop idx [] _ = (genericReplicate ((size - idx) * 8) 0, [])
 
 encodeStructReference desc offset =
-    bytes (offset * 4 + structTag) 4 ++
-    bytes (dataSectionWordSize $ structDataSize desc) 2 ++
-    bytes (structPointerCount desc) 2
+    intToBytes (offset * 4 + structTag) 4 ++
+    intToBytes (dataSectionWordSize $ structDataSize desc) 2 ++
+    intToBytes (structPointerCount desc) 2
 
 encodeInlineStructListReference elementDataSize elementPointerCount elementCount offset = let
     dataBits = dataSectionBits elementDataSize * elementCount
     dataWords = div (dataBits + 63) 64
-    in bytes (offset * 4 + structTag) 4 ++
-       bytes dataWords 2 ++
-       bytes (elementPointerCount * elementCount) 2
+    in intToBytes (offset * 4 + structTag) 4 ++
+       intToBytes dataWords 2 ++
+       intToBytes (elementPointerCount * elementCount) 2
 
 encodeListReference elemSize@(SizeInlineComposite ds rc) elementCount offset =
-    bytes (offset * 4 + listTag) 4 ++
-    bytes (fieldSizeEnum elemSize + shiftL (elementCount * (dataSectionWordSize ds + rc)) 3) 4
+    intToBytes (offset * 4 + listTag) 4 ++
+    intToBytes (fieldSizeEnum elemSize + shiftL (elementCount * (dataSectionWordSize ds + rc)) 3) 4
 encodeListReference elemSize elementCount offset =
-    bytes (offset * 4 + listTag) 4 ++
-    bytes (fieldSizeEnum elemSize + shiftL elementCount 3) 4
+    intToBytes (offset * 4 + listTag) 4 ++
+    intToBytes (fieldSizeEnum elemSize + shiftL elementCount 3) 4
 
 fieldSizeEnum SizeVoid = 0
 fieldSizeEnum (SizeData Size1) = 1