From 213e3523aead4c18b65ac85886203d2508b9b27e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 23 Sep 2024 19:44:17 +0200
Subject: Implement "guard" as a builtin

---
 src/Parser/Core.hs      | 24 +++++++++++++++++-------
 src/Parser/Expr.hs      | 10 ++++++----
 src/Parser/Statement.hs | 19 +------------------
 3 files changed, 24 insertions(+), 29 deletions(-)

(limited to 'src/Parser')

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
-- 
cgit v1.2.3