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

Do away with the channel/variable distinction

Browse Source
This commit is contained in:
Adam Sampson 2007-04-11 19:41:42 +00:00
parent 74efa43389
commit 2e9a7e8bd6
6 changed files with 123 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
fco2/AST.hs
View File

@ -76,11 +76,6 @@ data Literal =
| SubscriptedLiteral Meta Subscript Literal
deriving (Show, Eq, Typeable, Data)
data Channel =
Channel Meta Name
| SubscriptedChannel Meta Subscript Channel
deriving (Show, Eq, Typeable, Data)
data Variable =
Variable Meta Name
| SubscriptedVariable Meta Subscript Variable
@ -142,8 +137,8 @@ data Choice = Choice Meta Expression Process
deriving (Show, Eq, Typeable, Data)
data Alternative =
Alternative Meta Channel InputMode Process
| AlternativeCond Meta Expression Channel InputMode Process
Alternative Meta Variable InputMode Process
| AlternativeCond Meta Expression Variable InputMode Process
| AlternativeSkip Meta Expression Process
deriving (Show, Eq, Typeable, Data)
@ -186,9 +181,8 @@ data SpecType =
| Declaration Meta Type
| Is Meta AbbrevMode Type Variable
| IsExpr Meta AbbrevMode Type Expression
| IsChannel Meta Type Channel
-- FIXME Can these be multidimensional?
| IsChannelArray Meta Type [Channel]
| IsChannelArray Meta Type [Variable]
| DataType Meta Type
| DataTypeRecord Meta Bool [(Type, Name)]
| Protocol Meta [Type]
@ -205,7 +199,6 @@ data Formal =
data Actual =
ActualVariable Variable
| ActualChannel Channel
| ActualExpression Expression
deriving (Show, Eq, Typeable, Data)
@ -221,9 +214,9 @@ data ParMode =
data Process =
ProcSpec Meta Specification Process
| Assign Meta [Variable] ExpressionList
| Input Meta Channel InputMode
| Output Meta Channel [OutputItem]
| OutputCase Meta Channel Name [OutputItem]
| Input Meta Variable InputMode
| Output Meta Variable [OutputItem]
| OutputCase Meta Variable Name [OutputItem]
| Skip Meta
| Stop Meta
| Main Meta

145
fco2/GenerateC.hs
View File

