suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Work towards getting arrays working -- needs a cleanup, though

Browse Source
This commit is contained in:
Adam Sampson 2007-04-11 17:08:16 +00:00
parent e6cf94c60e
commit 74efa43389
6 changed files with 220 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
fco2/AST.hs
View File

@ -33,8 +33,7 @@ data Type =
| Byte
| Int | Int16 | Int32 | Int64
| Real32 | Real64
| Array Expression Type
| ArrayUnsized Type
| Array [Dimension] Type
| UserDataType Name
| UserProtocol Name
| Chan Type
@ -44,6 +43,11 @@ data Type =
| Port Type
deriving (Show, Eq, Typeable, Data)
data Dimension =
Dimension Expression
| UnknownDimension
deriving (Show, Eq, Typeable, Data)
data ConversionMode =
DefaultConversion
| Round
@ -183,6 +187,7 @@ data SpecType =
| Is Meta AbbrevMode Type Variable
| IsExpr Meta AbbrevMode Type Expression
| IsChannel Meta Type Channel
-- FIXME Can these be multidimensional?
| IsChannelArray Meta Type [Channel]
| DataType Meta Type
| DataTypeRecord Meta Bool [(Type, Name)]

164
fco2/GenerateC.hs
View File

@ -7,9 +7,6 @@ module GenerateC where
-- FIXME: Checks should be done in the parser, not here -- for example, the
-- expressionList production should take an argument with a list of types.
-- FIXME: Arrays should support multiple dimensions (and never be nested).
-- AST should have A.Array [Expression] Type.
-- FIXME: The show instance for types should produce occam-looking types.
-- FIXME: Should have a "current type context" in the parser, so that
@ -20,6 +17,12 @@ module GenerateC where
-- FIXME: Should have a pass that converts functions to procs, and calls to a
-- call outside the enclosing process (which can be found by a generic pass
-- over the tree).
-- Array constants need pulling up at the same time (might as well avoid
-- walking the tree twice!).
-- And slices. Subscripts generally?
-- FIXME: The timer read mess can be cleaned up -- when you declare a timer,
-- that declares the temp variable...
import Data.List
import Data.Maybe
@ -87,14 +90,9 @@ scalarType A.Real64 = Just "double"
scalarType _ = Nothing
genType :: A.Type -> CGen ()
genType (A.Array e t)
genType (A.Array _ t)
= do genType t
tell ["["]
genExpression e
tell ["]"]
genType (A.ArrayUnsized t)
= do genType t
tell ["[]"]
tell ["*"]
genType (A.UserDataType n) = genName n
genType (A.Chan t) = tell ["Channel *"]
genType t
@ -110,10 +108,6 @@ genDeclType am t
A.ValAbbrev -> tell ["const "]
_ -> return ()
genType t
case (am, t) of
(_, A.Chan _) -> return ()
(A.Abbrev, _) -> tell ["*"]
_ -> return ()
genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen ()
genDecl am t n
@ -179,12 +173,12 @@ convStringStar c = [c]
--{{{ channels, variables
{-
FIXME All this stuff will change once we do arrays properly...
Channel c; -> &c \ Original
Channel c[10]; -> &c[i] /
Channel *c; -> c \ Abbrev
Channel **c; -> c[i] /
But if I say genChannel on cs, then I want cs back either way, not &cs...
-}
genChannel :: A.Channel -> CGen ()
genChannel (A.Channel m n)
@ -200,19 +194,21 @@ genChannel (A.SubscriptedChannel m s c) = genSubscript s (genChannel c)
int x; -> x \ Original, ValAbbrev
int x[10]; -> x[i] /
int *x; -> (*x) \ Abbrev
int **x; -> (*x)[i] /
int **x; -> x[i] /
-}
genVariable :: A.Variable -> CGen ()
genVariable (A.Variable m n)
= do ps <- get
am <- checkJust $ abbrevModeOfName ps n
case am of
A.Abbrev -> tell ["(*"]
_ -> return ()
genName n
case am of
A.Abbrev -> tell [")"]
_ -> return ()
t <- checkJust $ typeOfName ps n
let doName = genName n
case (am, t) of
(_, A.Array _ _) -> doName
(A.Abbrev, _) ->
do tell ["(*"]
doName
tell [")"]
_ -> doName
genVariable (A.SubscriptedVariable m s v) = genSubscript s (genVariable v)
--}}}
@ -257,8 +253,9 @@ genMonadic :: A.MonadicOp -> A.Expression -> CGen ()
genMonadic A.MonadicSubtr e = genSimpleMonadic "-" e
genMonadic A.MonadicBitNot e = genSimpleMonadic "~" e
genMonadic A.MonadicNot e = genSimpleMonadic "!" e
--genMonadic A.MonadicSize e
genMonadic op e = missing $ "genMonadic " ++ show op
genMonadic A.MonadicSize e
= do genExpression e
tell ["_sizes[0]"]
genSimpleDyadic :: String -> A.Expression -> A.Expression -> CGen ()
genSimpleDyadic s e f
@ -406,26 +403,80 @@ introduceSpec (n, A.Declaration m t)
tell ["ChanInit (&"]
genName n
tell [");\n"]
A.Array ds t ->
do genType t
tell [" "]
genName n
sequence_ $ map (\d -> case d of
A.Dimension e ->
do tell ["["]
genExpression e
tell ["]"]
A.UnknownDimension ->
missing "unknown dimension in declaration") ds
tell [";\n"]
tell ["const int "]
genName n
tell ["_sizes[] = { "]
sequence_ $ intersperse genComma [genExpression e | (A.Dimension e) <- ds]
tell [" };\n"]
_ ->
do genDeclType A.Original t
do genType t
tell [" "]
genName n
tell [";\n"]
{-
Original Abbrev
INT x IS y: int *x = &y; int *x = &(*y);
[]INT xs IS ys: int *xs = ys; int *xs = ys;
const int xs_sizes[] = ys_sizes;
-}
introduceSpec (n, A.Is m am t v)
= do genDecl am t n
tell [" = &"]
genVariable v
tell [";\n"]
= case t of
A.Array _ _ ->
do genDecl am t n
tell [" = "]
let name = case v of A.Variable _ name -> name
genName name
tell [";\n"]
tell ["const int "]
genName n
tell ["_sizes[] = "]
genName name
tell ["_sizes;\n"]
_ ->
do genDecl am t n
tell [" = &"]
genVariable v
tell [";\n"]
introduceSpec (n, A.IsExpr m am t e)
= do genDecl am t n
tell [" = "]
genExpression e
tell [";\n"]
{-
CHAN OF INT c IS d: Channel *c = d;
[]CHAN OF INT cs IS ds: Channel **cs = ds;
const int cs_sizes[] = ds_sizes;
-}
introduceSpec (n, A.IsChannel m t c)
= do genDecl A.Abbrev t n
tell [" = "]
genChannel c
tell [";\n"]
= case t of
A.Array _ _ ->
do genDecl A.Abbrev t n
tell [" = "]
let name = case c of A.Channel _ name -> name
genName name
tell [";\n"]
tell ["const int "]
genName n
tell ["_sizes[] = "]
genName name
tell ["_sizes;\n"]
_ ->
do genDecl A.Abbrev t n
tell [" = "]
genChannel c
tell [";\n"]
introduceSpec (n, A.IsChannelArray m t cs)
= do genDecl A.Abbrev t n
tell [" = {"]
@ -451,21 +502,48 @@ genActuals :: [A.Actual] -> CGen ()
genActuals as = sequence_ $ intersperse genComma (map genActual as)
genActual :: A.Actual -> CGen ()
genActual (A.ActualExpression e) = genExpression e
genActual (A.ActualChannel c) = genChannel c
-- FIXME Handle expressions that return arrays
genActual (A.ActualExpression e)
= do ps <- get
t <- checkJust $ typeOfExpression ps e
case t of
(A.Array _ t') -> missing "array expression actual"
_ -> genExpression e
genActual (A.ActualChannel c)
= do ps <- get
t <- checkJust $ typeOfChannel ps c
case t of
(A.Array _ t') ->
do genChannel c
tell [", "]
genChannel c
tell ["_sizes"]
_ -> genChannel c
genActual (A.ActualVariable v)
= do tell ["&"]
genVariable v
= do ps <- get
t <- checkJust $ typeOfVariable ps v
case t of
(A.Array _ t') ->
do genVariable v
tell [", "]
genVariable v
tell ["_sizes"]
_ ->
do tell ["&"]
genVariable v
genFormals :: [A.Formal] -> CGen ()
genFormals fs = sequence_ $ intersperse genComma (map genFormal fs)
-- Arrays must be handled specially
genFormal :: A.Formal -> CGen ()
genFormal (A.Formal am t n)
= do genDeclType am t
tell [" "]
genName n
= case t of
(A.Array _ t) ->
do genDecl am t n
tell ["[], const int "]
genName n
tell ["_sizes[]"]
_ -> genDecl am t n
--}}}
--{{{ par modes

32
fco2/Parse.hs
View File

@ -294,15 +294,19 @@ tryTrail p q = try (do { v <- p; q; return v })
listType :: [A.Type] -> OccParser A.Type
listType [] = fail "expected non-empty list"
listType [t] = return $ A.ArrayUnsized t
listType [t] = return $ makeArrayType A.UnknownDimension t
listType (t1 : rest@(t2 : _))
= if t1 == t2 then listType rest
else fail "multiple types in list"
matchType :: A.Type -> A.Type -> OccParser ()
matchType et rt
= if rt == et then return ()
else fail $ "type mismatch (got " ++ show rt ++ "; expected " ++ show et ++ ")"
= case (et, rt) of
((A.Array ds t), (A.Array ds' t')) ->
if length ds == length ds' then return () else bad
_ -> if rt == et then return () else bad
where
bad = fail $ "type mismatch (got " ++ show rt ++ "; expected " ++ show et ++ ")"
checkMaybe :: String -> Maybe a -> OccParser a
checkMaybe msg op
@ -449,7 +453,7 @@ dataType
<|> do { sINT64; return A.Int64 }
<|> do { sREAL32; return A.Real32 }
<|> do { sREAL64; return A.Real64 }
<|> try (do { sLeft; s <- expression; sRight; t <- dataType; return $ A.Array s t })
<|> try (do { sLeft; s <- expression; sRight; t <- dataType; return $ makeArrayType (A.Dimension s) t })
<|> do { n <- dataTypeName; return $ A.UserDataType n }
<?> "dataType"
@ -457,19 +461,19 @@ dataType
channelType :: OccParser A.Type
channelType
= do { sCHAN; sOF; p <- protocol; return $ A.Chan p }
<|> try (do { sLeft; s <- expression; sRight; t <- channelType; return $ A.Array s t })
<|> try (do { sLeft; s <- expression; sRight; t <- channelType; return $ makeArrayType (A.Dimension s) t })
<?> "channelType"
timerType :: OccParser A.Type
timerType
= do { sTIMER; return $ A.Timer }
<|> try (do { sLeft; s <- expression; sRight; t <- timerType; return $ A.Array s t })
<|> try (do { sLeft; s <- expression; sRight; t <- timerType; return $ makeArrayType (A.Dimension s) t })
<?> "timerType"
portType :: OccParser A.Type
portType
= do { sPORT; sOF; p <- dataType; return $ A.Port p }
<|> do { m <- md; try sLeft; s <- try expression; try sRight; t <- portType; return $ A.Array s t }
<|> do { m <- md; try sLeft; s <- try expression; try sRight; t <- portType; return $ makeArrayType (A.Dimension s) t }
<?> "portType"
--}}}
--{{{ literals
@ -525,10 +529,12 @@ table :: OccParser A.Literal
table
= maybeSubscripted "table" table' A.SubscriptedLiteral
-- FIXME This should put the sizes into the types, since it knows them and
-- we'll need them when generating code.
table' :: OccParser A.Literal
table'
= try (do { m <- md; s <- stringLiteral; sLeftR; t <- dataType; sRightR; return $ A.Literal m t s })
<|> try (do { m <- md; s <- stringLiteral; return $ A.Literal m (A.ArrayUnsized A.Byte) s })
<|> try (do { m <- md; s <- stringLiteral; return $ A.Literal m (A.Array [A.UnknownDimension] A.Byte) s })
<|> do m <- md
es <- tryTrail (do { sLeft; sepBy1 expression sComma }) sRight
ps <- getState
@ -808,7 +814,7 @@ definition
dataSpecifier :: OccParser A.Type
dataSpecifier
= try dataType
<|> try (do { sLeft; sRight; s <- dataSpecifier; return $ A.ArrayUnsized s })
<|> try (do { sLeft; sRight; s <- dataSpecifier; return $ makeArrayType A.UnknownDimension s })
<?> "dataSpecifier"
specifier :: OccParser A.Type
@ -817,7 +823,7 @@ specifier
<|> try channelType
<|> try timerType
<|> try portType
<|> try (do { sLeft; sRight; s <- specifier; return $ A.ArrayUnsized s })
<|> try (do { sLeft; sRight; s <- specifier; return $ makeArrayType A.UnknownDimension s })
<?> "specifier"
--{{{ PROCs and FUNCTIONs
@ -1202,9 +1208,9 @@ actual :: A.Formal -> OccParser A.Actual
actual (A.Formal am t n)
= do case am of
A.ValAbbrev -> do { e <- expression; et <- pTypeOfExpression e; matchType t et; return $ A.ActualExpression e } <?> "actual expression for " ++ an
_ -> case t of
A.Chan _ -> do { c <- channel; ct <- pTypeOfChannel c; matchType t ct; return $ A.ActualChannel c } <?> "actual channel for " ++ an
_ -> do { v <- variable; vt <- pTypeOfVariable v; matchType t vt; return $ A.ActualVariable v } <?> "actual variable for " ++ an
_ -> if isChannelType t
then do { c <- channel; ct <- pTypeOfChannel c; matchType t ct; return $ A.ActualChannel c } <?> "actual channel for " ++ an
else do { v <- variable; vt <- pTypeOfVariable v; matchType t vt; return $ A.ActualVariable v } <?> "actual variable for " ++ an
where
an = A.nameName n
--}}}

21
fco2/Types.hs
View File

@ -36,15 +36,15 @@ typeOfName ps n
Just (A.Is m am t v) -> typeOfVariable ps v
Just (A.IsExpr m am t e) -> typeOfExpression ps e
Just (A.IsChannel m t c) -> typeOfChannel ps c
Just (A.IsChannelArray m t (c:_)) -> typeOfChannel ps c `perhaps` A.ArrayUnsized
Just (A.IsChannelArray m t (c:_)) -> typeOfChannel ps c `perhaps` A.Array [A.UnknownDimension]
Just (A.Retypes m am t v) -> Just t
Just (A.RetypesExpr m am t e) -> Just t
_ -> Nothing
-- FIXME: This should fail if the subscript is invalid...
subscriptType :: A.Type -> Maybe A.Type
subscriptType (A.Array e t) = Just t
subscriptType (A.ArrayUnsized t) = Just t
subscriptType (A.Array [_] t) = Just t
subscriptType (A.Array (_:ds) t) = Just $ A.Array ds t
subscriptType _ = Nothing
typeOfChannel :: ParseState -> A.Channel -> Maybe A.Type
@ -109,9 +109,14 @@ abbrevModeOfSpec s
A.RetypesExpr _ am _ _ -> am
_ -> A.Original
isArrayType :: ParseState -> A.Type -> Bool
isArrayType ps (A.Array _ _) = True
isArrayType ps (A.ArrayUnsized _) = True
-- FIXME Should handle user data types
isArrayType _ _ = False
-- | Add an array dimension to a type; if it's already an array it'll just add
-- a new dimension to the existing array.
makeArrayType :: A.Dimension -> A.Type -> A.Type
makeArrayType d (A.Array ds t) = A.Array (d : ds) t
makeArrayType d t = A.Array [d] t
isChannelType :: A.Type -> Bool
isChannelType (A.Array _ t) = isChannelType t
isChannelType (A.Chan _) = True
isChannelType _ = False

10
fco2/testcases/actuals.occ
View File

@ -1,12 +1,12 @@
-- FIXME This should check arrays too.
PROC O (VAL INT val1, val2, INT abbr, CHAN OF INT channel)
PROC O (VAL INT val1, val2, VAL []INT varray, INT abbr, []INT array, CHAN OF INT channel)
SKIP
:
PROC P (VAL INT val1, val2, INT abbr, CHAN OF INT channel)
O (val1, val2, abbr, channel)
PROC P (VAL INT val1, val2, VAL []INT varray, INT abbr, []INT array, CHAN OF INT channel)
O (val1, val2, varray, abbr, array, channel)
:
PROC Q ()
INT x, y:
[10]INT xs, ys:
CHAN OF INT c:
P (42, x, y, c)
P (42, x, xs, y, ys, c)
:

55
fco2/testcases/arrays.occ Normal file
View File

@ -0,0 +1,55 @@
--** Test array abbreviations and parameters.
PROC P ()
SEQ
PROC Q1 ([]INT arg.arg)
SKIP
:
PROC Q ([]INT arg)
Q1 (arg)
:
PROC R1 (VAL []INT val.arg.arg)
SKIP
:
PROC R (VAL []INT val.arg)
R1 (val.arg)
:
[10]INT array:
SEQ
Q (array)
R (array)
[]INT abbrev IS array:
SEQ
Q (abbrev)
R (abbrev)
[]INT abbrev.abbrev IS abbrev:
SKIP
VAL []INT val.abbrev IS array:
SEQ
R (val.abbrev)
VAL []INT val.abbrev.abbrev IS val.abbrev:
SKIP
abbrev2 IS array:
SEQ
Q (abbrev2)
R (abbrev2)
VAL val.abbrev2 IS array:
R (val.abbrev2)
PROC S1 ([]CHAN OF INT chan.arg.arg)
SKIP
:
PROC S ([]CHAN OF INT chan.arg)
S1 (chan.arg)
:
[10]CHAN OF INT chan.array:
SEQ
S (chan.array)
[]CHAN OF INT chan.abbrev IS chan.array:
SEQ
S (chan.abbrev)
[]CHAN OF INT chan.abbrev.abbrev IS chan.abbrev:
SKIP
chan.abbrev2 IS chan.array:
S (chan.abbrev2)
: