Resolve the c ! x ambiguity outside the parser.
Unfortunately there appears to be exactly one place you can do this, and it turns out to be inside inferTypes (because you need to know the type of c completely, and you can't type-infer x until you know if it's a tag or a variable). It's definitely nicer than doing it in the parser, though. I've also started adding "-- AMBIGUITY" comments in the parser.
This commit is contained in:
parent
4b841e1dc1
commit
feefcfd017
|
@ -761,8 +761,21 @@ inferTypes = applyExplicitM9 doExpression doDimension doSubscript
|
|||
return $ A.Assign m vs' el'
|
||||
A.Output m v ois ->
|
||||
do v' <- inferTypes v
|
||||
ois' <- doOutputItems m v' Nothing ois
|
||||
return $ A.Output m v' ois'
|
||||
-- At this point we must resolve the "c ! x" ambiguity:
|
||||
-- we definitely know what c is, and we must know what x is
|
||||
-- before trying to infer its type.
|
||||
tagged <- isTagged v'
|
||||
if tagged
|
||||
-- Tagged protocol -- convert (wrong) variable to tag.
|
||||
then case ois of
|
||||
((A.OutExpression _ (A.ExprVariable _ (A.Variable _ wrong))):ois) ->
|
||||
do tag <- nameToTag wrong
|
||||
ois' <- doOutputItems m v' (Just tag) ois
|
||||
return $ A.OutputCase m v' tag ois'
|
||||
_ -> diePC m $ formatCode "This channel carries a variant protocol; expected a list starting with a tag, but found %" ois
|
||||
-- Regular protocol -- proceed as before.
|
||||
else do ois' <- doOutputItems m v' Nothing ois
|
||||
return $ A.Output m v' ois'
|
||||
A.OutputCase m v tag ois ->
|
||||
do v' <- inferTypes v
|
||||
ois' <- doOutputItems m v' (Just tag) ois
|
||||
|
@ -782,6 +795,24 @@ inferTypes = applyExplicitM9 doExpression doDimension doSubscript
|
|||
-- FIXME: IntrinsicProcCall
|
||||
_ -> descend p
|
||||
where
|
||||
-- | Does a channel carry a tagged protocol?
|
||||
isTagged :: A.Variable -> PassM Bool
|
||||
isTagged c
|
||||
= do protoT <- checkChannel A.DirOutput c
|
||||
case protoT of
|
||||
A.UserProtocol n ->
|
||||
do st <- specTypeOfName n
|
||||
case st of
|
||||
A.ProtocolCase _ _ -> return True
|
||||
_ -> return False
|
||||
_ -> return False
|
||||
|
||||
-- | Given a name that should really have been a tag, make it one.
|
||||
nameToTag :: A.Name -> PassM A.Name
|
||||
nameToTag n@(A.Name m nt _)
|
||||
= do nd <- lookupName n
|
||||
findUnscopedName (A.Name m nt (A.ndOrigName nd))
|
||||
|
||||
doOutputItems :: Meta -> A.Variable -> Maybe A.Name
|
||||
-> Transform [A.OutputItem]
|
||||
doOutputItems m v tag ois
|
||||
|
|
|
@ -433,6 +433,10 @@ scopeOutFormals fs = sequence_ [scopeOut n | (A.Formal am t n) <- fs]
|
|||
-- the occam2.1 manual.
|
||||
--
|
||||
-- Each production is allowed to consume the thing it's trying to match.
|
||||
--
|
||||
-- Productions with an "-- AMBIGUITY" comment match something that's ambiguous
|
||||
-- in the occam grammar, and may thus produce incorrect AST fragments. The
|
||||
-- ambiguities will be resolved later.
|
||||
|
||||
--{{{ names
|
||||
anyName :: A.NameType -> OccParser A.Name
|
||||
|
@ -670,10 +674,10 @@ splitStringLiteral m cs = ssl cs
|
|||
--{{{ expressions
|
||||
expressionList :: OccParser A.ExpressionList
|
||||
expressionList
|
||||
-- AMBIGUITY: this will also match FunctionCallList.
|
||||
= do m <- md
|
||||
es <- sepBy1 expression sComma
|
||||
return $ A.ExpressionList m es
|
||||
-- FunctionCallList will be matched by this and resolved later.
|
||||
-- XXX: Value processes are not supported (because nobody uses them and they're hard to parse)
|
||||
<?> "expression list"
|
||||
|
||||
|
@ -1325,23 +1329,20 @@ channelOutput :: OccParser A.Process
|
|||
channelOutput
|
||||
= do m <- md
|
||||
c <- tryVX channel sBang
|
||||
-- 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.
|
||||
-- FIXME: We should resolve this in a pass later, rather than doing
|
||||
-- the check here.
|
||||
pis <- protocolItems c
|
||||
case pis of
|
||||
Left _ ->
|
||||
do os <- sepBy1 outputItem sSemi
|
||||
eol
|
||||
return $ A.Output m c os
|
||||
Right _ ->
|
||||
do tag <- tagName
|
||||
os <- many (sSemi >> outputItem)
|
||||
eol
|
||||
return $ A.OutputCase m c tag os
|
||||
-- AMBIGUITY: in "a ! b", b may be a tag or a variable.
|
||||
regularOutput m c <|> caseOutput m c
|
||||
<?> "channel output"
|
||||
where
|
||||
regularOutput m c
|
||||
= do o <- try outputItem
|
||||
os <- many (sSemi >> outputItem)
|
||||
eol
|
||||
return $ A.Output m c (o:os)
|
||||
caseOutput m c
|
||||
= do tag <- tagName
|
||||
os <- many (sSemi >> outputItem)
|
||||
eol
|
||||
return $ A.OutputCase m c tag os
|
||||
|
||||
outputItem :: OccParser A.OutputItem
|
||||
outputItem
|
||||
|
|
12
testcases/ambiguity-output.occ
Normal file
12
testcases/ambiguity-output.occ
Normal file
|
@ -0,0 +1,12 @@
|
|||
PROTOCOL FOO
|
||||
CASE
|
||||
x
|
||||
:
|
||||
PROC P ()
|
||||
INT x:
|
||||
SEQ
|
||||
CHAN INT c:
|
||||
c ! x
|
||||
CHAN FOO c:
|
||||
c ! x
|
||||
:
|
Loading…
Reference in New Issue
Block a user