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

Fixed the occam and Rain parsers to work with the new channel-ends

Browse Source 
For now, I have fixed the occam parser so that it allows 1 or more direction specifiers after channel names.  So c?? is valid, and should end up being equivalent to c?, but this may need altering later.
This commit is contained in:
Neil Brown 2009-01-20 17:28:57 +00:00
parent de80ab467e
commit 4d692c8897
3 changed files with 14 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
frontends/ParseOccam.hs
View File

@ -523,7 +523,7 @@ dataType
channelType :: OccParser A.Type
channelType
= do { sCHAN; optional sOF; p <- protocol; return $ A.Chan A.DirUnknown A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False} p }
= do { sCHAN; optional sOF; p <- protocol; return $ A.Chan A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False} p }
<|> arrayType channelType
<?> "channel type"
@ -853,7 +853,6 @@ direction :: OccParser A.Direction
direction
= (sQuest >> return A.DirInput)
<|> (sBang >> return A.DirOutput)
<|> return A.DirUnknown
<?> "direction decorator"
-- | Parse a production with an optional direction specifier,
@ -863,21 +862,16 @@ maybeDirected :: OccParser t -> OccParser (A.Type -> OccParser A.Type, t)
maybeDirected inner
= do v <- inner
m <- md
dir <- direction
return (case dir of
A.DirUnknown -> return
_ -> applyDirection m dir,
v)
dirs <- many direction
return (foldFuncsM $ map (applyDirection m) (reverse dirs), v)
-- | Parse a channel followed by an optional direction specifier.
directedChannel :: OccParser A.Variable
directedChannel
= do c <- channel
m <- md
dir <- direction
case dir of
A.DirUnknown -> return c
_ -> return $ A.DirectedVariable m dir c
dirs <- many direction
return $ foldFuncs (map (A.DirectedVariable m) (reverse dirs)) c
timer :: OccParser A.Variable
timer
@ -1636,6 +1630,7 @@ actual (A.Formal am t n)
_ ->
case stripArrayType t of
A.Chan {} -> var directedChannel
A.ChanEnd {} -> var directedChannel
A.Timer {} -> var timer
A.Port _ -> var port
_ -> var variable

6
frontends/ParseRain.hs
View File

@ -167,9 +167,9 @@ dataType
<|> do {reserved "sint32" ; return A.Int32}
<|> do {reserved "sint64" ; return A.Int64}
<|> do {reserved "time" ; return A.Time}
<|> do {sChannel ; inner <- dataType ; return $ A.Chan A.DirUnknown (A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False}) inner}
<|> do {sIn ; inner <- dataType ; return $ A.Chan A.DirInput (A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False}) inner}
<|> do {sOut ; inner <- dataType ; return $ A.Chan A.DirOutput (A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False}) inner}
<|> do {sChannel ; inner <- dataType ; return $ A.Chan (A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False}) inner}
<|> do {sIn ; inner <- dataType ; return $ A.ChanEnd A.DirInput (A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False}) inner}
<|> do {sOut ; inner <- dataType ; return $ A.ChanEnd A.DirOutput (A.ChanAttributes {A.caWritingShared = False, A.caReadingShared = False}) inner}
<|> do {sLeftQ ; inner <- dataType ; sRightQ ; return $ A.List inner}
<|> do {(m,n) <- identifier ; return $ A.UserDataType A.Name {A.nameMeta = m, A.nameName = n}}
<?> "data type"

10
frontends/RainTypes.hs
View File

@ -85,9 +85,9 @@ ttte m c f t = typeToTypeExp m t >>= \t' -> return $ OperType m c (\[x] -> f x)
-- User data types should not be present in the input.
typeToTypeExp :: Meta -> A.Type -> RainTypeM (TypeExp A.Type)
typeToTypeExp m (A.List t) = ttte m "[]" A.List t
typeToTypeExp m (A.Chan A.DirInput at t) = ttte m "?" (A.Chan A.DirInput at) t
typeToTypeExp m (A.Chan A.DirOutput at t) = ttte m "!" (A.Chan A.DirOutput at) t
typeToTypeExp m (A.Chan A.DirUnknown at t) = ttte m "channel" (A.Chan A.DirUnknown at) t
typeToTypeExp m (A.ChanEnd A.DirInput at t) = ttte m "?" (A.ChanEnd A.DirInput at) t
typeToTypeExp m (A.ChanEnd A.DirOutput at t) = ttte m "!" (A.ChanEnd A.DirOutput at) t
typeToTypeExp m (A.Chan at t) = ttte m "channel" (A.Chan at) t
typeToTypeExp m (A.Mobile t) = ttte m "MOBILE" A.Mobile t
typeToTypeExp _ (A.UnknownVarType reqs en)
= case en of
@ -284,7 +284,7 @@ markCommTypes = checkDepthM2 checkInputOutput checkAltInput
where
checkInput :: A.Variable -> A.Variable -> Meta -> a -> RainTypeM ()
checkInput chanVar destVar m p
= astTypeOf destVar >>= markUnify chanVar . A.Chan A.DirInput (A.ChanAttributes
= astTypeOf destVar >>= markUnify chanVar . A.ChanEnd A.DirInput (A.ChanAttributes
False False)
checkWait :: RainTypeCheck A.InputMode
@ -300,7 +300,7 @@ markCommTypes = checkDepthM2 checkInputOutput checkAltInput
checkInputOutput (A.Input _ _ im@(A.InputTimerAfter {})) = checkWait im
checkInputOutput (A.Input _ _ im@(A.InputTimerRead {})) = checkWait im
checkInputOutput p@(A.Output m chanVar [A.OutExpression m' srcExp])
= astTypeOf srcExp >>= markUnify chanVar . A.Chan A.DirOutput (A.ChanAttributes
= astTypeOf srcExp >>= markUnify chanVar . A.ChanEnd A.DirOutput (A.ChanAttributes
False False)
checkInputOutput _ = return ()