Parsing distinction for single-word and function-call terms

6 files changed, 56 insertions, 23 deletions

diff --git a/src/Parser.hs b/src/Parser.hs
index e3d174e..619543f 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -64,7 +64,7 @@ parseTestDefinition = label "test definition" $ toplevel ToplevelTest $ do
         name <- try $ identifier <* osymbol ":"
         case name of
             "tag" -> do
-                Just <$> typedExpr <* eol <* scn
+                Just <$> typedExpr FunctionTerm <* eol <* scn
             _ -> do
                 registerParseError $ FancyError off $ S.singleton $ ErrorFail $
                     "unexpected test metadata ‘" <> T.unpack name <> "’"
@@ -89,7 +89,7 @@ parseDefinition href = label "symbol definition" $ do
                 SomeExpr <$> testBlock ref
             , do
                 osymbol "="
-                someExpr <* eol
+                someExpr FunctionTerm <* eol
             ]
         scn
         atypes' <- getInferredTypes atypes
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index 3716c80..c12d004 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -7,6 +7,7 @@ module Parser.Expr (
     addVarName, addVarNameType,
     constrName,
 
+    TermComplexity(..),
     someExpr,
     typedExpr,
     literal,
@@ -103,7 +104,7 @@ someExpansion = do
             sline <- getSourceLine
             name <- VarName . TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_')
             lookupScalarVarExpr off sline name
-        , between (char '{') (char '}') someExpr
+        , between (char '{') (char '}') (someExpr FunctionTerm)
         ]
 
 expressionExpansion :: forall a. ExprType a => Text -> TestParser (Expr a)
@@ -197,7 +198,7 @@ list = label "list" $ do
                         (ExprTypePrim (Proxy :: Proxy a)) -> HideType (ExprTypePrim (Proxy @[ a ])) $ Pure ([] :: [ a ])
                         _ -> Undefined "incomplete type"
 
-        ,do SomeExpr x <- someExpr
+        ,do SomeExpr x <- someExpr FunctionTerm
             let enumErr off = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
                     "list range enumeration not defined for ‘" <> textExprType x <> "’"
             let exprList = foldr (liftA2 (:)) (Pure [])
@@ -209,12 +210,12 @@ list = label "list" $ do
                 ,do off <- stateOffset <$> getParserState
                     osymbol ".."
                     ExprEnumerator fromTo _ <- maybe (enumErr off) return $ exprEnumerator x
-                    y <- typedExpr
+                    y <- typedExpr FunctionTerm
                     symbol "]"
                     return $ fromTo <$> x <*> y
 
                 ,do symbol ","
-                    y <- typedExpr
+                    y <- typedExpr FunctionTerm
 
                     choice
                         [do symbol "]"
@@ -223,12 +224,12 @@ list = label "list" $ do
                         ,do off <- stateOffset <$> getParserState
                             osymbol ".."
                             ExprEnumerator _ fromThenTo <- maybe (enumErr off) return $ exprEnumerator x
-                            z <- typedExpr
+                            z <- typedExpr FunctionTerm
                             symbol "]"
                             return $ fromThenTo <$> x <*> y <*> z
 
                         ,do symbol ","
-                            xs <- listOf typedExpr
+                            xs <- listOf (typedExpr FunctionTerm)
                             symbol "]"
                             return $ exprList (x : y : xs)
                         ]
@@ -254,14 +255,28 @@ applyBinOp off op x y = do
     y' <- unifyExpr off (Proxy @b) y
     return $ op <$> x' <*> y'
 
-someExpr :: TestParser SomeExpr
-someExpr = join inner <?> "expression"
+data TermComplexity
+    = SimpleTerm -- variable name, literal or more complex term in parentheses
+    | FunctionTerm -- simple term or function call
+
+someExpr :: TermComplexity -> TestParser SomeExpr
+someExpr complexity = label "expression" $ do
+    case complexity of
+        SimpleTerm -> join termSimple
+        FunctionTerm -> join inner
   where
-    inner = makeExprParser term table
+    inner = makeExprParser termFunction table
 
     parens = between (symbol "(") (symbol ")")
 
