Compile inline lists (TODO: code generation).

compiler/src/Compiler.hs

@@ -161,7 +161,10 @@ lookupDesc scope name = lookupDesc (descParent scope) name
 builtinTypeMap :: Map.Map String Desc
 builtinTypeMap = Map.fromList
     ([(builtinTypeName t, DescBuiltinType t) | t <- builtinTypes] ++
-     [("List", DescBuiltinList), ("Inline", DescBuiltinInline), ("id", DescBuiltinId)])
+     [("List", DescBuiltinList),
+      ("Inline", DescBuiltinInline),
+      ("InlineList", DescBuiltinInlineList),
+      ("id", DescBuiltinId)])
 
 ------------------------------------------------------------------------------------------
 
@@ -246,6 +249,12 @@ compileValue pos (InlineStructType desc) v = compileValue pos (StructType desc)
 compileValue _ (ListType t) (ListFieldValue l) =
     fmap ListDesc (doAll [ compileValue vpos t v | Located vpos v <- l ])
 
+compileValue pos (InlineListType t s) (ListFieldValue l) = do
+    elements <- doAll [ compileValue vpos t v | Located vpos v <- l ]
+    when (List.genericLength elements /= s) $
+        makeError pos $ printf "Fixed-size list must have exactly %d elements." s
+    return $ ListDesc elements
+
 compileValue pos (BuiltinType BuiltinVoid) _ = makeError pos "Void fields cannot have values."
 compileValue pos (BuiltinType BuiltinBool) _ = makeExpectError pos "boolean"
 compileValue pos (BuiltinType BuiltinInt8) _ = makeExpectError pos "integer"
@@ -263,9 +272,9 @@ compileValue pos (BuiltinType BuiltinData) _ = makeExpectError pos "string"
 
 compileValue pos (EnumType _) _ = makeExpectError pos "enumerant name"
 compileValue pos (StructType _) _ = makeExpectError pos "parenthesized list of field assignments"
-compileValue pos (InlineStructType _) _ = makeExpectError pos "parenthesized list of field assignments"
 compileValue pos (InterfaceType _) _ = makeError pos "Interfaces can't have default values."
 compileValue pos (ListType _) _ = makeExpectError pos "list"
+compileValue pos (InlineListType _ _) _ = makeExpectError pos "list"
 
 descAsType _ (DescEnum desc) = succeed (EnumType desc)
 descAsType _ (DescStruct desc) = succeed (StructType desc)
@@ -276,33 +285,39 @@ descAsType name DescBuiltinList = makeError (declNamePos name) message where
             message = printf "'List' requires exactly one type parameter." (declNameString name)
 descAsType name DescBuiltinInline = makeError (declNamePos name) message where
             message = printf "'Inline' requires exactly one type parameter." (declNameString name)
+descAsType name DescBuiltinInlineList = makeError (declNamePos name) message where
+            message = printf "'InlineList' requires exactly one type parameter." (declNameString name)
 descAsType name _ = makeError (declNamePos name) message where
             message = printf "'%s' is not a type." (declNameString name)
 
 compileType :: Desc -> TypeExpression -> Status TypeDesc
-compileType scope (TypeExpression n []) = do
-    desc <- lookupDesc scope n
-    descAsType n desc
-compileType scope (TypeExpression n (param:moreParams)) = do
+compileType scope (TypeExpression n params) = do
     desc <- lookupDesc scope n
     case desc of
