diff --git a/fco2/AST.hs b/fco2/AST.hs index 64b93e3..6853ccc 100644 --- a/fco2/AST.hs +++ b/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 diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index adf144b..e4bdd30 100644 --- a/fco2/GenerateC.hs +++ b/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 ["[]"] - _ -> genDecl am t n - tell [" = "] - rhs - tell [";\n"] - rhsSizes n + tell ["[] = "] + rhs + tell [";\n"] + rhsSizes n + (A.ValAbbrev, A.Record _, A.Literal _ _ _) -> + -- 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 diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 9dd8e42..a3b727b 100644 --- a/fco2/Parse.hs +++ b/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. -listType :: Meta -> [A.Type] -> OccParser A.Type -listType m l = listType' m (length l) l +-- | Find the type of a table literal given the types of its components. +-- This'll always return an Array; the inner type will either be the type of +-- 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" - listType' m len [t] = return $ makeArrayType (A.Dimension len) t - listType' m len (t1 : rest@(t2 : _)) - = if t1 == t2 then listType' m len rest - else fail $ "multiple types in list: " ++ show t1 ++ " and " ++ show t2 + tableType' m len [t] = return $ makeArrayType (A.Dimension len) t + tableType' m len (t1 : rest@(t2 : _)) + = if t1 == t2 then tableType' m len rest + else return $ makeArrayType (A.Dimension len) A.Any + 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? -isValidLiteralType :: A.Type -> A.Type -> OccParser Bool -isValidLiteralType defT' realT' - = do realT <- underlyingType realT' - defT <- underlyingType defT' - case (defT, realT) of - (A.Real32, _) -> return $ isRealType realT - (A.Int, _) -> return $ isIntegerType realT - (A.Byte, _) -> return $ isIntegerType realT +-- | Can a literal of type rawT be used as a value of type wantT? +isValidLiteralType :: Meta -> A.Type -> A.Type -> OccParser Bool +isValidLiteralType m rawT wantT + = do case (rawT, wantT) of + -- We don't yet know what type we want -- so assume it's OK for now. + (_, A.Any) -> return True + (A.Real32, _) -> return $ isRealType wantT + (A.Int, _) -> return $ isIntegerType wantT + (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 ++ ")" - return $ A.Literal m (applyDimensions t wantT) lr + dieP m $ "default type of literal (" ++ show t ++ ") cannot be coerced to desired type (" ++ show wantT ++ ")" + + 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 defType +typeDecorator :: OccParser (Maybe A.Type) +typeDecorator = do sLeftR t <- dataType sRightR - return t - <|> return defType + return $ Just t + <|> return Nothing "literal type decorator" literal :: OccParser A.Expression literal = do m <- md (lr, t) <- untypedLiteral - wantT <- getTypeContext t >>= typeDecorator - makeLiteral (A.Literal m t lr) wantT + dec <- typeDecorator + 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 - makeLiteral e wantT + ctx <- getTypeContext + case ctx of + Just wantT -> makeLiteral e wantT + _ -> return e table' :: OccParser A.Expression table' = do m <- md (lr, t) <- tableElems - wantT <- typeDecorator t - makeLiteral (A.Literal m t lr) wantT + dec <- typeDecorator + 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 - lr <- liftM (A.ArrayLiteral m) $ mapM collapseArrayElem es - return (lr, defT) + defT <- tableType m ets + return (A.ArrayLiteral m (map A.ArrayElemExpr es), 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 diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 6d455ae..fdb92ae 100644 --- a/fco2/ParseState.hs +++ b/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). -getTypeContext :: PSM m => A.Type -> m A.Type -getTypeContext def +-- | Get the current type context, if there is one. +getTypeContext :: PSM m => m (Maybe A.Type) +getTypeContext = do ps <- get case psTypeContext ps of - (Just c):_ -> return c - _ -> return def + (Just c):_ -> return $ Just c + _ -> return Nothing --}}} --{{{ nonces diff --git a/fco2/TODO b/fco2/TODO index 79a6688..f219387 100644 --- a/fco2/TODO +++ b/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 diff --git a/fco2/Types.hs b/fco2/Types.hs index cd16ae8..449c08c 100644 --- a/fco2/Types.hs +++ b/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. -typeOfRecordField :: (PSM m, Die m) => Meta -> A.Type -> A.Name -> m A.Type -typeOfRecordField m (A.Record rec) field +-- | Get the fields of a record type. +recordFields :: (PSM m, Die m) => Meta -> A.Type -> m [(A.Name, A.Type)] +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 diff --git a/fco2/testcases/record-literals.occ b/fco2/testcases/record-literals.occ new file mode 100644 index 0000000..9b8dbfb --- /dev/null +++ b/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) +: