summaryrefslogtreecommitdiff
path: root/src/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parser.hs')
-rw-r--r--src/Parser.hs33
1 files changed, 27 insertions, 6 deletions
diff --git a/src/Parser.hs b/src/Parser.hs
index 3c43a69..e63f854 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -6,8 +6,8 @@ module Parser (
import Control.Monad
import Control.Monad.State
-import Control.Monad.Writer
+import Data.Map qualified as M
import Data.Maybe
import Data.Set qualified as S
import Data.Text qualified as T
@@ -16,6 +16,7 @@ import Data.Text.Lazy.IO qualified as TL
import Text.Megaparsec hiding (State)
import Text.Megaparsec.Char
+import Text.Megaparsec.Char.Lexer qualified as L
import System.Directory
import System.Exit
@@ -27,13 +28,29 @@ import Parser.Statement
import Test
import Test.Builtins
-parseTestDefinition :: TestParser ()
+parseTestDefinition :: TestParser Toplevel
parseTestDefinition = label "test definition" $ toplevel ToplevelTest $ do
block (\name steps -> return $ Test name $ concat steps) header testStep
where header = do
wsymbol "test"
lexeme $ TL.toStrict <$> takeWhileP (Just "test name") (/=':')
+parseDefinition :: TestParser Toplevel
+parseDefinition = label "symbol definition" $ toplevel ToplevelDefinition $ do
+ def <- localState $ L.indentBlock scn $ do
+ wsymbol "def"
+ name <- varName
+ choice
+ [ do
+ symbol ":"
+ let finish steps = do
+ return $ ( name, ) $ SomeVarValue mempty $ \_ _ -> TestBlock $
+ concat steps
+ return $ L.IndentSome Nothing finish testStep
+ ]
+ modify $ \s -> s { testVars = fmap someVarValueType def : testVars s }
+ return def
+
parseTestModule :: FilePath -> TestParser Module
parseTestModule absPath = do
moduleName <- choice
@@ -50,12 +67,14 @@ parseTestModule absPath = do
, do
return $ [ T.pack $ takeBaseName absPath ]
]
- (_, toplevels) <- listen $ many $ choice
+ toplevels <- many $ choice
[ parseTestDefinition
+ , parseDefinition
]
- let moduleTests = catMaybes $ map (\case ToplevelTest x -> Just x; {- _ -> Nothing -}) toplevels
+ let moduleTests = catMaybes $ map (\case ToplevelTest x -> Just x; _ -> Nothing) toplevels
+ moduleDefinitions = catMaybes $ map (\case ToplevelDefinition x -> Just x; _ -> Nothing) toplevels
eof
- return Module { .. }
+ return Module {..}
parseTestFile :: FilePath -> IO Module
parseTestFile path = do
@@ -66,8 +85,10 @@ parseTestFile path = do
[ map (fmap someVarValueType) builtins
]
, testContext = SomeExpr RootNetwork
+ , testNextTypeVar = 0
+ , testTypeUnif = M.empty
}
- (res, _) = flip evalState initState $ runWriterT $ runParserT (parseTestModule absPath) path content
+ res = runTestParser path content initState $ parseTestModule absPath
case res of
Left err -> putStr (errorBundlePretty err) >> exitFailure