diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2023-02-20 19:50:36 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-02-20 19:50:36 +0100 |
commit | 82e4bdcaaefa88913a0dacf3496747251909219f (patch) | |
tree | b649928867f520681491b3488a17a8f52f681550 | |
parent | f8c6706d5eefb8e4ebcdee7c963e8fe22fd9efab (diff) |
For statement
-rw-r--r-- | src/Main.hs | 11 | ||||
-rw-r--r-- | src/Parser.hs | 32 | ||||
-rw-r--r-- | src/Test.hs | 3 |
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) |