Reorganize Parser method

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
+      Main.LLVMGen
-      Forth.Parser
+      Main.Parser.Megaparsec
-      Forth.Types.Expr
+      Main.Types.Expr
       Paths_really_bad_compiler_in_haskell
   hs-source-dirs:
       src

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

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 as MP hiding (parse)
-import Text.Megaparsec.Char as C
+import Text.Megaparsec qualified as MP
-import Text.Megaparsec.Char.Lexer as L
+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
+lexeme :: Parser a -> Parser a
-lexemeParser = L.lexeme C.space
+lexeme = L.lexeme C.space
 
-symbolParser :: Text -> Parser Text
+symbol :: Text -> Parser Text
-symbolParser = L.symbol C.space
+symbol = L.symbol C.space
 
-intParser :: Parser Int
+int :: Parser Int
-intParser = lexemeParser L.decimal
+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 -> Either (ParseErrorBundle Text Void) Expr
-
-parseExpr :: Text -> ParseResult
 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

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
     )