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

@@ -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
+                  -- At this point we must resolve the "c ! x" ambiguity:
-                  return $ A.Output m v' ois'
+                  -- 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

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 !
+           -- AMBIGUITY: in "a ! b", b may be a tag or a variable.
-           -- b" whether b is a variable or a tag, without knowing the type of
+           regularOutput m c <|> caseOutput m c
-           -- 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
     <?> "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

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
+: