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/Test/Builtins.hs | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

(limited to 'src/Test/Builtins.hs')

diff --git a/src/Test/Builtins.hs b/src/Test/Builtins.hs
index 2ab38aa..b768bb9 100644
--- a/src/Test/Builtins.hs
+++ b/src/Test/Builtins.hs
@@ -2,12 +2,26 @@ module Test.Builtins (
     builtins,
 ) where
 
+import Data.Map qualified as M
+import Data.Typeable
+
 import Test
 
 builtins :: [ ( VarName, SomeVarValue ) ]
 builtins =
-    [ ( VarName "wait", builtinWait )
+    [ ( VarName "guard", builtinGuard )
+    , ( VarName "wait", builtinWait )
     ]
 
+getArg :: Typeable a => FunctionArguments SomeExpr -> Maybe ArgumentKeyword -> a
+getArg (FunctionArguments args) kw =
+    case M.lookup kw args of
+        Just (SomeExpr expr) | Just expr' <- cast expr -> expr'
+        _ -> error "parameter mismatch"
+
+builtinGuard :: SomeVarValue
+builtinGuard = SomeVarValue (FunctionArguments $ M.singleton Nothing (ExprTypePrim (Proxy @Bool))) $
+    \sline args -> TestBlock [ Guard sline (getArg args Nothing) ]
+
 builtinWait :: SomeVarValue
-builtinWait = SomeVarValue mempty $ const $ TestBlock [ Wait ]
+builtinWait = SomeVarValue mempty $ const . const $ TestBlock [ Wait ]
-- 
cgit v1.2.3