From d14c5ace00ba4f87665ea8ff0d4b3a27c35e36f5 Mon Sep 17 00:00:00 2001 From: sudoer777 Date: Sat, 30 Sep 2023 04:07:45 -0500 Subject: [PATCH] Reorganize Parser method --- really-bad-compiler-in-haskell.cabal | 6 ++-- src/Main.hs | 10 ++----- src/Main/Parser/Megaparsec.hs | 43 +++++++++++++++------------- src/Main/Types/Expr.hs | 4 +-- 4 files changed, 30 insertions(+), 33 deletions(-) diff --git a/really-bad-compiler-in-haskell.cabal b/really-bad-compiler-in-haskell.cabal index d55ad95..13f796f 100644 --- a/really-bad-compiler-in-haskell.cabal +++ b/really-bad-compiler-in-haskell.cabal @@ -16,9 +16,9 @@ tested-with: executable really-bad-compiler-in-haskell main-is: Main.hs other-modules: - Forth.LLVMGen - Forth.Parser - Forth.Types.Expr + Main.LLVMGen + Main.Parser.Megaparsec + Main.Types.Expr Paths_really_bad_compiler_in_haskell hs-source-dirs: src diff --git a/src/Main.hs b/src/Main.hs index f8a556f..7c4d935 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,25 +3,19 @@ module Main (main) where --- import Compiler.ExeGen - import Data.ByteString.Char8 qualified as B -import Data.Text.Lazy.IO qualified as T +import Data.Text.IO qualified as T import Main.LLVMGen import Main.Parser.Megaparsec -import Main.Types.Expr import System.Environment import System.Process -getRight :: ParseResult -> Expr -getRight (Right r) = r - main :: IO () main = do fileName <- fmap head getArgs contents <- T.readFile fileName T.putStrLn "- Parsing file..." - let parsed = getRight (parseExpr contents) + let parsed = parse contents T.putStrLn "- Generating LLVM to './a.out.ll'..." llvmGen parsed >>= B.writeFile "a.out.ll" T.putStrLn "- Compiling to executable './a.out'..." diff --git a/src/Main/Parser/Megaparsec.hs b/src/Main/Parser/Megaparsec.hs index e1c9f27..e78c623 100644 --- a/src/Main/Parser/Megaparsec.hs +++ b/src/Main/Parser/Megaparsec.hs @@ -2,30 +2,31 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} -module Main.Parser.Megaparsec (parseExpr, ParseResult) where +module Main.Parser.Megaparsec (parse) where import Control.Monad.Combinators.Expr import Data.Functor.Identity qualified -import Data.Text.Lazy +import Data.Text import Data.Void (Void) import Main.Types.Expr -import Text.Megaparsec as MP -import Text.Megaparsec.Char as C -import Text.Megaparsec.Char.Lexer as L +import Text.Megaparsec as MP hiding (parse) +import Text.Megaparsec qualified as MP +import Text.Megaparsec.Char qualified as C +import Text.Megaparsec.Char.Lexer qualified as L type Parser = Parsec Void Text -lexemeParser :: Parser a -> Parser a -lexemeParser = L.lexeme C.space +lexeme :: Parser a -> Parser a +lexeme = L.lexeme C.space -symbolParser :: Text -> Parser Text -symbolParser = L.symbol C.space +symbol :: Text -> Parser Text +symbol = L.symbol C.space -intParser :: Parser Int -intParser = lexemeParser L.decimal +int :: Parser Int +int = lexeme L.decimal term :: Parser Expr -term = Lit <$> intParser +term = Lit <$> int table :: [[Operator Parser Expr]] table = @@ -34,25 +35,27 @@ table = ], [ binaryOp "+" Add, binaryOp "-" Sub - -- binaryOp "." Pop ] ] binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a -binaryOp name f = InfixL (f <$ symbolParser name) +binaryOp name f = InfixL (f <$ symbol name) prefixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a -prefixOp name f = Prefix (f <$ symbolParser name) +prefixOp name f = Prefix (f <$ symbol name) postfixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a -postfixOp name f = Postfix (f <$ symbolParser name) +postfixOp name f = Postfix (f <$ symbol name) expr :: Parser Expr expr = makeExprParser term table -type ParseResult = Either (ParseErrorBundle Text Void) Expr - -parseExpr :: Text -> ParseResult +parseExpr :: Text -> Either (ParseErrorBundle Text Void) Expr parseExpr = MP.parse (C.space *> expr <* eof) "" --- parseE = parseExpr \ No newline at end of file +parse :: Text -> Expr +parse t = do + case parseExpr t of + Right r -> r + +-- TODO: add error handling \ No newline at end of file diff --git a/src/Main/Types/Expr.hs b/src/Main/Types/Expr.hs index 30f0a1d..9fc0b32 100644 --- a/src/Main/Types/Expr.hs +++ b/src/Main/Types/Expr.hs @@ -6,7 +6,7 @@ data Expr | Sub Expr Expr | Mul Expr Expr | Div Expr Expr + | Print Expr deriving - ( -- | Pop Expr Expr - Show + ( Show ) \ No newline at end of file