Add parenthesis

README.md

@@ -1,6 +1,8 @@
 # Really Bad Compiler in Haskell
 
-A compiler written in Haskell which can currently perform basic arithmetic. Currently using the megaparsec and llvm-hs-\* libraries, but I may reimplement certain libraries myself. Built for the Introduction to Compiler Design class at The University of Texas at Dallas.
+A compiler for Hear, a language for when you cannot C.
+
+Written in Haskell, and currently using the megaparsec and llvm-hs-\* libraries, but I plan to eventually rewrite the lexar/parser from scratch. Built for the Introduction to Compiler Design class at The University of Texas at Dallas.
 
 Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
 
@@ -12,7 +14,7 @@ Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
 
 ## Run Instructions
 
-- Use `stack run <file>` to run the program (for example, `stack run example/1`).
+- Use `stack run <file>` to run the program (for example, `stack run example/1.hear`).
 - The LLVM will be generated as `a.out.ll`, and the executable will be generated as `a.out`.
 
 ## To edit

example/1

@@ -1 +0,0 @@
-5*3+2

example/1.hear

@@ -0,0 +1 @@
+(5*(3-2)+-4-4)

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/Forth/Parser.hs

@@ -1,58 +0,0 @@
--- see https://markkarpov.com/tutorial/megaparsec.html
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Forth.Parser (parseExpr, ParseResult) where
-
-import Control.Monad.Combinators.Expr
-import Data.Functor.Identity qualified
-import Data.Text.Lazy
-import Data.Void (Void)
-import Forth.Types.Expr
-import Text.Megaparsec as MP
-import Text.Megaparsec.Char as C
-import Text.Megaparsec.Char.Lexer as L
-
-type Parser = Parsec Void Text
-
-lexemeParser :: Parser a -> Parser a
-lexemeParser = L.lexeme C.space
-
-symbolParser :: Text -> Parser Text
-symbolParser = L.symbol C.space
-
-intParser :: Parser Int
-intParser = lexemeParser L.decimal
-
-term :: Parser Expr
-term = Lit <$> intParser
-
-table :: [[Operator Parser Expr]]
-table =
-  [ [ binaryOp "*" Mul,
-      binaryOp "/" Div
-    ],
-    [ 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)
-
--- prefixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
--- prefixOp name f = Prefix (f <$ symbolParser name)
-
--- postfixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
--- postfixOp name f = Postfix (f <$ symbolParser name)
-
-expr :: Parser Expr
-expr = makeExprParser term table
-
-type ParseResult = Either (ParseErrorBundle Text Void) Expr
-
-parseExpr :: Text -> ParseResult
-parseExpr = MP.parse (C.space *> expr <* eof) ""
-
--- parseE = parseExpr

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 Forth.LLVMGen
+import Main.LLVMGen
-import Forth.Parser
+import Main.Parser.Megaparsec
-import Forth.Types.Expr
 import System.Environment
-import System.Process
+import System.Process (callCommand)
-
-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/LLVMGen.hs

@@ -4,10 +4,9 @@
 
 -- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
 
-module Forth.LLVMGen (llvmGen) where
+module Main.LLVMGen (llvmGen) where
 
 import Data.ByteString (ByteString)
-import Forth.Types.Expr as Expr
 import LLVM (moduleLLVMAssembly, withModuleFromAST)
 import LLVM.AST hiding (function)
 import LLVM.AST.Type
@@ -16,6 +15,7 @@ import LLVM.IRBuilder.Constant
 import LLVM.IRBuilder.Instruction
 import LLVM.IRBuilder.Module
 import LLVM.IRBuilder.Monad
+import Main.Types.Expr as Expr
 
 getLLVM :: Expr -> Module
 getLLVM expr =
@@ -35,6 +35,7 @@ exprToLLVM ::
   Expr ->
   m Operand
 exprToLLVM (Lit prim) = pure $ primToLLVM prim
+exprToLLVM (Paren e) = exprToLLVM e
 exprToLLVM (Expr.Add a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b

src/Main/Parser/Megaparsec.hs

@@ -0,0 +1,75 @@
+-- see https://markkarpov.com/tutorial/megaparsec.html
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main.Parser.Megaparsec (parse) where
+
+import Control.Monad.Combinators.Expr
+import Data.Functor.Identity qualified
+import Data.Text
+import Data.Void (Void)
+import Main.Types.Expr
+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
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme C.space
+
+symbol :: Text -> Parser Text
+symbol = L.symbol C.space
+
+int :: Parser Int
+int = lexeme $ L.signed (return ()) L.decimal
+
+string :: Text -> Parser Text
+string = C.string
+
+container :: Text -> Text -> Parser a -> Parser a
+container b e = between (symbol b) (symbol e)
+
+term :: Parser Expr
+term =
+  choice
+    [ Lit <$> int,
+      container "(" ")" expr
+    ]
+
+table :: [[Operator Parser Expr]]
+table =
+  [ [methodOp "print" Print],
+    [ binaryOp "*" Mul,
+      binaryOp "/" Div
+    ],
+    [ binaryOp "+" Add,
+      binaryOp "-" Sub
+    ]
+  ]
+
+binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
+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 <$ symbol name)
+
+methodOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
+methodOp name f = Prefix (f <$ (string name <* C.space))
+
+-- postfixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
+-- postfixOp name f = Postfix (f <$ symbol name)
+
+expr :: Parser Expr
+expr = makeExprParser term table
+
+parseExpr :: Text -> Either (ParseErrorBundle Text Void) Expr
+parseExpr = MP.parse (C.space *> expr <* eof) ""
+
+parse :: Text -> Expr
+parse t = do
+  case parseExpr t of
+    Right r -> r
+
+-- TODO: add error handling

src/Main/Types/Expr.hs

@@ -1,12 +1,13 @@
-module Forth.Types.Expr (Expr (..)) where
+module Main.Types.Expr (Expr (..)) where
 
 data Expr
   = Lit Int
+  | Paren Expr
   | Add Expr Expr
   | Sub Expr Expr
   | Mul Expr Expr
   | Div Expr Expr
+  | Print Expr
   deriving
-    ( -- | Pop Expr Expr
+    ( Show
-      Show
     )