Implement record literals

fco2/AST.hs

@@ -83,6 +83,7 @@ data LiteralRepr =
   | HexLiteral Meta String
   | ByteLiteral Meta String
   | ArrayLiteral Meta [ArrayElem]
+  | RecordLiteral Meta [Expression]
   deriving (Show, Eq, Typeable, Data)
 
 -- | An item inside an array literal -- which might be an expression, or might

fco2/GenerateC.hs

@@ -306,6 +306,10 @@ genLiteralRepr (A.ArrayLiteral m aes)
     =  do tell ["{"]
           genArrayLiteralElems aes
           tell ["}"]
+genLiteralRepr (A.RecordLiteral m es)
+    =  do tell ["{"]
+          sequence_ $ intersperse genComma $ map genExpression es
+          tell ["}"]
 
 -- | Generate a decimal literal -- removing leading zeroes to avoid producing
 -- an octal literal!
@@ -951,12 +955,28 @@ introduceSpec (A.Specification _ n (A.IsExpr _ am t e))
                  genType ts
                  tell [" "]
                  genName n
-                 tell ["[]"]
+                 tell ["[] = "]
-            _ -> genDecl am t n
+                 rhs
-          tell [" = "]
+                 tell [";\n"]
-          rhs
+                 rhsSizes n
-          tell [";\n"]
+            (A.ValAbbrev, A.Record _, A.Literal _ _ _) ->
-          rhsSizes n
+              -- Record literals are even trickier, because there's no way of
+              -- directly writing a struct literal in C that you can use -> on.
+              do tmp <- makeNonce "record_literal"
+                 tell ["const "]
+                 genType t
+                 tell [" ", tmp, " = "]
+                 rhs
+                 tell [";\n"]
+                 genDecl am t n
+                 tell [" = &", tmp, ";\n"]
+                 rhsSizes n
+            _ ->
+              do genDecl am t n
+                 tell [" = "]
+                 rhs
+                 tell [";\n"]
+                 rhsSizes n
 introduceSpec (A.Specification _ n (A.IsChannelArray _ t cs))
     =  do tell ["Channel *"]
           genName n

fco2/Parse.hs

@@ -437,15 +437,19 @@ intersperseP (f:fs) sep
           as <- intersperseP fs sep
           return $ a : as
 
--- | Check that all items in a list have the same type.
+-- | Find the type of a table literal given the types of its components.
-listType :: Meta -> [A.Type] -> OccParser A.Type
+-- This'll always return an Array; the inner type will either be the type of
-listType m l = listType' m (length l) l
+-- the elements if they're all the same (in which case it's either an array
+-- literal, or a record where all the fields are the same type), or Any if
+-- they're not (i.e. if it's a record literal or an empty array).
+tableType :: Meta -> [A.Type] -> OccParser A.Type
+tableType m l = tableType' m (length l) l
   where
-    listType' m len [] = fail "expected non-empty list"
+    tableType' m len [t] = return $ makeArrayType (A.Dimension len) t
-    listType' m len [t] = return $ makeArrayType (A.Dimension len) t
+    tableType' m len (t1 : rest@(t2 : _))
-    listType' m len (t1 : rest@(t2 : _))
+        = if t1 == t2 then tableType' m len rest
-        = if t1 == t2 then listType' m len rest
+                      else return $ makeArrayType (A.Dimension len) A.Any
-                      else fail $ "multiple types in list: " ++ show t1 ++ " and " ++ show t2
+    tableType' m len [] = return $ makeArrayType (A.Dimension 0) A.Any
 
 -- | Check that the second second of dimensions can be used in a context where
 -- the first is expected.
