summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-02-20 19:50:36 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2023-02-20 19:50:36 +0100
commit82e4bdcaaefa88913a0dacf3496747251909219f (patch)
treeb649928867f520681491b3488a17a8f52f681550
parentf8c6706d5eefb8e4ebcdee7c963e8fe22fd9efab (diff)
For statement
-rw-r--r--src/Main.hs11
-rw-r--r--src/Parser.hs32
-rw-r--r--src/Test.hs3
3 files changed, 41 insertions, 5 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 81fb04f..404ecec 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -172,7 +172,7 @@ testStepGuard sline expr = do
evalSteps :: [TestStep] -> TestRun ()
evalSteps = mapM_ $ \case
- Let (SourceLine sline) name expr inner -> do
+ Let (SourceLine sline) (TypedVarName name) expr inner -> do
cur <- asks (lookup name . tsVars . snd)
when (isJust cur) $ do
outLine OutputError Nothing $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline
@@ -180,6 +180,15 @@ evalSteps = mapM_ $ \case
value <- eval expr
withVar name value $ evalSteps inner
+ For (SourceLine sline) (TypedVarName name) expr inner -> do
+ cur <- asks (lookup name . tsVars . snd)
+ when (isJust cur) $ do
+ outLine OutputError Nothing $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline
+ throwError Failed
+ value <- eval expr
+ forM_ value $ \i -> do
+ withVar name i $ evalSteps inner
+
DeclNode name@(TypedVarName vname) net inner -> do
createNode net (Left name) $ \node -> do
withVar vname node $ evalSteps inner
diff --git a/src/Parser.hs b/src/Parser.hs
index 19a1cf0..9ba702b 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -387,13 +387,38 @@ letStatement = do
off <- stateOffset <$> getParserState
name <- varName
osymbol "="
- SomeExpr (e :: Expr a) <- someExpr
+ SomeExpr e <- someExpr
localState $ do
- addVarName off $ TypedVarName @a name
+ let tname = TypedVarName name
+ addVarName off tname
void $ eol
body <- testBlock indent
- return [Let line name e body]
+ return [Let line tname e body]
+
+forStatement :: TestParser [TestStep]
+forStatement = do
+ line <- getSourceLine
+ ref <- L.indentLevel
+ wsymbol "for"
+ voff <- stateOffset <$> getParserState
+ name <- varName
+
+ wsymbol "in"
+ loff <- stateOffset <$> getParserState
+ SomeExpr e <- someExpr
+ 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
+
+ symbol ":"
+ scn
+ indent <- L.indentGuard scn GT ref
+ localState $ do
+ let tname = TypedVarName name
+ addVarName voff tname
+ body <- testBlock indent
+ return [For line tname (UnOp unpack e) body]
class (Typeable a, Typeable (ParamRep a)) => ParamType a where
type ParamRep a :: Type
@@ -634,6 +659,7 @@ testBlock indent = concat <$> go
testStep :: TestParser [TestStep]
testStep = choice
[ letStatement
+ , forStatement
, testLocal
, testWith
, testNode
diff --git a/src/Test.hs b/src/Test.hs
index 88be0dc..6460daf 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -33,7 +33,8 @@ data Test = Test
, testSteps :: [TestStep]
}
-data TestStep = forall a. ExprType a => Let SourceLine VarName (Expr a) [TestStep]
+data TestStep = forall a. ExprType a => Let SourceLine (TypedVarName a) (Expr a) [TestStep]
+ | forall a. ExprType a => For SourceLine (TypedVarName a) (Expr [a]) [TestStep]
| DeclNode (TypedVarName Node) (Expr Network) [TestStep]
| Spawn (TypedVarName Process) (Either (TypedVarName Node) (Either (Expr Network) (Expr Node))) [TestStep]
| Send (Expr Process) (Expr Text)