From 0cbbe31c5f16df73dcc3a73b37cac4a72948f3a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Thu, 27 Aug 2026 20:34:57 +0200 Subject: Accept various builtin types in type expressions --- src/Parser.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'src/Parser.hs') 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 -- cgit v1.2.3