@@ -660,28 +664,26 @@ portType
 --}}}
 --{{{ literals
 --{{{ type utilities for literals
--- | Can a literal of type defT be used for a value type t?
+-- | Can a literal of type rawT be used as a value of type wantT?
-isValidLiteralType :: A.Type -> A.Type -> OccParser Bool
+isValidLiteralType :: Meta -> A.Type -> A.Type -> OccParser Bool
-isValidLiteralType defT' realT'
+isValidLiteralType m rawT wantT
-    =  do realT <- underlyingType realT'
+    =  do case (rawT, wantT) of
-          defT <- underlyingType defT'
+            -- We don't yet know what type we want -- so assume it's OK for now.
-          case (defT, realT) of
+            (_, A.Any) -> return True
-            (A.Real32, _) -> return $ isRealType realT
+            (A.Real32, _) -> return $ isRealType wantT
-            (A.Int, _) -> return $ isIntegerType realT
+            (A.Int, _) -> return $ isIntegerType wantT
-            (A.Byte, _) -> return $ isIntegerType realT
+            (A.Byte, _) -> return $ isIntegerType wantT
+            (A.Array [A.Dimension nf] _, A.Record _) ->
+              -- We can't be sure without looking at the literal itself,
+              -- so we need to do that below.
+              do fs <- recordFields m wantT
+                 return $ nf == length fs
             (A.Array ds1 t1, A.Array ds2 t2) ->
               if areValidDimensions ds2 ds1
-                then isValidLiteralType t1 t2
+                then isValidLiteralType m t1 t2
                 else return False
             (a, b) -> return $ a == b
 
-checkValidLiteralType :: A.Type -> A.Type -> OccParser ()
-checkValidLiteralType defT t
-    =  do isValid <- isValidLiteralType defT t
-          ps <- get
-          when (not isValid) $
-            fail $ "type given/inferred for literal (" ++ show t ++ ") is not valid for this sort of literal (" ++ show defT ++ ")"
-
 -- | Apply dimensions from one type to another as far as possible.
 -- This should only be used when you know the two types are compatible first
 -- (i.e. they've passed isValidLiteralType).
@@ -696,36 +698,82 @@ applyDimensions (A.Array ods _) (A.Array tds t) = A.Array (dims ods tds) t
     dims _ ds = ds
 applyDimensions _ t = t
 
--- | Given a "raw" literal and the type that it should be, either produce a
+-- | Convert a raw array element literal into its real form.
+makeArrayElem :: A.Type -> A.ArrayElem -> OccParser A.ArrayElem
+makeArrayElem t@(A.Array _ _) (A.ArrayElemArray aes)
+    =  do elemT <- trivialSubscriptType t
+          liftM A.ArrayElemArray $ mapM (makeArrayElem elemT) aes
+makeArrayElem _ (A.ArrayElemArray _)
+    = fail $ "unexpected nested array literal"
+-- A nested array literal that's still of array type (i.e. it's not a
+-- record inside the array) -- collapse it.
+makeArrayElem t@(A.Array _ _) (A.ArrayElemExpr (A.Literal _ _ (A.ArrayLiteral _ aes)))
+    =  do elemT <- trivialSubscriptType t
+          liftM A.ArrayElemArray $ mapM (makeArrayElem elemT) aes
+makeArrayElem t (A.ArrayElemExpr e)
+    = liftM A.ArrayElemExpr $ makeLiteral e t
+
+-- | Given a raw literal and the type that it should be, either produce a
 -- literal of that type, or fail with an appropriate error if it's not a valid
 -- value of that type.
 makeLiteral :: A.Expression -> A.Type -> OccParser A.Expression
+-- A literal.
 makeLiteral (A.Literal m t lr) wantT
-    =  do typesOK <- isValidLiteralType t wantT
+    =  do underT <- underlyingType wantT
+
+          typesOK <- isValidLiteralType m t underT
           when (not typesOK) $
-            fail $ "default type of literal (" ++ show t ++ ") cannot be coerced to desired type (" ++ show wantT ++ ")"
+            dieP m $ "default type of literal (" ++ show t ++ ") cannot be coerced to desired type (" ++ show wantT ++ ")"
-          return $ A.Literal m (applyDimensions t wantT) lr
+
+          case trace ("** makeLiteral " ++ show wantT ++ ", " ++ show t) (underT, lr) of
+            -- An array literal.
+            (A.Array _ _, A.ArrayLiteral ml aes) ->
+              do elemT <- trivialSubscriptType underT
+                 aes' <- mapM (makeArrayElem elemT) aes
+                 return $ A.Literal m (applyDimensions t wantT) (A.ArrayLiteral ml aes')
+            -- A record literal -- which we need to convert from the raw
+            -- representation.
+            (A.Record _, A.ArrayLiteral ml aes)  ->
+              do fs <- recordFields m underT
+                 es <- sequence [makeLiteral e t
+                                 | ((_, t), A.ArrayElemExpr e) <- zip fs aes]
+                 return $ A.Literal m wantT (A.RecordLiteral ml es)
+            -- Some other kind of literal (one of the trivial types).
+            _ -> return $ A.Literal m wantT lr
+-- A subscript; figure out what the type of the thing being subscripted must be
+-- and recurse.
 makeLiteral (A.SubscriptedExpr m sub e) wantT
     =  do inWantT <- unsubscriptType sub wantT
           e' <- makeLiteral e inWantT
           return $ A.SubscriptedExpr m sub e'
+-- Something that's not a literal (which we've found inside a table) -- just
+-- check it's the right type.
+makeLiteral e wantT
+    =  do t <- typeOfExpression e
+          matchType wantT t
+          return e
 --}}}
 
-typeDecorator :: A.Type -> OccParser A.Type
+typeDecorator :: OccParser (Maybe A.Type)
-typeDecorator defType
+typeDecorator
     =   do sLeftR
            t <- dataType
            sRightR
-           return t
+           return $ Just t
-    <|> return defType
+    <|> return Nothing
     <?> "literal type decorator"
 
 literal :: OccParser A.Expression
 literal
     =  do m <- md
           (lr, t) <- untypedLiteral
-          wantT <- getTypeContext t >>= typeDecorator
+          dec <- typeDecorator
-          makeLiteral (A.Literal m t lr) wantT
+          ctx <- getTypeContext
+          let lit = A.Literal m t lr
+          case (dec, ctx) of
+            (Just wantT, _) -> makeLiteral lit wantT
+            (_, Just wantT) -> makeLiteral lit wantT
+            _ -> return lit
     <?> "literal"
 
 untypedLiteral :: OccParser (A.LiteralRepr, A.Type)
@@ -778,19 +826,26 @@ byte
 -- (The implication of this is that the type of the expression this parses
 -- isn't necessarily an array type -- it might be something like
 -- @[1, 2, 3][1]@.)
+-- The expression this returns cannot be used directly; it doesn't have array
+-- literals collapsed, and record literals are array literals of type []ANY.
 table :: OccParser A.Expression
 table
     =   do e <- maybeSubscripted "table" table' A.SubscriptedExpr typeOfExpression
            rawT <- typeOfExpression e
-           wantT <- getTypeContext rawT
+           ctx <- getTypeContext
-           makeLiteral e wantT
+           case ctx of
+             Just wantT -> makeLiteral e wantT
+             _ -> return e
 
 table' :: OccParser A.Expression
 table'
     =   do m <- md
            (lr, t) <- tableElems
-           wantT <- typeDecorator t
+           dec <- typeDecorator
-           makeLiteral (A.Literal m t lr) wantT
+           let lit = A.Literal m t lr
+           case dec of
+             Just wantT -> makeLiteral lit wantT
+             _ -> return lit
     <|> maybeSliced table A.SubscriptedExpr typeOfExpression
     <?> "table'"
 
@@ -801,19 +856,10 @@ tableElems
     <|> do m <- md
            es <- tryXVX sLeft (noTypeContext $ sepBy1 expression sComma) sRight
            ets <- mapM typeOfExpression es
-           defT <- listType m ets
+           defT <- tableType m ets
-           lr <- liftM (A.ArrayLiteral m) $ mapM collapseArrayElem es
+           return (A.ArrayLiteral m (map A.ArrayElemExpr es), defT)
-           return (lr, defT)
     <?> "table elements"
 
--- | Collapse nested array literals.
-collapseArrayElem :: A.Expression -> OccParser A.ArrayElem
-collapseArrayElem e
-    = case e of
-        A.Literal _ _ (A.ArrayLiteral _ subAEs) ->
-          return $ A.ArrayElemArray subAEs
-        _ -> return $ A.ArrayElemExpr e
-
 stringLiteral :: OccParser (A.LiteralRepr, A.Dimension)
 stringLiteral
     =  do m <- md
@@ -1295,7 +1341,10 @@ chanArrayAbbrev
            sColon
            eol
            ts <- mapM typeOfVariable cs
-           t <- listType m ts
+           t <- tableType m ts
+           case t of
+             (A.Array _ (A.Chan _)) -> return ()
+             _ -> fail $ "types do not match in channel array abbreviation"
            return $ A.Specification m n $ A.IsChannelArray m t cs
     <|> do m <- md
            (ct, s, n) <- try (do s <- channelSpecifier

fco2/ParseState.hs

@@ -136,13 +136,13 @@ popTypeContext :: PSM m => m ()
 popTypeContext
     = modify (\ps -> ps { psTypeContext = tail $ psTypeContext ps })
 
--- | Get the current type context (or the given default value if there isn't one).
+-- | Get the current type context, if there is one.
-getTypeContext :: PSM m => A.Type -> m A.Type
+getTypeContext :: PSM m => m (Maybe A.Type)
-getTypeContext def
+getTypeContext
     =  do ps <- get
           case psTypeContext ps of
-            (Just c):_ -> return c
+            (Just c):_ -> return $ Just c
-            _ -> return def
+            _ -> return Nothing
 --}}}
 
 --{{{ nonces

fco2/TODO

@@ -25,8 +25,6 @@ Add an option for whether to compile out overflow/bounds checks.
 
 ## Parser
 
-Record literals aren't implemented.
-
 ## Passes
 
 Come up with an approach to combining simple passes to avoid multiple tree
@@ -69,8 +67,6 @@ to be a bad idea for very large counts (since I assume it'll allocate off the
 stack). We should probably do a malloc if it's not determinable at compile
 time.
 
-Real-to-integer conversions don't work correctly.
-
 Slice checks should not be generated if the slice is known to be safe.
 
 PLACE should work.
@@ -82,6 +78,12 @@ the pullup:
   c ? index; [array FROM index]
 (Tested in cgtest12.)
 
+## tock_support
+
+No overflow checking is done on most operations.
+
+Real-to-integer conversions don't work correctly.
+
 ## Long-term
 
 If we have constant folding, we're three-quarters of the way towards having an

fco2/Types.hs

@@ -59,14 +59,20 @@ sliceType m base count (A.Array (d:ds) t)
         (False, False) -> return $ A.Array (A.UnknownDimension : ds) t
 sliceType m _ _ _ = dieP m "slice of non-array type"
 
--- | Get the type of a record field.
+-- | Get the fields of a record type.
-typeOfRecordField :: (PSM m, Die m) => Meta -> A.Type -> A.Name -> m A.Type
+recordFields :: (PSM m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)]
-typeOfRecordField m (A.Record rec) field
+recordFields m (A.Record rec)
     =  do st <- specTypeOfName rec
           case st of
-            A.RecordType _ _ fs -> checkJust "unknown record field" $ lookup field fs
+            A.RecordType _ _ fs -> return fs
             _ -> dieP m "not record type"
-typeOfRecordField m _ _ = dieP m "not record type"
+recordFields m _ = dieP m "not record type"
+
+-- | Get the type of a record field.
+typeOfRecordField :: (PSM m, Die m) => Meta -> A.Type -> A.Name -> m A.Type
+typeOfRecordField m t field
+    =  do fs <- recordFields m t
+          checkJust "unknown record field" $ lookup field fs
 
 -- | Apply a plain subscript to a type.
 plainSubscriptType :: (PSM m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type

fco2/testcases/record-literals.occ

@@ -0,0 +1,33 @@
+-- Need to test that list literals inside record literals are not collapsed.
+
+DATA TYPE ONE
+  RECORD
+    INT i:
+:
+DATA TYPE DIFF
+  RECORD
+    INT i:
+    BYTE b:
+    REAL32 r:
+:
+DATA TYPE SAME
+  RECORD
+    INT x:
+    INT y:
+    INT z:
+:
+PROC P ()
+  VAL INT x IS 42:
+  VAL ONE one IS [42]:
+  VAL DIFF diff IS [42, '**', 3.141]:
+  VAL SAME same IS [42, 43, 44]:
+  SEQ
+    ASSERT (one[i] = 42)
+    ASSERT (diff[i] = 42)
+    ASSERT (diff[b] = 42)
+    ASSERT (diff[r] > 3.1)
+    ASSERT (diff[r] < 3.2)
+    ASSERT (same[x] = 42)
+    ASSERT (same[y] = 43)
+    ASSERT (same[z] = 44)
+: