Fix bugs in annotations, implement ability to set C++ namespace via annotations.

c++/Makefile.am

@@ -84,10 +84,13 @@ libcapnproto_a_SOURCES=                                        \
 # Tests ==============================================================
 
 capnpc_inputs =                                                \
+  src/capnproto/c++.capnp                                      \
   src/capnproto/test.capnp                                     \
   src/capnproto/test-import.capnp
 
 capnpc_outputs =                                               \
+  src/capnproto/c++.capnp.c++                                  \
+  src/capnproto/c++.capnp.h                                    \
   src/capnproto/test.capnp.c++                                 \
   src/capnproto/test.capnp.h                                   \
   src/capnproto/test-import.capnp.c++                          \

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

+# 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.
+
+$id("v3JF2GP4Supe9JSSJ3pnSdUqhJI");
+$namespace("capnproto::annotations");
+
+annotation namespace: Text on(file);

c++/src/capnproto/test-util.h

@@ -48,17 +48,26 @@ inline std::ostream& operator<<(std::ostream& os, Void) {
 
 namespace internal {
 
-void initTestMessage(TestAllTypes::Builder builder);
-void initTestMessage(TestDefaults::Builder builder);
+// Explicitly import each of these to make sure they're really located in capnproto::test and not,
+// say, the global namespace.
+using ::capnproto::test::TestAllTypes;
+using ::capnproto::test::TestDefaults;
+using ::capnproto::test::TestEnum;
+using ::capnproto::test::TestUnion;
+using ::capnproto::test::TestUnionDefaults;
+using ::capnproto::test::TestNestedTypes;
 
-void checkTestMessage(TestAllTypes::Builder builder);
-void checkTestMessage(TestDefaults::Builder builder);
+void initTestMessage(test::TestAllTypes::Builder builder);
+void initTestMessage(test::TestDefaults::Builder builder);
 
-void checkTestMessage(TestAllTypes::Reader reader);
-void checkTestMessage(TestDefaults::Reader reader);
+void checkTestMessage(test::TestAllTypes::Builder builder);
+void checkTestMessage(test::TestDefaults::Builder builder);
 
-void checkTestMessageAllZero(TestAllTypes::Builder builder);
-void checkTestMessageAllZero(TestAllTypes::Reader reader);
+void checkTestMessage(test::TestAllTypes::Reader reader);
+void checkTestMessage(test::TestDefaults::Reader reader);
+
+void checkTestMessageAllZero(test::TestAllTypes::Builder builder);
+void checkTestMessageAllZero(test::TestAllTypes::Reader reader);
 
 }  // namespace internal
 }  // namespace capnproto

c++/src/capnproto/test.capnp

@@ -21,6 +21,10 @@
 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+using Cxx = import "c++.capnp";
+
+$Cxx.namespace("capnproto::test");
+
 enum TestEnum {
   foo @0;
   bar @1;

compiler/src/Compiler.hs

@@ -25,14 +25,14 @@ module Compiler where
 
 import Grammar
 import Semantics
-import Token(Located(Located))
+import Token(Located(Located), locatedPos, locatedValue)
 import Parser(parseFile)
 import Control.Monad(unless)
 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)
+import Data.Maybe(mapMaybe, fromMaybe, listToMaybe, catMaybes)
 import Text.Parsec.Pos(SourcePos, newPos)
 import Text.Parsec.Error(ParseError, newErrorMessage, Message(Message, Expect))
 import Text.Printf(printf)