-        DescBuiltinList ->
-            if null moreParams
-                then fmap ListType (compileType scope param)
-                else makeError (declNamePos n) "'List' requires exactly one type parameter."
-        DescBuiltinInline ->
-            if null moreParams
-                then do
-                    inner <- compileType scope param
-                    case inner of
-                        StructType s -> if structIsFixedWidth s
-                            then return (InlineStructType s)
-                            else makeError (declNamePos n) $
-                                printf "'%s' cannot be inlined because it is not fixed-width."
-                                       (structName s)
-                        _ -> makeError (declNamePos n) "'Inline' parameter must be a struct type."
-                else makeError (declNamePos n) "'Inline' requires exactly one type parameter."
-        _ -> makeError (declNamePos n) "Only the type 'List' can have type parameters."
+        DescBuiltinList -> case params of
+            [TypeParameterType param] -> fmap ListType (compileType scope param)
+            _ -> makeError (declNamePos n) "'List' requires exactly one type parameter."
+        DescBuiltinInline -> case params of
+            [TypeParameterType param] -> do
+                inner <- compileType scope param
+                case inner of
+                    StructType s -> if structIsFixedWidth s
+                        then return (InlineStructType s)
+                        else makeError (declNamePos n) $
+                            printf "'%s' cannot be inlined because it is not fixed-width."
+                                   (structName s)
+                    _ -> makeError (declNamePos n) "'Inline' parameter must be a struct type."
+            _ -> makeError (declNamePos n) "'Inline' requires exactly one type parameter."
+        DescBuiltinInlineList -> case params of
+            [TypeParameterType param, TypeParameterInteger size] -> do
+                inner <- compileType scope param
+                return $ InlineListType inner size
+            _ -> makeError (declNamePos n)
+                "'InlineList' requires exactly two type parameters: a type and a size."
+        _ -> case params of
+            [] -> descAsType n desc
+            _ -> makeError (declNamePos n) $
+                printf "'%s' doesn't take parameters." (declNameString n)
 
 compileAnnotation :: Desc -> AnnotationTarget -> Annotation
                   -> Status (Maybe AnnotationDesc, ValueDesc)

compiler/src/CxxGenerator.hs

@@ -91,6 +91,7 @@ isPrimitive (StructType _) = False
 isPrimitive (InlineStructType _) = False
 isPrimitive (InterfaceType _) = False
 isPrimitive (ListType _) = False
+isPrimitive (InlineListType _ _) = False
 
 isBlob (BuiltinType BuiltinText) = True
 isBlob (BuiltinType BuiltinData) = True
@@ -254,7 +255,7 @@ fieldContext parent desc = mkStrContext context where
         Nothing -> MuVariable ""
         Just v -> MuVariable (if isDefaultZero v then "" else ", " ++ defaultMask v)
     context "fieldElementSize" =
-        MuVariable $ cxxFieldSizeString $ elementSize $ elementType $ fieldType desc
+        MuVariable $ cxxFieldSizeString $ fieldSize $ elementType $ fieldType desc
     context "fieldElementType" =
         MuVariable $ cxxTypeString $ elementType $ fieldType desc
     context "fieldUnion" = case fieldUnion desc of

compiler/src/Grammar.hs

@@ -38,12 +38,19 @@ declNameImport (RelativeName _) = Nothing
 declNameImport (ImportName s) = Just s
 declNameImport (MemberName parent _) = declNameImport parent
 
-data TypeExpression = TypeExpression DeclName [TypeExpression]
+data TypeParameter = TypeParameterType TypeExpression
+                   | TypeParameterInteger Integer
+                   deriving (Show)
+data TypeExpression = TypeExpression DeclName [TypeParameter]
                     deriving (Show)
 
+typeParameterImports :: TypeParameter -> [Located String]
+typeParameterImports (TypeParameterType t) = typeImports t
+typeParameterImports (TypeParameterInteger _) = []
+
 typeImports :: TypeExpression -> [Located String]
 typeImports (TypeExpression name params) =
-    maybeToList (declNameImport name) ++ concatMap typeImports params
+    maybeToList (declNameImport name) ++ concatMap typeParameterImports params
 
 data Annotation = Annotation DeclName (Located FieldValue) deriving(Show)
 

compiler/src/Parser.hs

@@ -149,10 +149,14 @@ declName = do
     members <- many (period >> located anyIdentifier)
     return (foldl MemberName base members :: DeclName)
 
+typeParameter :: TokenParser TypeParameter
+typeParameter = liftM TypeParameterInteger literalInt
+            <|> liftM TypeParameterType typeExpression
+
 typeExpression :: TokenParser TypeExpression
 typeExpression = do
     name <- declName
-    suffixes <- option [] (parenthesizedList typeExpression)
+    suffixes <- option [] (parenthesizedList typeParameter)
     return (TypeExpression name suffixes)
 
 nameWithOrdinal :: TokenParser (Located String, Located Integer)

compiler/src/Semantics.hs

@@ -56,6 +56,7 @@ data Desc = DescFile FileDesc
           | DescBuiltinType BuiltinType
           | DescBuiltinList
           | DescBuiltinInline
+          | DescBuiltinInlineList
           | DescBuiltinId
 
 descName (DescFile      _) = "(top-level)"
