diff options
Diffstat (limited to 'src/Parser.hs')
-rw-r--r-- | src/Parser.hs | 33 |
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 |