-    term = label "term" $ choice
+    termSimple = label "term" $ choice
+        [ parens inner
+        , return <$> literal
+        , return <$> variable
+        , return <$> constructor
+        ]
+
+    termFunction = label "term" $ choice
         [ parens inner
         , return <$> literal
         , return <$> functionCall
@@ -370,10 +385,10 @@ someExpr = join inner <?> "expression"
             region (const err) $
                 foldl1 (<|>) $ map (\(SomeBinOp op) -> tryop op (proxyOf e) (proxyOf f)) ops
 
-typedExpr :: forall a. ExprType a => TestParser (Expr a)
-typedExpr = do
+typedExpr :: forall a. ExprType a => TermComplexity -> TestParser (Expr a)
+typedExpr complexity = do
     off <- stateOffset <$> getParserState
-    SomeExpr e <- someExpr
+    SomeExpr e <- someExpr complexity
     unifyExpr off Proxy e
 
 literal :: TestParser SomeExpr
@@ -406,7 +421,7 @@ functionCall = do
     (variable <|> constructor) >>= \case
         SomeExpr e'@(FunVariable argTypes _ _) -> do
             let check = checkFunctionArguments argTypes
-            args <- functionArguments check someExpr literal (\poff -> lookupVarExpr poff sline . VarName)
+            args <- functionArguments check (someExpr FunctionTerm) literal (\poff -> lookupVarExpr poff sline . VarName)
             return $ SomeExpr $ ArgsApp args e'
         e -> return e
 
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs
index 96af2f3..f4f5b61 100644
--- a/src/Parser/Statement.hs
+++ b/src/Parser/Statement.hs
@@ -37,7 +37,7 @@ letStatement = do
     off <- stateOffset <$> getParserState
     name <- varName
     osymbol "="
-    se@(SomeExpr e) <- someExpr
+    se@(SomeExpr e) <- someExpr FunctionTerm
 
     localState $ do
         let tname = TypedVarName name
@@ -55,7 +55,7 @@ forStatement = do
 
     wsymbol "in"
     loff <- stateOffset <$> getParserState
-    SomeExpr e <- someExpr
+    SomeExpr e <- someExpr FunctionTerm
     let err = parseError $ FancyError loff $ S.singleton $ ErrorFail $ T.unpack $
             "expected a list, expression has type '" <> textExprType e <> "'"
     ExprListUnpacker unpack _ <- maybe err return $ exprListUnpacker e
@@ -93,7 +93,7 @@ shellStatement = do
 
         , do
             parseParamKeyword "on" mbnode
-            node <- typedExpr
+            node <- typedExpr SimpleTerm
             parseParams ref mbpname (Just node)
 
         , do
@@ -120,7 +120,7 @@ exprStatement :: TestParser (Expr (TestBlock ()))
 exprStatement = do
     ref <- L.indentLevel
     off <- stateOffset <$> getParserState
-    SomeExpr expr <- someExpr
+    SomeExpr expr <- someExpr FunctionTerm
     choice
         [ continuePartial off ref expr
         , unifyExpr off Proxy expr
@@ -136,7 +136,7 @@ exprStatement = do
         blockOf indent $ do
             coff <- stateOffset <$> getParserState
             sline <- getSourceLine
-            args <- functionArguments (checkFunctionArguments (exprArgs fun)) someExpr literal (\poff -> lookupVarExpr poff sline . VarName)
+            args <- functionArguments (checkFunctionArguments (exprArgs fun)) (someExpr FunctionTerm) literal (\poff -> lookupVarExpr poff sline . VarName)
             let fun' = ArgsApp args fun
             choice
                 [ continuePartial coff indent fun'
@@ -309,7 +309,7 @@ instance ExprType a => ParamType (ExprParam a) where
     type ParamRep (ExprParam a) = Expr a
     parseParam _ = do
         off <- stateOffset <$> getParserState
-        SomeExpr e <- literal <|> variable <|> constructor <|> between (symbol "(") (symbol ")") someExpr
+        SomeExpr e <- someExpr SimpleTerm
         unifyExpr off Proxy e
     showParamType _ = "<" ++ T.unpack (textExprType @a Proxy) ++ ">"
     paramExpr = fmap ExprParam
@@ -393,7 +393,7 @@ testWith = do
     wsymbol "with"
 
     off <- stateOffset <$> getParserState
-    ctx@(SomeExpr (_ :: Expr ctxe)) <- someExpr
+    ctx@(SomeExpr (_ :: Expr ctxe)) <- someExpr SimpleTerm
     let expected =
             [ ExprTypePrim @Network Proxy
             , ExprTypePrim @Node Proxy
diff --git a/test/asset/parser/function-fail.et b/test/asset/parser/function-fail.et
new file mode 100644
index 0000000..59ac3b0
--- /dev/null
+++ b/test/asset/parser/function-fail.et
@@ -0,0 +1,2 @@
+test Test:
+    guard 1 == 1
diff --git a/test/asset/parser/function.et b/test/asset/parser/function.et
new file mode 100644
index 0000000..3eca414
--- /dev/null
+++ b/test/asset/parser/function.et
@@ -0,0 +1,10 @@
+def f (x) and y = (x + y) + 1
+
+def g (x) and y = (x + (y+1))
+
+test Test:
+    guard (1 == 1)
+    guard (f 1 and 2 == 4)
+    guard (f 1 and 2 == g 1 and 2)
+    guard (f 1 and (g 2 and 3) == g 1 and 2 + 4)
+    guard (f (10 + g and 1 1) and (g 2 and 3) == g 1 and 2 + 10 +6)
diff --git a/test/script/parser.et b/test/script/parser.et
index 554e345..1a00bc8 100644
--- a/test/script/parser.et
+++ b/test/script/parser.et
@@ -11,3 +11,9 @@ test Parser:
 
         send "load ${scripts.path}/indent.et"
         expect /load-done/
+
+        send "load ${scripts.path}/function.et"
+        expect /load-done/
+
+        send "load ${scripts.path}/function-fail.et"
+        expect /load-failed parse-error/