@ -171,45 +171,54 @@ convStringStar 's' = " "
convStringStar c = [c]
--}}}
--{{{ channels, variables
--{{{ variables
{-
Channel c; -> &c \ Original
Channel c[10]; -> &c[i] /
Channel *c; -> c \ Abbrev
Channel **c; -> c[i] /
Original Abbrev
ValAbbrev
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)
= do ps <- get
am <- checkJust $ abbrevModeOfName ps n
case am of
A.Original -> tell ["&"]
A.Abbrev -> return ()
genName n
genChannel (A.SubscriptedChannel m s c) = genSubscript s (genChannel c)
INT x: x x *x int x; int *x;
[10]INT xs: xs[i] xs[i] xs[i] int xs[10]; int *xs;
xs xs xs
{-
int x; -> x \ Original, ValAbbrev
int x[10]; -> x[i] /
int *x; -> (*x) \ Abbrev
int **x; -> x[i] /
Original Abbrev
CHAN OF INT c: c &c c Channel c; Channel *c;
[10]CHAN OF INT cs: cs[i] &cs[i] cs[i] Channel cs[10]; Channel **cs;
cs cs cs
[2][2]INT xss: xss[i][j] xss[i][j] xss[i][j]
xss xss xss
[2][2]CHAN INT css: css[i][j] &css[i][j] css[i][j]
css css css
I suspect there's probably a nicer way of doing this, but as a translation of
the above table this isn't too horrible...
-}
genVariable :: A.Variable -> CGen ()
genVariable (A.Variable m n)
genVariable v
= do ps <- get
am <- checkJust $ abbrevModeOfName ps n
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)
am <- checkJust $ abbrevModeOfVariable ps v
t <- checkJust $ typeOfVariable ps v
let isArray = case t of
A.Array _ _ -> True
_ -> False
let isSubbed = case v of
A.SubscriptedVariable _ _ _ -> True
_ -> False
let isChan = case stripArrayType t of
A.Chan _ -> True
_ -> False
case am of
A.Abbrev -> if isChan || isArray then return () else tell ["*"]
A.ValAbbrev -> if isSubbed || not isArray then tell ["&"] else return ()
_ -> return ()
inner v
where
inner (A.Variable m n) = genName n
inner (A.SubscriptedVariable m s v) = genSubscript s (inner v)
--}}}
--{{{ expressions
@ -297,7 +306,7 @@ genDyadic A.After e f = genFuncDyadic "occam_after" e f
--}}}
--{{{ input/output items
genInputItem :: A.Channel -> A.InputItem -> CGen ()
genInputItem :: A.Variable -> A.InputItem -> CGen ()
genInputItem c (A.InCounted m cv av)
= do genInputItem c (A.InVariable m cv)
-- need to then input as much as appropriate
@ -308,20 +317,20 @@ genInputItem c (A.InVariable m v)
case t of
A.Int ->
do tell ["ChanInInt ("]
genChannel c
genVariable c
tell [", &"]
genVariable v
tell [");\n"]
_ ->
do tell ["ChanIn ("]
genChannel c
genVariable c
tell [", &"]
genVariable v
tell [", sizeof ("]
genType t
tell ["));\n"]
genOutputItem :: A.Channel -> A.OutputItem -> CGen ()
genOutputItem :: A.Variable -> A.OutputItem -> CGen ()
genOutputItem c (A.OutCounted m ce ae)
= do genOutputItem c (A.OutExpression m ce)
missing "genOutputItem counted"
@ -332,18 +341,19 @@ genOutputItem c (A.OutExpression m e)
case t of
A.Int ->
do tell ["ChanOutInt ("]
genChannel c
genVariable c
tell [", "]
genExpression e
tell [");\n"]
_ ->
do tell ["{\n"]
tell ["const "]
genType t
tell [" ", n, " = "]
genExpression e
tell [";\n"]
tell ["ChanOut ("]
genChannel c
genVariable c
tell [", &", n, ", sizeof ("]
genType t
tell ["));\n"]
@ -400,7 +410,7 @@ introduceSpec (n, A.Declaration m t)
do tell ["Channel "]
genName n
tell [";\n"]
tell ["ChanInit (&"]
tell ["ChanInit ("]
genName n
tell [");\n"]
A.Array ds t ->
@ -430,23 +440,29 @@ introduceSpec (n, A.Declaration m t)
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;
[10]CHAN OF INT: Channel c[10];
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.Is m am t v)
= case t of
A.Array _ _ ->
do genDecl am t n
tell [" = "]
let name = case v of A.Variable _ name -> name
genName name
genVariable v
tell [";\n"]
tell ["const int "]
genName n
tell ["_sizes[] = "]
genName name
genVariable v
tell ["_sizes;\n"]
_ ->
do genDecl am t n
tell [" = &"]
case t of
A.Chan _ -> tell [" = "]
_ -> tell [" = &"]
genVariable v
tell [";\n"]
introduceSpec (n, A.IsExpr m am t e)
@ -454,33 +470,10 @@ introduceSpec (n, A.IsExpr m am t e)
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)
= 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 [" = {"]
sequence_ $ intersperse genComma (map genChannel cs)
sequence_ $ intersperse genComma (map genVariable cs)
tell ["};\n"]
introduceSpec (n, A.Proc m fs p)
= do tell ["void "]
@ -509,16 +502,6 @@ genActual (A.ActualExpression 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 ps <- get
t <- checkJust $ typeOfVariable ps v
@ -597,10 +580,10 @@ genAssign vs el
(zip vs ns)
tell ["}\n"]
genInput :: A.Channel -> A.InputMode -> CGen ()
genInput :: A.Variable -> A.InputMode -> CGen ()
genInput c im
= do ps <- get
t <- checkJust $ typeOfChannel ps c
t <- checkJust $ typeOfVariable ps c
case t of
A.Timer -> case im of
A.InputSimple m [A.InVariable m' v] -> genTimerRead v
@ -625,7 +608,7 @@ genTimerWait e
genExpression e
tell [");\n"]
genOutput :: A.Channel -> [A.OutputItem] -> CGen ()
genOutput :: A.Variable -> [A.OutputItem] -> CGen ()
genOutput c ois = sequence_ $ map (genOutputItem c) ois
genStop :: CGen ()

53
fco2/Parse.hs
View File

@ -322,7 +322,6 @@ pTypeOf f item
Nothing -> fail "cannot compute type"
pTypeOfVariable = pTypeOf typeOfVariable
pTypeOfChannel = pTypeOf typeOfChannel
pTypeOfExpression = pTypeOf typeOfExpression
pSpecTypeOfName = pTypeOf specTypeOfName
--}}}
@ -682,37 +681,37 @@ variable'
<|> try (maybeSliced variable A.SubscriptedVariable)
<?> "variable'"
channel :: OccParser A.Channel
channel :: OccParser A.Variable
channel
= maybeSubscripted "channel" channel' A.SubscriptedChannel
= maybeSubscripted "channel" channel' A.SubscriptedVariable
<?> "channel"
channel' :: OccParser A.Channel
channel' :: OccParser A.Variable
channel'
= try (do { m <- md; n <- channelName; return $ A.Channel m n })
<|> try (maybeSliced channel A.SubscriptedChannel)
= try (do { m <- md; n <- channelName; return $ A.Variable m n })
<|> try (maybeSliced channel A.SubscriptedVariable)
<?> "channel'"
timer :: OccParser A.Channel
timer :: OccParser A.Variable
timer
= maybeSubscripted "timer" timer' A.SubscriptedChannel
= maybeSubscripted "timer" timer' A.SubscriptedVariable
<?> "timer"
timer' :: OccParser A.Channel
timer' :: OccParser A.Variable
timer'
= try (do { m <- md; n <- timerName; return $ A.Channel m n })
<|> try (maybeSliced timer A.SubscriptedChannel)
= try (do { m <- md; n <- timerName; return $ A.Variable m n })
<|> try (maybeSliced timer A.SubscriptedVariable)
<?> "timer'"
port :: OccParser A.Channel
port :: OccParser A.Variable
port
= maybeSubscripted "port" port' A.SubscriptedChannel
= maybeSubscripted "port" port' A.SubscriptedVariable
<?> "port"
port' :: OccParser A.Channel
port' :: OccParser A.Variable
port'
= try (do { m <- md; n <- portName; return $ A.Channel m n })
<|> try (maybeSliced port A.SubscriptedChannel)
= try (do { m <- md; n <- portName; return $ A.Variable m n })
<|> try (maybeSliced port A.SubscriptedVariable)
<?> "port'"
--}}}
--{{{ protocols
@ -787,10 +786,14 @@ abbreviation
<|> do { sVAL ;
do { (n, e) <- try (do { n <- newVariableName; sIS; e <- expression; return (n, e) }); sColon; eol; t <- pTypeOfExpression e; return (n, A.IsExpr m A.ValAbbrev t e) }
<|> do { s <- specifier; n <- newVariableName; sIS; e <- expression; sColon; eol; t <- pTypeOfExpression e; matchType s t; return (n, A.IsExpr m A.ValAbbrev s e) } }
<|> try (do { n <- newChannelName <|> newTimerName <|> newPortName; sIS; c <- channel; sColon; eol; t <- pTypeOfChannel c; return (n, A.IsChannel m t c) })
<|> try (do { s <- specifier; n <- newChannelName <|> newTimerName <|> newPortName; sIS; c <- channel; sColon; eol; t <- pTypeOfChannel c; matchType s t; return (n, A.IsChannel m s c) })
<|> try (do { n <- newChannelName; sIS; sLeft; cs <- sepBy1 channel sComma; sRight; sColon; eol; ts <- mapM pTypeOfChannel cs; t <- listType ts; return (n, A.IsChannelArray m t cs) })
<|> try (do { s <- specifier; n <- newChannelName; sIS; sLeft; cs <- sepBy1 channel sComma; sRight; sColon; eol; ts <- mapM pTypeOfChannel cs; t <- listType ts; matchType s t; return (n, A.IsChannelArray m s cs) }))
<|> try (do { n <- newChannelName; sIS; c <- channel; sColon; eol; t <- pTypeOfVariable c; return (n, A.Is m A.Abbrev t c) })
<|> try (do { n <- newTimerName; sIS; c <- timer; sColon; eol; t <- pTypeOfVariable c; return (n, A.Is m A.Abbrev t c) })
<|> try (do { n <- newPortName; sIS; c <- port; sColon; eol; t <- pTypeOfVariable c; return (n, A.Is m A.Abbrev t c) })
<|> try (do { s <- specifier; n <- newChannelName; sIS; c <- channel; sColon; eol; t <- pTypeOfVariable c; matchType s t; return (n, A.Is m A.Abbrev s c) })
<|> try (do { s <- specifier; n <- newTimerName; sIS; c <- timer; sColon; eol; t <- pTypeOfVariable c; matchType s t; return (n, A.Is m A.Abbrev s c) })
<|> try (do { s <- specifier; n <- newPortName; sIS; c <- port; sColon; eol; t <- pTypeOfVariable c; matchType s t; return (n, A.Is m A.Abbrev s c) })
<|> try (do { n <- newChannelName; sIS; sLeft; cs <- sepBy1 channel sComma; sRight; sColon; eol; ts <- mapM pTypeOfVariable cs; t <- listType ts; return (n, A.IsChannelArray m t cs) })
<|> try (do { s <- specifier; n <- newChannelName; sIS; sLeft; cs <- sepBy1 channel sComma; sRight; sColon; eol; ts <- mapM pTypeOfVariable cs; t <- listType ts; matchType s t; return (n, A.IsChannelArray m s cs) }))
<?> "abbreviation"
definition :: OccParser A.Specification
@ -923,14 +926,14 @@ inputProcess
(c, i) <- input
return $ A.Input m c i
input :: OccParser (A.Channel, A.InputMode)
input :: OccParser (A.Variable, A.InputMode)
input
= channelInput
<|> timerInput
<|> do { m <- md; p <- tryTrail port sQuest; v <- variable; eol; return (p, A.InputSimple m [A.InVariable m v]) }
<?> "input"
channelInput :: OccParser (A.Channel, A.InputMode)
channelInput :: OccParser (A.Variable, A.InputMode)
= do m <- md
c <- tryTrail channel sQuest
(do { tl <- try (do { sCASE; taggedList }); eol; return (c, A.InputCase m (A.OnlyV m (tl (A.Skip m)))) }
@ -938,7 +941,7 @@ channelInput :: OccParser (A.Channel, A.InputMode)
<|> do { is <- sepBy1 inputItem sSemi; eol; return (c, A.InputSimple m is) })
<?> "channelInput"
timerInput :: OccParser (A.Channel, A.InputMode)
timerInput :: OccParser (A.Variable, A.InputMode)
= do m <- md
c <- tryTrail timer sQuest
(do { v <- variable; eol; return (c, A.InputSimple m [A.InVariable m v]) }
@ -988,7 +991,7 @@ channelOutput
-- This is an ambiguity in the occam grammar; you can't tell in "a ! b"
-- whether b is a variable or a tag, without knowing the type of a.
st <- getState
isCase <- case typeOfChannel st c of
isCase <- case typeOfVariable st c of
Just t -> return $ isCaseProtocolType st t
Nothing -> fail $ "cannot figure out the type of " ++ show c
if isCase
@ -1209,7 +1212,7 @@ 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
_ -> if isChannelType t
then do { c <- channel; ct <- pTypeOfChannel c; matchType t ct; return $ A.ActualChannel c } <?> "actual channel for " ++ an
then do { c <- channel; ct <- pTypeOfVariable c; matchType t ct; return $ A.ActualVariable 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

17
fco2/Types.hs
View File

@ -35,8 +35,7 @@ typeOfName ps n
Just (A.Declaration m t) -> Just t
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.Array [A.UnknownDimension]
Just (A.IsChannelArray m t (c:_)) -> typeOfVariable 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
@ -47,16 +46,15 @@ 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
typeOfChannel ps (A.Channel m n) = typeOfName ps n
typeOfChannel ps (A.SubscriptedChannel m s c)
= typeOfChannel ps c >>= subscriptType
typeOfVariable :: ParseState -> A.Variable -> Maybe A.Type
typeOfVariable ps (A.Variable m n) = typeOfName ps n
typeOfVariable ps (A.SubscriptedVariable m s v)
= typeOfVariable ps v >>= subscriptType
abbrevModeOfVariable :: ParseState -> A.Variable -> Maybe A.AbbrevMode
abbrevModeOfVariable ps (A.Variable _ n) = abbrevModeOfName ps n
abbrevModeOfVariable ps (A.SubscriptedVariable _ _ v) = abbrevModeOfVariable ps v
typeOfExpression :: ParseState -> A.Expression -> Maybe A.Type
typeOfExpression ps e
= case e of
@ -103,7 +101,6 @@ abbrevModeOfSpec s
= case s of
A.Is _ am _ _ -> am
A.IsExpr _ am _ _ -> am
A.IsChannel _ _ _ -> A.Abbrev
A.IsChannelArray _ _ _ -> A.Abbrev
A.Retypes _ am _ _ -> am
A.RetypesExpr _ am _ _ -> am
@ -120,3 +117,7 @@ isChannelType (A.Array _ t) = isChannelType t
isChannelType (A.Chan _) = True
isChannelType _ = False
stripArrayType :: A.Type -> A.Type
stripArrayType (A.Array _ t) = stripArrayType t
stripArrayType t = t

14
fco2/Unnest.hs
View File

@ -150,15 +150,19 @@ removeFreeNames = doGeneric `extM` doProcess `extM` doStructured `extM` doValueP
_ -> False]
ps <- get
let types = [fromJust $ typeOfName ps n | n <- freeNames]
let ams = [case fromJust $ abbrevModeOfName ps n of
A.Original -> A.Abbrev
t -> t
| n <- freeNames]
-- Add formals for each of the free names
let newFs = [A.Formal A.Abbrev t n | (t, n) <- zip types freeNames]
let newFs = [A.Formal am t n | (am, t, n) <- zip3 ams types freeNames]
p' <- removeFreeNames p
let spec' = (n, A.Proc m (fs ++ newFs) p')
-- Add extra arguments to calls of this proc
let newAs = [case A.nameType n of
A.ChannelName -> A.ActualChannel (A.Channel m n)
A.VariableName -> A.ActualExpression (A.ExprVariable m (A.Variable m n))
| (t, n) <- zip types freeNames]
let newAs = [case am of
A.Abbrev -> A.ActualVariable (A.Variable m n)
_ -> A.ActualExpression (A.ExprVariable m (A.Variable m n))
| (am, n) <- zip ams freeNames]
child' <- removeFreeNames (addToCalls n newAs child)
return (spec', child')
_ ->

10
fco2/testcases/arrays.occ
View File

@ -37,19 +37,23 @@ PROC P ()
R (val.abbrev2)
PROC S1 ([]CHAN OF INT chan.arg.arg)
SKIP
chan.arg.arg[0] ! 42
:
PROC S ([]CHAN OF INT chan.arg)
S1 (chan.arg)
SEQ
chan.arg[0] ! 42
S1 (chan.arg)
:
[10]CHAN OF INT chan.array:
SEQ
chan.array[0] ! 42
S (chan.array)
[]CHAN OF INT chan.abbrev IS chan.array:
SEQ
chan.abbrev[0] ! 42
S (chan.abbrev)
[]CHAN OF INT chan.abbrev.abbrev IS chan.abbrev:
SKIP
chan.abbrev.abbrev[0] ! 42
chan.abbrev2 IS chan.array:
S (chan.abbrev2)
: