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

Added direction specifiers and further attributes (such as whether the channel is shared) to the Chan type in the AST

Browse Source
This commit is contained in:
Neil Brown 2007-08-21 10:35:18 +00:00
parent dfefcdfd41
commit 3b14eec036
7 changed files with 49 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
AST.hs
View File

@ -74,6 +74,16 @@ data NameDef = NameDef {
}
deriving (Show, Eq, Typeable, Data)
-- | The direction of a channel -- input (reading-end), output (writing-end) or unknown (either)
data Direction = DirInput | DirOutput | DirUnknown
deriving (Show, Eq, Typeable, Data)
data ChanAttributes = ChanAttributes {
caWritingShared :: Bool,
caReadingShared :: Bool
}
deriving (Show, Eq, Typeable, Data)
-- | A data or protocol type.
-- The two concepts aren't unified in occam, but they are here, because it
-- makes sense to be able to ask what type a particular name is defined to
@ -92,7 +102,8 @@ data Type =
| Record Name
-- | A user-defined protocol.
| UserProtocol Name
| Chan Type
-- | A channel of the specified type.
| Chan Direction ChanAttributes Type
-- | A counted input or output.
| Counted Type Type
| Any
@ -117,7 +128,7 @@ instance Show Type where
show (UserDataType n) = nameName n ++ "{data type}"
show (Record n) = nameName n ++ "{record}"
show (UserProtocol n) = nameName n ++ "{protocol}"
show (Chan t) = "CHAN OF " ++ show t
show (Chan _ _ t) = "CHAN OF " ++ show t
show (Counted ct et) = show ct ++ "::" ++ show et
show Any = "ANY"
show Timer = "TIMER"

26
GenerateC.hs
View File

@ -333,7 +333,7 @@ cgenType ops (A.Array _ t)
tell ["*"]
cgenType _ (A.Record n) = genName n
-- UserProtocol -- not used
cgenType _ (A.Chan t) = tell ["Channel *"]
cgenType _ (A.Chan _ _ t) = tell ["Channel *"]
-- Counted -- not used
-- Any -- not used
--cgenType ops (A.Port t) =
@ -381,7 +381,7 @@ cgenBytesIn' _ (A.Record n) _
return Nothing
-- This is so that we can do RETYPES checks on channels; we don't actually
-- allow retyping between channels and other things.
cgenBytesIn' _ (A.Chan _) _
cgenBytesIn' _ (A.Chan {}) _
= do tell ["sizeof (Channel *)"]
return Nothing
cgenBytesIn' ops t _
@ -397,7 +397,7 @@ cgenDeclType ops am t
call genType ops t
case t of
A.Array _ _ -> return ()
A.Chan _ -> return ()
A.Chan {} -> return ()
A.Record _ -> tell [" *"]
_ -> when (am == A.Abbrev) $ tell [" *"]
@ -665,8 +665,8 @@ cgenVariable' ops checkValid v
let prefix = case (am, t) of
(_, A.Array _ _) -> ""
(A.Original, A.Chan _) -> if isSub then "" else "&"
(A.Abbrev, A.Chan _) -> ""
(A.Original, A.Chan {}) -> if isSub then "" else "&"
(A.Abbrev, A.Chan {}) -> ""
(A.Original, A.Record _) -> "&"
(A.Abbrev, A.Record _) -> ""
(A.Abbrev, _) -> "*"
@ -1040,7 +1040,7 @@ abbrevVariable ops am (A.Array ds _) v@(A.SubscriptedVariable m (A.SubscriptFor
= call genSlice ops v v' (makeConstant m 0) count ds
abbrevVariable ops am (A.Array _ _) v
= (call genVariable ops v, call genArraySize ops True (call genVariable ops v >> tell ["_sizes"]))
abbrevVariable ops am (A.Chan _) v
abbrevVariable ops am (A.Chan {}) v
= (call genVariable ops v, noSize)
abbrevVariable ops am (A.Record _) v
= (call genVariable ops v, noSize)
@ -1110,12 +1110,12 @@ cgenSpec ops spec body
-- | Generate the C type corresponding to a variable being declared.
-- It must be possible to use this in arrays.
cdeclareType :: GenOps -> A.Type -> CGen ()
cdeclareType _ (A.Chan _) = tell ["Channel *"]
cdeclareType _ (A.Chan {}) = tell ["Channel *"]
cdeclareType ops t = call genType ops t
-- | Generate a declaration of a new variable.
cgenDeclaration :: GenOps -> A.Type -> A.Name -> CGen ()
cgenDeclaration ops (A.Chan _) n
cgenDeclaration ops (A.Chan {}) n
= do tell ["Channel "]
genName n
tell [";\n"]
@ -1167,13 +1167,13 @@ cgenArraySizesLiteral ops ds
-- | Initialise an item being declared.
cdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ())
cdeclareInit ops _ (A.Chan _) var
cdeclareInit ops _ (A.Chan {}) var
= Just $ do tell ["ChanInit ("]
call genVariable ops var
tell [");\n"]
cdeclareInit ops m t@(A.Array ds t') var
= Just $ do init <- case t' of
A.Chan _ ->
A.Chan {} ->
do A.Specification _ store _ <- makeNonceVariable "storage" m (A.Array ds A.Int) A.VariableName A.Original
let storeV = A.Variable m store
tell ["Channel "]
@ -1325,7 +1325,7 @@ cintroduceSpec ops (A.Specification _ n (A.Retypes m am t v))
-- we need to dereference the pointer that abbrevVariable gives us.
let deref = case (am, t) of
(_, A.Array _ _) -> False
(_, A.Chan _) -> False
(_, A.Chan {}) -> False
(A.ValAbbrev, _) -> True
_ -> False
when deref $ tell ["*"]
@ -1463,7 +1463,7 @@ cgenInput ops c im
cgenInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen ()
cgenInputCase ops m c s
= do t <- typeOfVariable c
let proto = case t of A.Chan (A.UserProtocol n) -> n
let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n
tag <- makeNonce "case_tag"
genName proto
tell [" ", tag, ";\n"]
@ -1518,7 +1518,7 @@ cgenOutput ops c ois = sequence_ $ map (call genOutputItem ops c) ois
cgenOutputCase :: GenOps -> A.Variable -> A.Name -> [A.OutputItem] -> CGen ()
cgenOutputCase ops c tag ois
= do t <- typeOfVariable c
let proto = case t of A.Chan (A.UserProtocol n) -> n
let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n
tell ["ChanOutInt ("]
call genVariable ops c
tell [", "]

26
GenerateCPPCSP.hs
View File

@ -166,7 +166,7 @@ cppgenInput ops c im
A.InputSimple m is ->
do t <- typeOfVariable c
case t of
A.Chan (A.UserProtocol innerType) ->
A.Chan _ _ (A.UserProtocol innerType) ->
--We read from the channel into a temporary var, then deal with the var afterwards
do inputVar <- makeNonce "proto_var"
genProtocolName innerType
@ -184,7 +184,7 @@ cppgenInputCase ops m c s
= do t <- typeOfVariable c
--We have to do complex things with the which() function of the variant (which may be a chained variant)
--to actually get the real index of the item we have received.
let proto = case t of A.Chan (A.UserProtocol n) -> n
let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n
tag <- makeNonce "case_tag"
which <- makeNonce "which_val"
genProtocolName proto
@ -402,7 +402,7 @@ cppgenOutput ops c ois
= do t <- typeOfVariable c
case t of
--If it's a protocol, we have to build the appropriate tuple to send down the channel:
A.Chan (A.UserProtocol innerType) ->
A.Chan _ _ (A.UserProtocol innerType) ->
do call genVariable ops c
tell [" ->writer() << "]
genProtocolName innerType
@ -477,7 +477,7 @@ genSubTypes proto tag middle
cppgenOutputCase :: GenOps -> A.Variable -> A.Name -> [A.OutputItem] -> CGen ()
cppgenOutputCase ops c tag ois
= do t <- typeOfVariable c
let proto = case t of A.Chan (A.UserProtocol n) -> n
let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n
call genVariable ops c
tell [" ->writer() << "]
genSubTypes proto tag (middle proto)
@ -606,7 +606,7 @@ cppdeclareType ops (A.Counted countType valueType)
_ -> call genType ops valueType
tell ["/**/>/**/"]
cppdeclareType ops (A.Chan t)
cppdeclareType ops (A.Chan _ _ t)
= do tell [" csp::One2OneChannel < "]
call genType ops t
tell ["/**/>/**/ "]
@ -643,7 +643,7 @@ cppgenDeclaration ops t n
cppdeclareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ())
cppdeclareInit ops m t@(A.Array ds t') var
= Just $ do init <- case t' of
A.Chan _ ->
A.Chan {} ->
return (\sub -> Just $ do call genVariable ops (sub var)
tell [" = new "]
call declareType ops t'
@ -659,7 +659,7 @@ cppdeclareInit _ _ _ _ = Nothing
cppdeclareFree :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ())
cppdeclareFree ops m t@(A.Array ds t') var
= Just $ do free <- case t' of
A.Chan _ ->
A.Chan {} ->
return (\sub -> Just $ do tell ["delete "]
call genVariable ops (sub var)
tell [";\n"]
@ -930,7 +930,7 @@ cppintroduceSpec ops (A.Specification _ n (A.Retypes m am t v))
-- we need to dereference the pointer that cppabbrevVariable gives us.
do let deref = case (am, t) of
(_, A.Array _ _) -> False
(_, A.Chan _) -> False
(_, A.Chan {}) -> False
(A.ValAbbrev, _) -> True
_ -> False
when deref $ tell ["*"]
@ -987,7 +987,7 @@ cppgenType ops arr@(A.Array _ _)
= cppgenArrayType ops False arr 0
cppgenType _ (A.Record n) = genName n
cppgenType _ (A.UserProtocol n) = genProtocolName n
cppgenType ops (A.Chan t)
cppgenType ops (A.Chan _ _ t)
= do tell ["csp::One2OneChannel < "]
call genType ops t
tell [" > * "]
@ -1022,7 +1022,7 @@ cppabbrevVariable ops am ty@(A.Array ds _) v@(A.SubscriptedVariable m (A.Subscri
= cppgenSlice ops v v' ty (makeConstant m 0) count ds
cppabbrevVariable ops am (A.Array _ _) v
= call genVariable ops v
cppabbrevVariable ops am (A.Chan _) v
cppabbrevVariable ops am (A.Chan {}) v
= call genVariable ops v
cppabbrevVariable ops am (A.Record _) v
= call genVariable ops v
@ -1176,7 +1176,7 @@ cppgenDeclType ops am t
do when (am == A.ValAbbrev) $ tell ["const "]
call genType ops t
case t of
A.Chan _ -> return ()
A.Chan {} -> return ()
A.Record _ -> tell [" *"]
_ -> when (am == A.Abbrev) $ tell [" *"]
@ -1193,8 +1193,8 @@ cppgenVariable' ops checkValid v
let prefix = case (am, t) of
(_, A.Array _ _) -> ""
(A.Original, A.Chan _) -> if isSub then "" else "&"
(A.Abbrev, A.Chan _) -> ""
(A.Original, A.Chan {}) -> if isSub then "" else "&"
(A.Abbrev, A.Chan {}) -> ""
(A.Original, A.Record _) -> "&"
(A.Abbrev, A.Record _) -> ""
(A.Abbrev, _) -> "*"

10
Parse.hs
View File

@ -559,7 +559,7 @@ dataType
-- FIXME should probably make CHAN INT work, since that'd be trivial...
channelType :: OccParser A.Type
channelType
= do { sCHAN; sOF; p <- protocol; return $ A.Chan p }
= do { sCHAN; sOF; p <- protocol; return $ A.Chan A.DirUnknown A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False} p }
<|> arrayType channelType
<?> "channel type"
@ -1265,7 +1265,7 @@ chanArrayAbbrev
ts <- mapM typeOfVariable cs
t <- tableType m ts
case t of
(A.Array _ (A.Chan _)) -> return ()
(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
@ -1275,7 +1275,7 @@ chanArrayAbbrev
sLeft
ct <- trivialSubscriptType s
case ct of
A.Chan _ -> return (ct, s, n)
A.Chan {} -> return (ct, s, n)
_ -> pzero)
cs <- sepBy1 (channelOfType ct) sComma
sRight
@ -1361,7 +1361,7 @@ retypesAbbrev
-- | Check that a RETYPES\/RESHAPES is safe.
checkRetypes :: A.Type -> A.Type -> OccParser ()
-- Retyping channels is always "safe".
checkRetypes (A.Chan _) (A.Chan _) = return ()
checkRetypes (A.Chan {}) (A.Chan {}) = return ()
checkRetypes fromT toT
= do bf <- bytesInType fromT
bt <- bytesInType toT
@ -1893,7 +1893,7 @@ actual (A.Formal am t n)
return $ A.ActualExpression t e
_ ->
case stripArrayType t of
A.Chan _ -> var (channelOfType t)
A.Chan {} -> var (channelOfType t)
A.Timer -> var timer
A.Port _ -> var (portOfType t)
_ -> var (variableOfType t)

2
RainParse.hs
View File

@ -176,7 +176,7 @@ dataType :: RainParser A.Type
dataType
= do {sBool ; return A.Bool}
<|> do {sInt ; return A.Int64}
<|> do {sChannel ; inner <- dataType ; return $ A.Chan inner}
<|> do {sChannel ; inner <- dataType ; return $ A.Chan A.DirUnknown (A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False}) inner}
<?> "data type"
variableId :: RainParser A.Variable

2
TLP.hs
View File

@ -49,7 +49,7 @@ tlpInterface
return (mainName, chans)
where
tlpChannel :: (CSM m, Die m) => A.Formal -> m TLPChannel
tlpChannel (A.Formal _ (A.Chan A.Byte) n)
tlpChannel (A.Formal _ (A.Chan _ _ A.Byte) n)
= do def <- lookupName n
let origN = A.ndOrigName def
case lookup origN tlpChanNames of

6
Types.hs
View File

@ -218,7 +218,7 @@ returnTypesOfIntrinsic s
-- Returns Left if it's a simple protocol, Right if it's tagged.
protocolItems :: (CSM m, Die m) => A.Variable -> m (Either [A.Type] [(A.Name, [A.Type])])
protocolItems v
= do A.Chan t <- typeOfVariable v
= do A.Chan _ _ t <- typeOfVariable v
case t of
A.UserProtocol proto ->
do st <- specTypeOfName proto
@ -366,8 +366,8 @@ simplifyType origT@(A.Record n)
simplifyType (A.Array ds t)
= do t' <- simplifyType t
return $ A.Array ds t'
simplifyType (A.Chan t)
= liftM A.Chan $ simplifyType t
simplifyType (A.Chan d a t)
= liftM (A.Chan d a) $ simplifyType t
simplifyType (A.Counted ct it)
= do ct' <- simplifyType ct
it' <- simplifyType it