From c72455c9f4203ab7b9c617f26ffa7e5fdabf2d5f Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Sat, 10 Sep 2022 19:36:45 +0100 Subject: Revisited parser interface --- app/Main.hs | 5 ++- src/Micro/Parser.hs | 18 +++++++--- test/Language.hs | 98 ++++++++++++++++++++++++++--------------------------- 3 files changed, 63 insertions(+), 58 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 9cf5d75..fb3c132 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,8 +6,7 @@ import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Micro.Compiler import Micro.Error (showErrorList, showParserError) -import Micro.Lexer (scan) -import Micro.Parser (parse, parseFromFile) +import Micro.Parser import System.Console.GetOpt import System.Environment (getProgName) import System.Environment.Blank (getArgs) @@ -64,7 +63,7 @@ usage progName errs compileFile :: String -> Bool -> IO () compileFile filename onlyParse = do - res <- parseFromFile (scan parse) filename + res <- parseFromFile filename case res of Left err -> hPutStrLn stderr (showParserError err) >> exitFailure Right ast -> do diff --git a/src/Micro/Parser.hs b/src/Micro/Parser.hs index ea4873e..45ba44d 100644 --- a/src/Micro/Parser.hs +++ b/src/Micro/Parser.hs @@ -1,4 +1,9 @@ -module Micro.Parser where +module Micro.Parser + ( Micro.Parser.parse, + parseFromFile, + parseFromString, + ) +where import Control.Monad.Identity (Identity) import Data.Maybe (isJust) @@ -217,7 +222,10 @@ program = do parse :: Parser [Expr] parse = program -parseFromFile :: Parsec String () a -> FilePath -> IO (Either ParseError a) -parseFromFile p fname = do - input <- readFile fname - return (runParser p () fname input) +parseFromFile :: FilePath -> IO (Either ParseError [Expr]) +parseFromFile filename = do + input <- readFile filename + return $ runParser (scan Micro.Parser.parse) () filename input + +parseFromString :: String -> Either ParseError [Expr] +parseFromString input = runParser (scan Micro.Parser.parse) () "-" input diff --git a/test/Language.hs b/test/Language.hs index 95d5e75..6bedc68 100644 --- a/test/Language.hs +++ b/test/Language.hs @@ -5,22 +5,20 @@ import Data.Foldable (find) import qualified Micro.Ast as A import Micro.Compiler import qualified Micro.Error as E -import Micro.Lexer (scan) -import Micro.Parser (parse) +import Micro.Parser (parseFromString) import Test.HUnit -import Text.Parsec (runParser) import Text.Parsec.Pos (newPos) assertAst :: String -> [A.Expr] -> Assertion assertAst input expected = do - r <- return $ runParser (scan parse) () "test" input + r <- return $ parseFromString input case r of Left e -> assertFailure $ show e Right ast -> assertEqual "" expected ast expectError :: String -> E.ErrorType -> Assertion expectError input etyp = do - r <- return $ runParser (scan parse) () "test" input + r <- return $ parseFromString input case r of Left e -> assertFailure $ show e Right ast -> do @@ -34,15 +32,15 @@ expectError input etyp = do testCase1 = TestLabel "parse module" $ TestCase $ - assertAst "module main" [A.Module "main" $ newPos "test" 1 1] + assertAst "module main" [A.Module "main" $ newPos "-" 1 1] testCase2 = TestLabel "parse binary number" $ TestCase $ assertAst "module main\n0b100000;" - [ A.Module "main" $ newPos "test" 1 1, - A.Num 32 $ newPos "test" 2 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Num 32 $ newPos "-" 2 1 ] testCase3 = @@ -52,8 +50,8 @@ testCase3 = assertAst "module main\n\ \def fn() { }" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn" [] Nothing [] False False $ newPos "test" 2 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn" [] Nothing [] False False $ newPos "-" 2 1 ] testCase4 = @@ -63,8 +61,8 @@ testCase4 = assertAst "module main\n\ \def fn(a: u8) { }" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn" [("a", A.Type "u8", True, newPos "test" 2 8)] Nothing [] False False $ newPos "test" 2 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn" [("a", A.Type "u8", True, newPos "-" 2 8)] Nothing [] False False $ newPos "-" 2 1 ] testCase5 = @@ -75,8 +73,8 @@ testCase5 = "module main\n\ \def fn(): u8 {\n\ \return 1; }" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn" [] (Just $ A.Type "u8") [A.Return (Just $ A.Num 1 $ newPos "test" 3 8) $ newPos "test" 3 1] False False $ newPos "test" 2 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn" [] (Just $ A.Type "u8") [A.Return (Just $ A.Num 1 $ newPos "-" 3 8) $ newPos "-" 3 1] False False $ newPos "-" 2 1 ] testCase6 = @@ -87,9 +85,9 @@ testCase6 = "module main\n\ \def fn() { }\n\ \fn();" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn" [] Nothing [] False False $ newPos "test" 2 1, - A.Call (A.Variable "fn" $ newPos "test" 3 1) [] $ newPos "test" 3 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn" [] Nothing [] False False $ newPos "-" 2 1, + A.Call (A.Variable "fn" $ newPos "-" 3 1) [] $ newPos "-" 3 1 ] testCase7 = @@ -100,9 +98,9 @@ testCase7 = "module main\n\ \def fn(a: u8) { }\n\ \fn(10);" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn" [("a", A.Type "u8", True, newPos "test" 2 8)] Nothing [] False False $ newPos "test" 2 1, - A.Call (A.Variable "fn" $ newPos "test" 3 1) [A.Num 10 $ newPos "test" 3 4] $ newPos "test" 3 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn" [("a", A.Type "u8", True, newPos "-" 2 8)] Nothing [] False False $ newPos "-" 2 1, + A.Call (A.Variable "fn" $ newPos "-" 3 1) [A.Num 10 $ newPos "-" 3 4] $ newPos "-" 3 1 ] testCase8 = @@ -113,8 +111,8 @@ testCase8 = "module main\n\ \def fn() {\n\ \return; }" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn" [] Nothing [A.Return Nothing $ newPos "test" 3 1] False False $ newPos "test" 2 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn" [] Nothing [A.Return Nothing $ newPos "-" 3 1] False False $ newPos "-" 2 1 ] testCase9 = @@ -125,8 +123,8 @@ testCase9 = "module main\n\ \def fn() {\n\ \fn(); }" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn" [] Nothing [A.Call (A.Variable "fn" $ newPos "test" 3 1) [] $ newPos "test" 3 1] False False $ newPos "test" 2 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn" [] Nothing [A.Call (A.Variable "fn" $ newPos "-" 3 1) [] $ newPos "-" 3 1] False False $ newPos "-" 2 1 ] testCase10 = @@ -139,18 +137,18 @@ testCase10 = \def fn2(f: ()) {\n\ \f(); }\n\ \fn2(fn1);" - [ A.Module "main" $ newPos "test" 1 1, - A.Func "fn1" [] Nothing [] False False $ newPos "test" 2 1, + [ A.Module "main" $ newPos "-" 1 1, + A.Func "fn1" [] Nothing [] False False $ newPos "-" 2 1, A.Func "fn2" - [("f", A.FuncType [] Nothing, True, newPos "test" 3 9)] + [("f", A.FuncType [] Nothing, True, newPos "-" 3 9)] Nothing - [ A.Call (A.Variable "f" $ newPos "test" 4 1) [] $ newPos "test" 4 1 + [ A.Call (A.Variable "f" $ newPos "-" 4 1) [] $ newPos "-" 4 1 ] False False - $ newPos "test" 3 1, - A.Call (A.Variable "fn2" $ newPos "test" 5 1) [A.Variable "fn1" $ newPos "test" 5 5] $ newPos "test" 5 1 + $ newPos "-" 3 1, + A.Call (A.Variable "fn2" $ newPos "-" 5 1) [A.Variable "fn1" $ newPos "-" 5 5] $ newPos "-" 5 1 ] testCase11 = @@ -162,16 +160,16 @@ testCase11 = \def fn(f: ()) {\n\ \f(); }\n\ \fn(() { });" - [ A.Module "main" $ newPos "test" 1 1, + [ A.Module "main" $ newPos "-" 1 1, A.Func "fn" - [("f", A.FuncType [] Nothing, True, newPos "test" 2 8)] + [("f", A.FuncType [] Nothing, True, newPos "-" 2 8)] Nothing - [A.Call (A.Variable "f" $ newPos "test" 3 1) [] $ newPos "test" 3 1] + [A.Call (A.Variable "f" $ newPos "-" 3 1) [] $ newPos "-" 3 1] False False - $ newPos "test" 2 1, - A.Call (A.Variable "fn" $ newPos "test" 4 1) [A.Func "lambda@4,4" [] Nothing [] True True $ newPos "test" 4 4] $ newPos "test" 4 1 + $ newPos "-" 2 1, + A.Call (A.Variable "fn" $ newPos "-" 4 1) [A.Func "lambda@4,4" [] Nothing [] True True $ newPos "-" 4 4] $ newPos "-" 4 1 ] testCase12 = @@ -180,8 +178,8 @@ testCase12 = assertAst "module main\n\ \() { }();" - [ A.Module "main" $ newPos "test" 1 1, - A.Call (A.Func "lambda@2,1" [] Nothing [] True True $ newPos "test" 2 1) [] $ newPos "test" 2 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Call (A.Func "lambda@2,1" [] Nothing [] True True $ newPos "-" 2 1) [] $ newPos "-" 2 1 ] testCase13 = @@ -190,8 +188,8 @@ testCase13 = assertAst "module main\n\ \var a: u8 = 10;" - [ A.Module "main" $ newPos "test" 1 1, - A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "test" 2 13) False $ newPos "test" 2 5 + [ A.Module "main" $ newPos "-" 1 1, + A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 13) False $ newPos "-" 2 5 ] testCase14 = @@ -200,8 +198,8 @@ testCase14 = assertAst "module main\n\ \private var a: u8 = 10;" - [ A.Module "main" $ newPos "test" 1 1, - A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "test" 2 21) True $ newPos "test" 2 13 + [ A.Module "main" $ newPos "-" 1 1, + A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 21) True $ newPos "-" 2 13 ] testCase15 = @@ -211,9 +209,9 @@ testCase15 = "module main\n\ \var (a: u8 = 10,\n\ \b: bool = true);" - [ A.Module "main" $ newPos "test" 1 1, - A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "test" 2 14) False $ newPos "test" 2 6, - A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "test" 3 11) False $ newPos "test" 3 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 14) False $ newPos "-" 2 6, + A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "-" 3 11) False $ newPos "-" 3 1 ] testCase16 = @@ -223,9 +221,9 @@ testCase16 = "module main\n\ \private var (a: u8 = 10,\n\ \b: bool = true);" - [ A.Module "main" $ newPos "test" 1 1, - A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "test" 2 22) True $ newPos "test" 2 14, - A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "test" 3 11) True $ newPos "test" 3 1 + [ A.Module "main" $ newPos "-" 1 1, + A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "-" 2 22) True $ newPos "-" 2 14, + A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "-" 3 11) True $ newPos "-" 3 1 ] testCase17 = @@ -235,9 +233,9 @@ testCase17 = "module main\n\ \var a: u8 = 0;\n\ \a = 10;" - [ A.Module "main" $ newPos "test" 1 1, - A.Var "a" (A.Type "u8") (A.Num 0 $ newPos "test" 2 13) False $ newPos "test" 2 5, - A.BinOp A.Assign (newPos "test" 3 5) (A.Variable "a" $ newPos "test" 3 1) (A.Num 10 $ newPos "test" 3 5) + [ A.Module "main" $ newPos "-" 1 1, + A.Var "a" (A.Type "u8") (A.Num 0 $ newPos "-" 2 13) False $ newPos "-" 2 5, + A.BinOp A.Assign (newPos "-" 3 5) (A.Variable "a" $ newPos "-" 3 1) (A.Num 10 $ newPos "-" 3 5) ] -- test errors -- cgit v1.2.3