summaryrefslogtreecommitdiff
path: root/src/Parser
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-09-23 19:44:17 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-09-25 20:25:22 +0200
commit213e3523aead4c18b65ac85886203d2508b9b27e (patch)
tree6f207174a09ee312a366d0c22c08a31a056aaf3d /src/Parser
parent274554243235d3013430a48973fd0f25244ac392 (diff)
Implement "guard" as a builtin
Diffstat (limited to 'src/Parser')
-rw-r--r--src/Parser/Core.hs24
-rw-r--r--src/Parser/Expr.hs10
-rw-r--r--src/Parser/Statement.hs19
3 files changed, 24 insertions, 29 deletions
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index dd2df12..ab6079a 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -55,12 +55,12 @@ lookupVarType off name = do
gets (fromMaybe t . M.lookup tvar . testTypeUnif)
Just x -> return x
-lookupVarExpr :: Int -> VarName -> TestParser SomeExpr
-lookupVarExpr off name = do
+lookupVarExpr :: Int -> SourceLine -> VarName -> TestParser SomeExpr
+lookupVarExpr off sline name = do
lookupVarType off name >>= \case
- ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable name :: Expr a)
- ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar name
- ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args name :: Expr (FunctionType a))
+ ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline name :: Expr a)
+ ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar sline name
+ ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args sline name :: Expr (FunctionType a))
unify :: Int -> SomeExprType -> SomeExprType -> TestParser SomeExprType
unify _ (ExprTypeVar aname) (ExprTypeVar bname) | aname == bname = do
@@ -127,10 +127,10 @@ unifyExpr off pa expr = if
| Just (Refl :: a :~: b) <- eqT
-> return expr
- | DynVariable tvar name <- expr
+ | DynVariable tvar sline name <- expr
-> do
_ <- unify off (ExprTypePrim (Proxy :: Proxy a)) (ExprTypeVar tvar)
- return $ Variable name
+ return $ Variable sline name
| Just (Refl :: FunctionType a :~: b) <- eqT
-> do
@@ -198,3 +198,13 @@ listOf :: TestParser a -> TestParser [a]
listOf item = do
x <- item
(x:) <$> choice [ symbol "," >> listOf item, return [] ]
+
+
+getSourceLine :: TestParser SourceLine
+getSourceLine = do
+ pstate <- statePosState <$> getParserState
+ return $ SourceLine $ T.concat
+ [ T.pack $ sourcePosPretty $ pstateSourcePos pstate
+ , T.pack ": "
+ , TL.toStrict $ TL.takeWhile (/='\n') $ pstateInput pstate
+ ]
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index 04035c1..8ae0f77 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -66,8 +66,9 @@ someExpansion = do
void $ char '$'
choice
[do off <- stateOffset <$> getParserState
+ sline <- getSourceLine
name <- VarName . TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_')
- lookupVarExpr off name
+ lookupVarExpr off sline name
, between (char '{') (char '}') someExpr
]
@@ -348,9 +349,10 @@ literal = label "literal" $ choice
variable :: TestParser SomeExpr
variable = label "variable" $ do
off <- stateOffset <$> getParserState
+ sline <- getSourceLine
name <- varName
- lookupVarExpr off name >>= \case
- SomeExpr e'@(FunVariable (FunctionArguments argTypes) _) -> do
+ lookupVarExpr off sline name >>= \case
+ SomeExpr e'@(FunVariable (FunctionArguments argTypes) _ _) -> do
let check poff kw expr = do
case M.lookup kw argTypes of
Just expected -> do
@@ -364,7 +366,7 @@ variable = label "variable" $ do
Nothing -> "unexpected parameter"
return expr
- args <- functionArguments check someExpr literal (\poff -> lookupVarExpr poff . VarName)
+ args <- functionArguments check someExpr literal (\poff -> lookupVarExpr poff sline . VarName)
return $ SomeExpr $ ArgsApp args e'
e -> do
return e
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs
index 94a5583..6434a53 100644
--- a/src/Parser/Statement.hs
+++ b/src/Parser/Statement.hs
@@ -8,9 +8,8 @@ import Control.Monad.State
import Data.Kind
import Data.Maybe
-import qualified Data.Set as S
+import Data.Set qualified as S
import Data.Text qualified as T
-import qualified Data.Text.Lazy as TL
import Data.Typeable
import Text.Megaparsec hiding (State)
@@ -24,16 +23,6 @@ import Process (Process)
import Test
import Util
-getSourceLine :: TestParser SourceLine
-getSourceLine = do
- pstate <- statePosState <$> getParserState
- return $ SourceLine $ T.concat
- [ T.pack $ sourcePosPretty $ pstateSourcePos pstate
- , T.pack ": "
- , TL.toStrict $ TL.takeWhile (/='\n') $ pstateInput pstate
- ]
-
-
letStatement :: TestParser [TestStep]
letStatement = do
line <- getSourceLine
@@ -313,11 +302,6 @@ testFlush = command "flush" $ Flush
<$> paramOrContext "from"
<*> param ""
-testGuard :: TestParser [TestStep]
-testGuard = command "guard" $ Guard
- <$> cmdLine
- <*> param ""
-
testDisconnectNode :: TestParser [TestStep]
testDisconnectNode = command "disconnect_node" $ DisconnectNode
<$> paramOrContext ""
@@ -364,7 +348,6 @@ testStep = choice
, testSend
, testExpect
, testFlush
- , testGuard
, testDisconnectNode
, testDisconnectNodes
, testDisconnectUpstream