Reorganize Parser method

pull/25/head
Ethan Reece 2023-09-30 04:07:45 -05:00
parent 01ff098530
commit d14c5ace00
Signed by: me
GPG Key ID: D3993665FF92E1C3
4 changed files with 30 additions and 33 deletions

View File

@ -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

View File

@ -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'..."

View File

@ -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
parse :: Text -> Expr
parse t = do
case parseExpr t of
Right r -> r
-- TODO: add error handling

View File

@ -6,7 +6,7 @@ data Expr
| Sub Expr Expr
| Mul Expr Expr
| Div Expr Expr
| Print Expr
deriving
( -- | Pop Expr Expr
Show
( Show
)