@@ -73,6 +74,7 @@ descName (DescAnnotation d) = annotationName d
 descName (DescBuiltinType d) = builtinTypeName d
 descName DescBuiltinList = "List"
 descName DescBuiltinInline = "Inline"
+descName DescBuiltinInlineList = "InlineList"
 descName DescBuiltinId = "id"
 
 descId (DescFile      d) = fileId d
@@ -90,6 +92,7 @@ descId (DescAnnotation d) = annotationId d
 descId (DescBuiltinType _) = Nothing
 descId DescBuiltinList = Nothing
 descId DescBuiltinInline = Nothing
+descId DescBuiltinInlineList = Nothing
 descId DescBuiltinId = Just "0U0T3e_SnatEfk6UcH2tcjTt1E0"
 
 -- Gets the ID if explicitly defined, or generates it by appending ".name" to the parent's ID.
@@ -115,6 +118,7 @@ descParent (DescAnnotation d) = annotationParent d
 descParent (DescBuiltinType _) = error "Builtin type has no parent."
 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 DescBuiltinId = error "Builtin annotation has no parent."
 
 descFile (DescFile d) = d
@@ -135,6 +139,7 @@ descAnnotations (DescAnnotation d) = annotationAnnotations d
 descAnnotations (DescBuiltinType _) = Map.empty
 descAnnotations DescBuiltinList = Map.empty
 descAnnotations DescBuiltinInline = Map.empty
+descAnnotations DescBuiltinInlineList = Map.empty
 descAnnotations DescBuiltinId = Map.empty
 
 descRuntimeImports (DescFile      _) = error "Not to be called on files."
@@ -152,6 +157,7 @@ descRuntimeImports (DescAnnotation d) = annotationRuntimeImports d
 descRuntimeImports (DescBuiltinType _) = []
 descRuntimeImports DescBuiltinList = []
 descRuntimeImports DescBuiltinInline = []
+descRuntimeImports DescBuiltinInlineList = []
 descRuntimeImports DescBuiltinId = []
 
 type MemberMap = Map.Map String (Maybe Desc)
@@ -221,6 +227,7 @@ data TypeDesc = BuiltinType BuiltinType
               | InlineStructType StructDesc
               | InterfaceType InterfaceDesc
               | ListType TypeDesc
+              | InlineListType TypeDesc Integer
 
 typeRuntimeImports (BuiltinType _) = []
 typeRuntimeImports (EnumType d) = [descFile (DescEnum d)]
@@ -228,6 +235,7 @@ typeRuntimeImports (StructType d) = [descFile (DescStruct d)]
 typeRuntimeImports (InlineStructType d) = [descFile (DescStruct d)]
 typeRuntimeImports (InterfaceType d) = [descFile (DescInterface d)]
 typeRuntimeImports (ListType d) = typeRuntimeImports d
+typeRuntimeImports (InlineListType d _) = typeRuntimeImports d
 
 data DataSectionSize = DataSection1 | DataSection8 | DataSection16 | DataSection32
                      | DataSectionWords Integer
@@ -310,19 +318,24 @@ fieldSize (InlineStructType StructDesc { structDataSize = ds, structPointerCount
     SizeInlineComposite ds ps
 fieldSize (InterfaceType _) = SizeReference
 fieldSize (ListType _) = SizeReference
-
-elementSize (StructType StructDesc { structDataSize = DataSection1, structPointerCount = 0 }) =
-    SizeData Size1
-elementSize (StructType StructDesc { structDataSize = DataSection8, structPointerCount = 0 }) =
-    SizeData Size8
-elementSize (StructType StructDesc { structDataSize = DataSection16, structPointerCount = 0 }) =
-    SizeData Size16
-elementSize (StructType StructDesc { structDataSize = DataSection32, structPointerCount = 0 }) =
-    SizeData Size32
-elementSize (StructType StructDesc { structDataSize = ds, structPointerCount = pc }) =
-    SizeInlineComposite ds pc
-elementSize (InlineStructType s) = elementSize (StructType s)
-elementSize t = fieldSize t
+fieldSize (InlineListType element size) = let
+    minDataSectionForBits bits
+        | bits <= 1 = DataSection1
+        | bits <= 8 = DataSection8
+        | bits <= 16 = DataSection16
+        | bits <= 32 = DataSection32
+        | otherwise = DataSectionWords $ div (bits + 63) 64
+    dataSection = case fieldSize element of
+        SizeVoid -> DataSectionWords 0
+        SizeData s -> minDataSectionForBits $ dataSizeInBits s * size
+        SizeReference -> DataSectionWords 0
+        SizeInlineComposite ds _ -> minDataSectionForBits $ dataSectionBits ds
+    pointerCount = case fieldSize element of
+        SizeVoid -> 0
+        SizeData _ -> 0
+        SizeReference -> size
+        SizeInlineComposite _ pc -> pc
+    in SizeInlineComposite dataSection pointerCount
 
 -- Render the type descriptor's name as a string, appropriate for use in the given scope.
 typeName :: Desc -> TypeDesc -> String
@@ -332,6 +345,7 @@ typeName scope (StructType desc) = descQualifiedName scope (DescStruct desc)
 typeName scope (InlineStructType desc) = descQualifiedName scope (DescStruct desc)
 typeName scope (InterfaceType desc) = descQualifiedName scope (DescInterface desc)
 typeName scope (ListType t) = "List(" ++ typeName scope t ++ ")"
+typeName scope (InlineListType t s) = printf "InlineList(%s, %d)" (typeName scope t) s
 
 -- Computes the qualified name for the given descriptor within the given scope.
 -- At present the scope is only used to determine whether the target is in the same file.  If
@@ -589,6 +603,7 @@ descToCode indent self@(DescAnnotation desc) = printf "%sannotation %s: %s on(%s
 descToCode _ (DescBuiltinType _) = error "Can't print code for builtin type."
 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 _ DescBuiltinId = error "Can't print code for builtin annotation."
 
 maybeBlockCode :: String -> [Desc] -> String

compiler/src/c++-header.mustache

@@ -355,7 +355,7 @@ inline {{fieldType}}::Builder {{typeFullName}}::Builder::get{{fieldTitleCase}}()
 {{/fieldIsInlineStruct}}
 {{/fieldIsStruct}}
 {{! ------------------------------------------------------------------------------------------- }}
-{{#fieldIsList}}
+{{#fieldIsNonStructList}}
 inline {{fieldType}}::Reader {{typeFullName}}::Reader::get{{fieldTitleCase}}() {
 {{#fieldUnion}}
   CAPNPROTO_INLINE_DPRECOND(which() == {{unionTitleCase}}::{{fieldUpperCase}},
@@ -367,9 +367,7 @@ inline {{fieldType}}::Reader {{typeFullName}}::Reader::get{{fieldTitleCase}}() {
       {{#fieldDefaultBytes}}DEFAULT_{{fieldUpperCase}}.words{{/fieldDefaultBytes}}
       {{^fieldDefaultBytes}}nullptr{{/fieldDefaultBytes}}));
 }
-{{/fieldIsList}}
-{{! ------------------------------------------------------------------------------------------- }}
-{{#fieldIsNonStructList}}
+
 inline {{fieldType}}::Builder {{typeFullName}}::Builder::init{{fieldTitleCase}}(unsigned int size) {
 {{#fieldUnion}}
   _builder.setDataField<{{unionTitleCase}}::Which>(
@@ -423,6 +421,18 @@ inline void {{typeFullName}}::Builder::set{{fieldTitleCase}}(
 {{/fieldIsNonStructList}}
 {{! ------------------------------------------------------------------------------------------- }}
 {{#fieldIsStructList}}
+inline {{fieldType}}::Reader {{typeFullName}}::Reader::get{{fieldTitleCase}}() {
+{{#fieldUnion}}
+  CAPNPROTO_INLINE_DPRECOND(which() == {{unionTitleCase}}::{{fieldUpperCase}},
+                            "Must check which() before get()ing a union member.");
+{{/fieldUnion}}
+  return {{fieldType}}::Reader(_reader.getListField(
+      {{fieldOffset}} * ::capnproto::REFERENCES,
+      ::capnproto::internal::FieldSize::INLINE_COMPOSITE,
+      {{#fieldDefaultBytes}}DEFAULT_{{fieldUpperCase}}.words{{/fieldDefaultBytes}}
+      {{^fieldDefaultBytes}}nullptr{{/fieldDefaultBytes}}));
+}
+
 inline {{fieldType}}::Builder {{typeFullName}}::Builder::init{{fieldTitleCase}}(unsigned int size) {
 {{#fieldUnion}}
   _builder.setDataField<{{unionTitleCase}}::Which>(