Implement record literals

This commit is contained in:
Adam Sampson 2007-05-05 00:26:26 +00:00
parent 95d366ff40
commit a8f0fc2caa
7 changed files with 182 additions and 71 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View 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)
: