From 62b65e16f5ef4e59dcfbdc10ae2b3cd419d79d7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Fri, 1 May 2026 10:02:50 +0200 Subject: Parsing distinction for single-word and function-call terms --- src/Parser.hs | 4 ++-- src/Parser/Expr.hs | 43 +++++++++++++++++++++++++++++-------------- src/Parser/Statement.hs | 14 +++++++------- 3 files changed, 38 insertions(+), 23 deletions(-) (limited to 'src') 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 -- cgit v1.2.3