summaryrefslogtreecommitdiff
path: root/src/Test
diff options
context:
space:
mode:
Diffstat (limited to 'src/Test')
-rw-r--r--src/Test/Builtins.hs18
1 files changed, 16 insertions, 2 deletions
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 ]