From feefcfd017f13421a6b53f2ebff37066265a6de3 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Sun, 6 Apr 2008 17:47:41 +0000
Subject: [PATCH] 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.
---
 frontends/OccamTypes.hs        | 35 ++++++++++++++++++++++++++++++++--
 frontends/ParseOccam.hs        | 35 +++++++++++++++++-----------------
 testcases/ambiguity-output.occ | 12 ++++++++++++
 3 files changed, 63 insertions(+), 19 deletions(-)
 create mode 100644 testcases/ambiguity-output.occ

diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs
index 61251c3..9d97ac5 100644
--- a/frontends/OccamTypes.hs
+++ b/frontends/OccamTypes.hs
@@ -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
diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs
index 9db7f2c..52b3f06 100644
--- a/frontends/ParseOccam.hs
+++ b/frontends/ParseOccam.hs
@@ -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
diff --git a/testcases/ambiguity-output.occ b/testcases/ambiguity-output.occ
new file mode 100644
index 0000000..10acf63
--- /dev/null
+++ b/testcases/ambiguity-output.occ
@@ -0,0 +1,12 @@
+PROTOCOL FOO
+  CASE
+    x
+:
+PROC P ()
+  INT x:
+  SEQ
+    CHAN INT c:
+    c ! x
+    CHAN FOO c:
+    c ! x
+: