Implement record literals
This commit is contained in:
parent
95d366ff40
commit
a8f0fc2caa
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
151
fco2/Parse.hs
151
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
|
||||
|
|
|
@ -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
|
||||
|
|
10
fco2/TODO
10
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
|
||||
|
|
|
@ -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
|
||||
|
|
33
fco2/testcases/record-literals.occ
Normal file
33
fco2/testcases/record-literals.occ
Normal file
|
@ -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)
|
||||
:
|
Loading…
Reference in New Issue
Block a user