diff options
Diffstat (limited to 'src/Parser.hs')
| -rw-r--r-- | src/Parser.hs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/src/Parser.hs b/src/Parser.hs index 5d545af..cba119b 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -221,23 +221,24 @@ parseTestModule absPath = do eof return Module {..} -parseTestFiles :: [ FilePath ] -> IO (Either CustomTestError ( [ Module ], [ Module ] )) -parseTestFiles paths = do +parseTestFiles :: [ SomePrimType ] -> [ FilePath ] -> IO (Either CustomTestError ( [ Module ], [ Module ] )) +parseTestFiles builtinTypes paths = do parsedModules <- newIORef [] runExceptT $ do requestedModules <- reverse <$> foldM (go parsedModules) [] paths allModules <- map snd <$> liftIO (readIORef parsedModules) return ( requestedModules, allModules ) where + builtinTypes' = map (\(SomePrimType p) -> ( VarName (textExprType p), ExprTypePrim p )) builtinTypes go parsedModules res path = do - liftIO (parseTestFile parsedModules Nothing path) >>= \case + liftIO (parseTestFile builtinTypes' parsedModules Nothing path) >>= \case Left err -> do throwError err Right cur -> do return $ cur : res -parseTestFile :: IORef [ ( FilePath, Module ) ] -> Maybe ModuleName -> FilePath -> IO (Either CustomTestError Module) -parseTestFile parsedModules mbModuleName path = do +parseTestFile :: [ ( VarName, SomeExprType ) ] -> IORef [ ( FilePath, Module ) ] -> Maybe ModuleName -> FilePath -> IO (Either CustomTestError Module) +parseTestFile builtinTypes parsedModules mbModuleName path = do absPath <- makeAbsolute path (lookup absPath <$> readIORef parsedModules) >>= \case Just found -> return $ Right found @@ -247,13 +248,14 @@ parseTestFile parsedModules mbModuleName path = do , testVars = concat [ map (\(( mname, name ), value ) -> ( name, ( GlobalVarName mname name, someExprType value ))) $ M.toList builtins ] + , testTypeVars = builtinTypes , testContext = SomeExpr (Undefined "void" :: Expr Void) , testNextTypeVar = 0 , testTypeUnif = M.empty , testCurrentModuleName = fromMaybe (error "current module name should be set at the beginning of parseTestModule") mbModuleName , testParseModule = \(ModuleName current) mname@(ModuleName imported) -> do let projectRoot = iterate takeDirectory absPath !! length current - parseTestFile parsedModules (Just mname) $ projectRoot </> foldr (</>) "" (map T.unpack imported) <.> takeExtension absPath + parseTestFile builtinTypes parsedModules (Just mname) $ projectRoot </> foldr (</>) "" (map T.unpack imported) <.> takeExtension absPath } mbContent <- (Just <$> TL.readFile path) `catchIOError` \e -> if isDoesNotExistError e then return Nothing else ioError e |