From 118a1f3527b77370fc3c3d75b85ae01f2fc63db3 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Sun, 6 Apr 2008 11:33:10 +0000
Subject: [PATCH] Add a resolveAmbiguities pass. Currently this only handles
 the FunctionCallList ambiguity.

---
 frontends/OccamPasses.hs | 16 +++++++++++++++-
 frontends/ParseOccam.hs  | 10 ++++------
 pass/Properties.hs       |  4 ++++
 3 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/frontends/OccamPasses.hs b/frontends/OccamPasses.hs
index 173cf58..404697b 100644
--- a/frontends/OccamPasses.hs
+++ b/frontends/OccamPasses.hs
@@ -49,8 +49,11 @@ occamPasses = makePassesDep' ((== FrontendOccam) . csFrontend)
     , ("Infer types", astAndState inferTypes,
        [],
        [Prop.inferredTypesRecorded])
-    , ("Check types", checkTypes,
+    , ("Resolve ambiguities", resolveAmbiguities,
        [Prop.inferredTypesRecorded],
+       [Prop.ambiguitiesResolved])
+    , ("Check types", checkTypes,
+       [Prop.inferredTypesRecorded, Prop.ambiguitiesResolved],
        [Prop.expressionTypesChecked, Prop.processTypesChecked,
         Prop.functionTypesChecked, Prop.retypesChecked])
     , ("Dummy occam pass", dummyOccamPass,
@@ -77,6 +80,17 @@ fixConstructorTypes = applyDepthM doExpression
            return $ A.ExprConstr m $ A.RepConstr m' t' rep expr
     doExpression e = return e
 
+-- | Handle ambiguities in the occam syntax that the parser can't resolve.
+resolveAmbiguities :: Data t => t -> PassM t
+resolveAmbiguities = applyDepthM doExpressionList
+  where
+    doExpressionList :: Transform A.ExpressionList
+    -- A single function call inside an ExpressionList is actually a
+    -- FunctionCallList, since it can have multiple results.
+    doExpressionList (A.ExpressionList _ [A.FunctionCall m n es])
+        = return $ A.FunctionCallList m n es
+    doExpressionList e = return e
+
 -- | Fold constant expressions.
 foldConstants :: Data t => t -> PassM t
 foldConstants = applyDepthM2 doExpression doSpecification
diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs
index 17a8c42..a072750 100644
--- a/frontends/ParseOccam.hs
+++ b/frontends/ParseOccam.hs
@@ -689,8 +689,7 @@ expressionList
     =   do m <- md
            es <- sepBy1 expression sComma
            return $ A.ExpressionList m es
-    <|> do (m, n, as) <- functionCall
-           return $ A.FunctionCallList m n as
+    -- 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"
 
@@ -744,13 +743,13 @@ sizeExpr
                    return $ A.SizeVariable m v
     <?> "SIZE expression"
 
-functionCall :: OccParser (Meta, A.Name, [A.Expression])
+functionCall :: OccParser A.Expression
 functionCall
     =  do m <- md
           n <- tryVX functionName sLeftR
           as <- sepBy expression sComma
           sRightR
-          return (m, n, as)
+          return $ A.FunctionCall m n as
     <?> "function call"
 
 monadicOperator :: OccParser A.MonadicOp
@@ -818,8 +817,7 @@ operand'
     <|> literal
     <|> do { sLeftR; e <- expression; sRightR; return e }
 -- XXX value process
-    <|> do (m, n, as) <- functionCall
-           return $ A.FunctionCall m n as
+    <|> functionCall
     <|> do m <- md
            sBYTESIN
            sLeftR
diff --git a/pass/Properties.hs b/pass/Properties.hs
index 947f1c8..dec9b11 100644
--- a/pass/Properties.hs
+++ b/pass/Properties.hs
@@ -22,6 +22,7 @@ module Properties
   , agg_typesDone
   , afterRemoved
   , allChansToAnyOrProtocol
+  , ambiguitiesResolved
   , arrayConstructorsRemoved
   , arrayConstructorTypesDone
   , arrayLiteralsExpanded
@@ -234,6 +235,9 @@ inferredTypesRecorded = Property "inferredTypesRecorded" $
     findInfer A.Infer = True
     findInfer _ = False
 
+ambiguitiesResolved :: Property
+ambiguitiesResolved = Property "ambiguitiesResolved" checkTODO
+
 findUDT :: A.Type -> Bool
 findUDT (A.UserDataType {}) = True
 findUDT _ = False