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:
Adam Sampson 2008-04-06 17:47:41 +00:00
parent 4b841e1dc1
commit feefcfd017
3 changed files with 63 additions and 19 deletions

View File

@ -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

View File

@ -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

View File

@ -0,0 +1,12 @@
PROTOCOL FOO
CASE
x
:
PROC P ()
INT x:
SEQ
CHAN INT c:
c ! x
CHAN FOO c:
c ! x
: