From 2e9a7e8bd6fd9248a4d8b6deb7abfa175e0a44f5 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Wed, 11 Apr 2007 19:41:42 +0000 Subject: [PATCH] Do away with the channel/variable distinction --- fco2/AST.hs | 19 ++--- fco2/GenerateC.hs | 145 +++++++++++++++++--------------------- fco2/Parse.hs | 53 +++++++------- fco2/Types.hs | 17 ++--- fco2/Unnest.hs | 14 ++-- fco2/testcases/arrays.occ | 10 ++- 6 files changed, 123 insertions(+), 135 deletions(-) diff --git a/fco2/AST.hs b/fco2/AST.hs index c377ca6..108b7b7 100644 --- a/fco2/AST.hs +++ b/fco2/AST.hs @@ -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 diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 51e64f1..cafaf91 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -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 () diff --git a/fco2/Parse.hs b/fco2/Parse.hs index c6b8366..a2ed959 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -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 diff --git a/fco2/Types.hs b/fco2/Types.hs index b926676..4677210 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -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 + diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index 1b6b864..8ea4d60 100644 --- a/fco2/Unnest.hs +++ b/fco2/Unnest.hs @@ -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') _ -> diff --git a/fco2/testcases/arrays.occ b/fco2/testcases/arrays.occ index d619b26..a57bc5c 100644 --- a/fco2/testcases/arrays.occ +++ b/fco2/testcases/arrays.occ @@ -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) :