@@ -154,27 +154,7 @@ lookupDesc scope name = lookupDesc (descParent scope) name
 builtinTypeMap :: Map.Map String Desc
 builtinTypeMap = Map.fromList
     ([(builtinTypeName t, DescBuiltinType t) | t <- builtinTypes] ++
-     [("List", DescBuiltinList), ("id", DescAnnotation builtinId)])
-
-builtinId = AnnotationDesc
-    { annotationName = "id"
-    , annotationParent = DescFile FileDesc
-        { fileName = "capnproto-builtins.capnp"
-        , fileImports = []
-        , fileAliases = []
-        , fileConstants = []
-        , fileEnums = []
-        , fileStructs = []
-        , fileInterfaces = []
-        , fileAnnotations = Map.empty
-        , fileMemberMap = Map.fromList [("id", Just $ DescAnnotation builtinId)]
-        , fileImportMap = Map.empty
-        , fileStatements = [DescAnnotation builtinId]
-        }
-    , annotationType = BuiltinType BuiltinText
-    , annotationAnnotations = Map.fromList [(idId, (builtinId, TextDesc idId))]
-    , annotationTargets = Set.fromList [minBound::AnnotationTarget .. maxBound::AnnotationTarget]
-    }
+     [("List", DescBuiltinList), ("id", DescBuiltinId)])
 
 ------------------------------------------------------------------------------------------
 
@@ -304,30 +284,57 @@ compileType scope (TypeExpression n (param:moreParams)) = do
                 else makeError (declNamePos n) "'List' requires exactly one type parameter."
         _ -> makeError (declNamePos n) "Only the type 'List' can have type parameters."
 
-compileAnnotation :: Desc -> AnnotationTarget -> Annotation -> Status (AnnotationDesc, ValueDesc)
+compileAnnotation :: Desc -> AnnotationTarget -> Annotation
+                  -> Status (Maybe AnnotationDesc, ValueDesc)
 compileAnnotation scope kind (Annotation name (Located pos value)) = do
     nameDesc <- lookupDesc scope name
-    annDesc <- case nameDesc of
-        DescAnnotation a -> return a
-        _ -> makeError (declNamePos name)
-           $ printf "'%s' is not an annotation." (declNameString 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 (annDesc, compiledValue)
+            return (Just annDesc, compiledValue)
+        _ -> makeError (declNamePos name)
+           $ printf "'%s' is not an annotation." (declNameString name)
 
-compileAnnotationMap :: Desc -> AnnotationTarget -> [Annotation] -> Status AnnotationMap
-compileAnnotationMap scope kind annotations = do
-    compiled <- doAll $ map (compileAnnotation scope kind) annotations
+compileAnnotations :: Desc -> AnnotationTarget -> [Annotation]
+                   -> Status (Maybe String, AnnotationMap)  -- (id, other annotations)
+compileAnnotations scope kind annotations = do
+    let compileLocated ann@(Annotation name _) =
+            fmap (Located $ declNamePos name) $ compileAnnotation scope kind ann
 
-    -- Makes a map entry for the annotation keyed by ID.  Throws out annotations with no ID.
-    let makeMapEntry ann@(desc, _) =
-            case Map.lookup idId $ annotationAnnotations desc of
-                Just (_, TextDesc globalId) -> Just (globalId, ann)
-                _ -> Nothing
+    compiled <- doAll $ map compileLocated annotations
 
-    return $ Map.fromList $ mapMaybe makeMapEntry compiled
+    -- 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
+
+        -- TODO(cleanup):  Generalize duplicate detection.
+        sortedLocatedEntries = detectDup $ List.sortBy compareIds locatedEntries
+        compareIds (Located _ (a, _)) (Located _ (b, _)) = compare a b
+        detectDup (Located _ x@(id1, _):Located pos (id2, _):rest)
+            | id1 == id2 = succeed x:makeError pos "Duplicate annotation.":detectDup rest
+        detectDup (Located _ x:rest) = succeed x:detectDup rest
+        detectDup [] = []
+
+    finalEntries <- doAll sortedLocatedEntries
+    _ <- doAll dupIds
+
+    return (theId, Map.fromList finalEntries)
 
 ------------------------------------------------------------------------------------------
 
@@ -559,9 +566,10 @@ compileDecl scope (ConstantDecl (Located _ name) t annotations (Located valuePos
     CompiledStatementStatus name (do
         typeDesc <- compileType scope t
         valueDesc <- compileValue valuePos typeDesc value
-        compiledAnnotations <- compileAnnotationMap scope ConstantAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope ConstantAnnotation annotations
         return (DescConstant ConstantDesc
             { constantName = name
+            , constantId = theId
             , constantParent = scope
             , constantType = typeDesc
             , constantValue = valueDesc
@@ -575,9 +583,10 @@ compileDecl scope (EnumDecl (Located _ name) annotations decls) =
         let numbers = [ num | EnumValueDecl _ num _ <- decls ]
         requireSequentialNumbering "Enum values" numbers
         requireOrdinalsInRange numbers
-        compiledAnnotations <- compileAnnotationMap scope EnumAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope EnumAnnotation annotations
         return (DescEnum EnumDesc
             { enumName = name
+            , enumId = theId
             , enumParent = scope
             , enumValues = [d | DescEnumValue d <- members]
             , enumAnnotations = compiledAnnotations
@@ -588,9 +597,10 @@ compileDecl scope (EnumDecl (Located _ name) annotations decls) =
 compileDecl scope@(DescEnum parent)
             (EnumValueDecl (Located _ name) (Located _ number) annotations) =
     CompiledStatementStatus name (do
-        compiledAnnotations <- compileAnnotationMap scope EnumValueAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope EnumValueAnnotation annotations
         return (DescEnumValue EnumValueDesc
             { enumValueName = name
+            , enumValueId = theId
             , enumValueParent = parent
             , enumValueNumber = number
             , enumValueAnnotations = compiledAnnotations
@@ -605,13 +615,14 @@ compileDecl scope (StructDecl (Located _ name) annotations decls) =
         let fieldNums = extractFieldNumbers decls
         requireSequentialNumbering "Fields" fieldNums
         requireOrdinalsInRange fieldNums
-        compiledAnnotations <- compileAnnotationMap scope StructAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope StructAnnotation annotations
         return (let
             fields = [d | DescField d <- members]
             unions = [d | DescUnion d <- members]
             (packing, _, fieldPackingMap) = packFields fields unions
             in DescStruct StructDesc
             { structName = name
+            , structId = theId
             , structParent = scope
             , structPacking = packing
             , structFields = fields
@@ -635,11 +646,12 @@ compileDecl scope@(DescStruct parent)
             orderedFieldNumbers = List.sort $ map fieldNumber fields
             discriminantMap = Map.fromList $ zip orderedFieldNumbers [0..]
         requireNoMoreThanOneFieldNumberLessThan name numPos number fields
-        compiledAnnotations <- compileAnnotationMap scope UnionAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope UnionAnnotation annotations
         return (let
             (tagOffset, tagPacking) = structFieldPackingMap parent ! number
             in DescUnion UnionDesc
             { unionName = name
+            , unionId = theId
             , unionParent = parent
             , unionNumber = number
             , unionTagOffset = tagOffset
@@ -667,11 +679,12 @@ compileDecl scope
         defaultDesc <- case defaultValue of
             Just (Located defaultPos value) -> fmap Just (compileValue defaultPos typeDesc value)
             Nothing -> return Nothing
-        compiledAnnotations <- compileAnnotationMap scope FieldAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope FieldAnnotation annotations
         return (let
             (offset, packing) = structFieldPackingMap parent ! number
             in DescField FieldDesc
             { fieldName = name
+            , fieldId = theId
             , fieldParent = parent
             , fieldNumber = number
             , fieldOffset = offset
@@ -689,9 +702,10 @@ compileDecl scope (InterfaceDecl (Located _ name) annotations decls) =
         let numbers = [ num | MethodDecl _ num _ _ _ <- decls ]
         requireSequentialNumbering "Methods" numbers
         requireOrdinalsInRange numbers
-        compiledAnnotations <- compileAnnotationMap scope InterfaceAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope InterfaceAnnotation annotations
         return (DescInterface InterfaceDesc
             { interfaceName = name
+            , interfaceId = theId
             , interfaceParent = scope
             , interfaceMethods          = [d | DescMethod    d <- members]
             , interfaceNestedAliases    = [d | DescAlias     d <- members]
@@ -709,9 +723,10 @@ compileDecl scope@(DescInterface parent)
     CompiledStatementStatus name (feedback (\desc -> do
         paramDescs <- doAll (map (compileParam desc) (zip [0..] params))
         returnTypeDesc <- compileType scope returnType
-        compiledAnnotations <- compileAnnotationMap scope MethodAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope MethodAnnotation annotations
         return (DescMethod MethodDesc
             { methodName = name
+            , methodId = theId
             , methodParent = parent
             , methodNumber = number
             , methodParams = paramDescs
@@ -724,9 +739,10 @@ compileDecl _ (MethodDecl (Located pos name) _ _ _ _) =
 compileDecl scope (AnnotationDecl (Located _ name) typeExp annotations targets) =
     CompiledStatementStatus name (do
         typeDesc <- compileType scope typeExp
-        compiledAnnotations <- compileAnnotationMap scope AnnotationAnnotation annotations
+        (theId, compiledAnnotations) <- compileAnnotations scope AnnotationAnnotation annotations
         return (DescAnnotation AnnotationDesc
             { annotationName = name
+            , annotationId = theId
             , annotationParent = scope
             , annotationType = typeDesc
             , annotationAnnotations = compiledAnnotations
@@ -739,9 +755,10 @@ compileParam scope@(DescMethod parent)
     defaultDesc <- case defaultValue of
         Just (Located pos value) -> fmap Just (compileValue pos typeDesc value)
         Nothing -> return Nothing
-    compiledAnnotations <- compileAnnotationMap scope ParamAnnotation annotations
+    (theId, compiledAnnotations) <- compileAnnotations scope ParamAnnotation annotations
     return ParamDesc
         { paramName = name
+        , paramId = theId
         , paramParent = parent
         , paramNumber = ordinal
         , paramType = typeDesc
@@ -754,9 +771,11 @@ compileFile name decls annotations importMap =
     feedback (\desc -> do
         (members, memberMap) <- compileChildDecls (DescFile desc) decls
         requireNoDuplicateNames decls
-        compiledAnnotations <- compileAnnotationMap (DescFile desc) FileAnnotation annotations
+        (theId, compiledAnnotations)
+            <- compileAnnotations (DescFile desc) FileAnnotation annotations
         return FileDesc
             { fileName = name
+            , fileId = theId
             , fileImports = Map.elems importMap
             , fileAliases    = [d | DescAlias     d <- members]
             , fileConstants  = [d | DescConstant  d <- members]
@@ -774,6 +793,7 @@ dedup = Set.toList . Set.fromList
 
 emptyFileDesc filename = FileDesc
     { fileName = filename
+    , fileId = Nothing
     , fileImports = []
     , fileAliases = []
     , fileConstants = []

compiler/src/CxxGenerator.hs

@@ -30,7 +30,7 @@ import Data.FileEmbed(embedFile)
 import Data.Word(Word8)
 import qualified Data.Digest.MD5 as MD5
 import qualified Data.Map as Map
-import Data.Maybe(catMaybes)
+import Data.Maybe(catMaybes, fromMaybe)
 import Data.Binary.IEEE754(floatToWord, doubleToWord)
 import Text.Printf(printf)
 import Text.Hastache
@@ -50,12 +50,20 @@ muNull = MuBool False;
 -- Using a single-element list has the same effect, though.
 muJust c = MuList [c]
 
+namespaceAnnotationId = "v3JF2GP4Supe9JSSJ3pnSdUqhJI.namespace"
+
+fileNamespace desc = fmap testAnnotation $ Map.lookup namespaceAnnotationId $ fileAnnotations desc
+
+testAnnotation (_, TextDesc x) = x
+testAnnotation (desc, _) =
+    error "Annotation was supposed to be text, but wasn't: " ++ annotationName desc
+
 fullName desc = scopePrefix (descParent desc) ++ descName desc
 
 scopePrefix (DescFile _) = ""
 scopePrefix desc = fullName desc ++ "::"
 
-globalName (DescFile _) = " "  -- TODO: namespaces
+globalName (DescFile desc) = maybe " " (" ::" ++) $ fileNamespace desc
 globalName desc = globalName (descParent desc) ++ "::" ++ descName desc
 
 -- Flatten the descriptor tree in pre-order, returning struct, union, and interface descriptors
@@ -303,14 +311,20 @@ importContext parent filename = mkStrContext context where
     context "importIsSystem" = MuBool False
     context s = parent s
 
+namespaceContext parent part = mkStrContext context where
+    context "namespaceName" = MuVariable part
+    context s = parent s
+
 fileContext desc = mkStrContext context where
     flattenedMembers = flattenTypes $ catMaybes $ Map.elems $ fileMemberMap desc
 
+    namespace = maybe [] (splitOn "::") $ fileNamespace desc
+
     context "fileName" = MuVariable $ fileName desc
     context "fileBasename" = MuVariable $ takeBaseName $ fileName desc
     context "fileIncludeGuard" = MuVariable $
-        "CAPNPROTO_INCLUDED_" ++ hashString (fileName desc)
-    context "fileNamespaces" = MuList []  -- TODO
+        "CAPNPROTO_INCLUDED_" ++ hashString (fileName desc ++ ':':fromMaybe "" (fileId desc))
+    context "fileNamespaces" = MuList $ map (namespaceContext context) namespace
     context "fileEnums" = MuList $ map (enumContext context) $ fileEnums desc
     context "fileTypes" = MuList $ map (typeContext context) flattenedMembers
     context "fileImports" = MuList $ map (importContext context) $ Map.keys $ fileImportMap desc

compiler/src/Parser.hs

@@ -184,9 +184,9 @@ constantDecl = do
     name <- located varIdentifier
     colon
     typeName <- typeExpression
-    annotations <- many annotation
     equalsSign
     value <- located fieldValue
+    annotations <- many annotation
     return (ConstantDecl name typeName annotations value)
 
 typeDecl statements = enumDecl statements
@@ -235,8 +235,8 @@ fieldDecl = do
     (name, ordinal) <- nameWithOrdinal
     colon
     t <- typeExpression
-    annotations <- many annotation
     value <- optionMaybe (equalsSign >> located fieldValue)
+    annotations <- many annotation
     return (FieldDecl name ordinal t annotations value)
 
 negativeFieldValue = liftM (IntegerFieldValue . negate) literalInt
@@ -288,8 +288,8 @@ paramDecl = do
     name <- varIdentifier
     colon
     t <- typeExpression
-    annotations <- many annotation
     value <- optionMaybe (equalsSign >> located fieldValue)
+    annotations <- many annotation
     return (ParamDecl name t annotations value)
 
 annotationDecl = do
@@ -297,10 +297,10 @@ annotationDecl = do
     name <- located varIdentifier
     colon
     t <- typeExpression
-    annotations <- many annotation
     onKeyword
     targets <- try (parenthesized asterisk >> return allAnnotationTargets)
            <|> parenthesizedList annotationTarget
+    annotations <- many annotation
     return (AnnotationDecl name t annotations targets)
 allAnnotationTargets = [minBound::AnnotationTarget .. maxBound::AnnotationTarget]
 

compiler/src/Semantics.hs

@@ -39,8 +39,6 @@ import Grammar(AnnotationTarget(..))
 -- ordinal is 65534.
 maxOrdinal = 65534 :: Integer
 
-idId = "com.capnproto.compiler.builtin.id"
-
 type ByteString = [Word8]
 
 data Desc = DescFile FileDesc
@@ -57,6 +55,7 @@ data Desc = DescFile FileDesc
           | DescAnnotation AnnotationDesc
           | DescBuiltinType BuiltinType
           | DescBuiltinList
+          | DescBuiltinId
 
 descName (DescFile      _) = "(top-level)"
 descName (DescAlias     d) = aliasName d
@@ -72,6 +71,31 @@ descName (DescParam     d) = paramName d
 descName (DescAnnotation d) = annotationName d
 descName (DescBuiltinType d) = builtinTypeName d
 descName DescBuiltinList = "List"
+descName DescBuiltinId = "id"
+
+descId (DescFile      d) = fileId d
+descId (DescAlias     _) = Nothing
+descId (DescConstant  d) = constantId d
+descId (DescEnum      d) = enumId d
+descId (DescEnumValue d) = enumValueId 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 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
 
 descParent (DescFile      _) = error "File descriptor has no parent."
 descParent (DescAlias     d) = aliasParent d
@@ -87,6 +111,23 @@ descParent (DescParam     d) = DescMethod (paramParent d)
 descParent (DescAnnotation d) = annotationParent d
 descParent (DescBuiltinType _) = error "Builtin type has no parent."
 descParent DescBuiltinList = error "Builtin type has no parent."
+descParent DescBuiltinId = error "Builtin annotation has no parent."
+
+descAnnotations (DescFile      d) = fileAnnotations d
+descAnnotations (DescAlias     _) = Map.empty
+descAnnotations (DescConstant  d) = constantAnnotations d
+descAnnotations (DescEnum      d) = enumAnnotations d
+descAnnotations (DescEnumValue d) = enumValueAnnotations d
+descAnnotations (DescStruct    d) = structAnnotations d
+descAnnotations (DescUnion     d) = unionAnnotations d
+descAnnotations (DescField     d) = fieldAnnotations d
+descAnnotations (DescInterface d) = interfaceAnnotations d
+descAnnotations (DescMethod    d) = methodAnnotations d
+descAnnotations (DescParam     d) = paramAnnotations d
+descAnnotations (DescAnnotation d) = annotationAnnotations d
+descAnnotations (DescBuiltinType _) = Map.empty
+descAnnotations DescBuiltinList = Map.empty
+descAnnotations DescBuiltinId = Map.empty
 
 type MemberMap = Map.Map String (Maybe Desc)
 
@@ -264,6 +305,7 @@ descQualifiedName scope desc = descQualifiedName (descParent scope) desc
 
 data FileDesc = FileDesc
     { fileName :: String
+    , fileId :: Maybe String
     , fileImports :: [FileDesc]
     , fileAliases :: [AliasDesc]
     , fileConstants :: [ConstantDesc]
@@ -284,6 +326,7 @@ data AliasDesc = AliasDesc
 
 data ConstantDesc = ConstantDesc
     { constantName :: String
+    , constantId :: Maybe String
     , constantParent :: Desc
     , constantType :: TypeDesc
     , constantAnnotations :: AnnotationMap
@@ -292,6 +335,7 @@ data ConstantDesc = ConstantDesc
 
 data EnumDesc = EnumDesc
     { enumName :: String
+    , enumId :: Maybe String
     , enumParent :: Desc
     , enumValues :: [EnumValueDesc]
     , enumAnnotations :: AnnotationMap
@@ -301,6 +345,7 @@ data EnumDesc = EnumDesc
 
 data EnumValueDesc = EnumValueDesc
     { enumValueName :: String
+    , enumValueId :: Maybe String
     , enumValueParent :: EnumDesc
     , enumValueNumber :: Integer
     , enumValueAnnotations :: AnnotationMap
@@ -308,6 +353,7 @@ data EnumValueDesc = EnumValueDesc
 
 data StructDesc = StructDesc
     { structName :: String
+    , structId :: Maybe String
     , structParent :: Desc
     , structPacking :: PackingState
     , structFields :: [FieldDesc]
@@ -329,6 +375,7 @@ data StructDesc = StructDesc
 
 data UnionDesc = UnionDesc
     { unionName :: String
+    , unionId :: Maybe String
     , unionParent :: StructDesc
     , unionNumber :: Integer
     , unionTagOffset :: Integer
@@ -344,6 +391,7 @@ data UnionDesc = UnionDesc
 
 data FieldDesc = FieldDesc
     { fieldName :: String
+    , fieldId :: Maybe String
     , fieldParent :: StructDesc
     , fieldNumber :: Integer
     , fieldOffset :: Integer
@@ -356,6 +404,7 @@ data FieldDesc = FieldDesc
 
 data InterfaceDesc = InterfaceDesc
     { interfaceName :: String
+    , interfaceId :: Maybe String
     , interfaceParent :: Desc
     , interfaceMethods :: [MethodDesc]
     , interfaceNestedAliases :: [AliasDesc]
@@ -370,6 +419,7 @@ data InterfaceDesc = InterfaceDesc
 
 data MethodDesc = MethodDesc
     { methodName :: String
+    , methodId :: Maybe String
     , methodParent :: InterfaceDesc
     , methodNumber :: Integer
     , methodParams :: [ParamDesc]
@@ -379,6 +429,7 @@ data MethodDesc = MethodDesc
 
 data ParamDesc = ParamDesc
     { paramName :: String
+    , paramId :: Maybe String
     , paramParent :: MethodDesc
     , paramNumber :: Integer
     , paramType :: TypeDesc
@@ -391,43 +442,47 @@ data AnnotationDesc = AnnotationDesc
     , annotationParent :: Desc
     , annotationType :: TypeDesc
     , annotationAnnotations :: AnnotationMap
+    , annotationId :: Maybe String
     , annotationTargets :: Set.Set AnnotationTarget
     }
 
 type AnnotationMap = Map.Map String (AnnotationDesc, ValueDesc)
 
 descToCode :: String -> Desc -> String
-descToCode indent self@(DescFile desc) = printf "# %s\n%s%s"
+descToCode indent self@(DescFile desc) = printf "# %s\n%s%s%s"
     (fileName desc)
-    (concatMap ((++ ";\n") . annotationCode (descParent self)) $ Map.toList $ fileAnnotations desc)
+    (case fileId desc of
+        Just i -> printf "$id(%s);\n" $ show i
+        Nothing -> "")
+    (concatMap ((++ ";\n") . annotationCode self) $ Map.toList $ fileAnnotations desc)
     (concatMap (descToCode indent) (fileStatements desc))
 descToCode indent (DescAlias desc) = printf "%susing %s = %s;\n" indent
     (aliasName desc)
     (descQualifiedName (aliasParent desc) (aliasTarget desc))
-descToCode indent self@(DescConstant desc) = printf "%sconst %s: %s%s = %s;\n" indent
+descToCode indent self@(DescConstant desc) = printf "%sconst %s: %s = %s%s;\n" indent
     (constantName desc)
     (typeName (descParent self) (constantType desc))
-    (annotationsCode (descParent self) $ constantAnnotations desc)
     (valueString (constantValue desc))
+    (annotationsCode self)
 descToCode indent self@(DescEnum desc) = printf "%senum %s%s {\n%s%s}\n" indent
     (enumName desc)
-    (annotationsCode (descParent self) $ enumAnnotations desc)
+    (annotationsCode self)
     (blockCode indent (enumStatements desc))
     indent
 descToCode indent self@(DescEnumValue desc) = printf "%s%s @%d%s;\n" indent
     (enumValueName desc) (enumValueNumber desc)
-    (annotationsCode (descParent self) $ enumValueAnnotations desc)
+    (annotationsCode self)
 descToCode indent self@(DescStruct desc) = printf "%sstruct %s%s {\n%s%s}\n" indent
     (structName desc)
-    (annotationsCode (descParent self) $ structAnnotations desc)
+    (annotationsCode self)
     (blockCode indent (structStatements desc))
     indent
 descToCode indent self@(DescField desc) = printf "%s%s@%d%s: %s%s%s;  # %s\n" indent
     (fieldName desc) (fieldNumber desc)
     (case fieldUnion desc of { Nothing -> ""; Just (u, _) -> " in " ++ unionName u})
     (typeName (descParent self) (fieldType desc))
-    (annotationsCode (descParent self) $ fieldAnnotations desc)
     (case fieldDefaultValue desc of { Nothing -> ""; Just v -> " = " ++ valueString v; })
+    (annotationsCode self)
     (case fieldSize $ fieldType desc of
         SizeReference -> printf "ref[%d]" $ fieldOffset desc
         SizeInlineComposite _ _ -> "??"
@@ -437,34 +492,35 @@ descToCode indent self@(DescField desc) = printf "%s%s@%d%s: %s%s%s;  # %s\n" in
             in printf "bits[%d, %d)" (offset * bits) ((offset + 1) * bits))
 descToCode indent self@(DescUnion desc) = printf "%sunion %s@%d%s {  # [%d, %d)\n%s%s}\n" indent
     (unionName desc) (unionNumber desc)
-    (annotationsCode (descParent self) $ unionAnnotations desc)
+    (annotationsCode self)
     (unionTagOffset desc * 16) (unionTagOffset desc * 16 + 16)
     (blockCode indent $ unionStatements desc)
     indent
 descToCode indent self@(DescInterface desc) = printf "%sinterface %s%s {\n%s%s}\n" indent
     (interfaceName desc)
-    (annotationsCode (descParent self) $ interfaceAnnotations desc)
+    (annotationsCode self)
     (blockCode indent (interfaceStatements desc))
     indent
 descToCode indent self@(DescMethod desc) = printf "%s%s@%d(%s): %s%s" indent
     (methodName desc) (methodNumber desc)
     (delimit ", " (map (descToCode indent . DescParam) (methodParams desc)))
     (typeName (descParent self) (methodReturnType desc))
-    (annotationsCode (descParent self) $ methodAnnotations desc)
+    (annotationsCode self)
 descToCode _ self@(DescParam desc) = printf "%s: %s%s%s"
     (paramName desc)
     (typeName (descParent self) (paramType desc))
-    (annotationsCode (descParent self) $ paramAnnotations desc)
     (case paramDefaultValue desc of
         Just v -> printf " = %s" $ valueString v
         Nothing -> "")
-descToCode indent self@(DescAnnotation desc) = printf "%sannotation %s: %s%s on(%s);\n" indent
+    (annotationsCode self)
+descToCode indent self@(DescAnnotation desc) = printf "%sannotation %s: %s on(%s)%s;\n" indent
     (annotationName desc)
     (typeName (descParent self) (annotationType desc))
-    (annotationsCode (descParent self) $ annotationAnnotations desc)
     (delimit ", " $ map show $ Set.toList $ annotationTargets desc)
+    (annotationsCode self)
 descToCode _ (DescBuiltinType _) = error "Can't print code for builtin type."
 descToCode _ DescBuiltinList = error "Can't print code for builtin type."
+descToCode _ DescBuiltinId = error "Can't print code for builtin annotation."
 
 maybeBlockCode :: String -> [Desc] -> String
 maybeBlockCode _ [] = ";\n"
@@ -476,12 +532,15 @@ blockCode indent = concatMap (descToCode ("  " ++ indent))
 annotationCode :: Desc -> (String, (AnnotationDesc, ValueDesc)) -> String
 annotationCode scope (_, (desc, VoidDesc)) =
     printf "$%s" (descQualifiedName scope (DescAnnotation desc))
-annotationCode _ (annId, (desc, val)) | annId == idId =
-    printf "$id(%s)" (valueString val)
 annotationCode scope (_, (desc, val)) =
     printf "$%s(%s)" (descQualifiedName scope (DescAnnotation desc)) (valueString val)
 
-annotationsCode scope = concatMap ((' ':) . annotationCode scope) . Map.toList
+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
 
 instance Show FileDesc where { show desc = descToCode "" (DescFile desc) }
 instance Show AliasDesc where { show desc = descToCode "" (DescAlias desc) }

compiler/src/Util.hs

@@ -24,12 +24,19 @@
 module Util where
 
 import Data.Char (isUpper, toUpper)
-import Data.List (intercalate)
+import Data.List (intercalate, isPrefixOf)
 
 --delimit _ [] = ""
 --delimit delimiter (h:t) = h ++ concatMap (delimiter ++) t
 delimit = intercalate
 
+splitOn :: String -> String -> [String]
+splitOn _ "" = [""]
+splitOn delimiter text | delimiter `isPrefixOf` text =
+    []:splitOn delimiter (drop (length delimiter) text)
+splitOn delimiter (c:rest) = let (first:more) = splitOn delimiter rest in (c:first):more
+
+-- Splits "camelCase" into ["camel", "Case"]
 splitName :: String -> [String]
 splitName (a:rest@(b:_)) | isUpper b = [a]:splitName rest
 splitName (a:rest) = case splitName rest of