Allow parsing signed integers

README.md

@@ -1,8 +1,6 @@
-# HEAR Compiler in Haskell
+# Really Bad Compiler in Haskell
 
-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.
+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.
 
 Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
 
@@ -10,18 +8,20 @@ Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
 
 - Install `ghcup` (for managing Haskell tools) and `nix` (for managing external dependencies).
 - Clone the repo.
-- Use `ghcup` to install `stack 2.11.1`, `HLS 2.3.0.0`, and `cabal 3.8.1.0`.
+- Use `ghcup` to install `stack 2.9.3`, `HLS 2.2.0.0`, `GHC 9.2.8`, and `cabal 3.6.2.0`.
 
 ## Run Instructions
 
-- Use `stack run <file>` to run the program (for example, `stack run example/1.hear`).
+- Use `stack run <file>` to run the program (for example, `stack run example/1.fs`).
 - The LLVM will be generated as `a.out.ll`, and the executable will be generated as `a.out`.
 
-## Currently Supported functionality
+## Language
 
-- Arithmetic
-- Parenthesis
-- print() statement
+It is planned to be similar to Forth, unless it turns out that Forth does not have the features I am looking for.
+
+Currently, it supports positive integers, `+`, `-`, `*`, `/`, and `.` (pops from stack and outputs to console).
+
+The supported syntax for this compiler aims to be compatible with Gforth.
 
 ## To edit
 
@@ -35,7 +35,7 @@ I recommend using VSCodium, which is preconfigured to have syntax highlighting a
 
 ## File structure
 
-- `src` - contains the compiler program
+- `app` - contains the compiler program
 - `example` - contains example programs that can be compiled
 
 ## Credits
@@ -52,16 +52,12 @@ I recommend using VSCodium, which is preconfigured to have syntax highlighting a
 - https://danieljharvey.github.io/posts/2023-02-08-llvm-compiler-part-1.html (for help using llvm-hs-pure)
 - https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs (source code for above resource)
 - https://9to5tutorial.com/homebrew-compiler-made-with-haskell-llvm-configuration (for help using llvm-hs-pure)
-- https://blog.ocharles.org.uk/blog/posts/2012-12-17-24-days-of-hackage-optparse-applicative.html (for help parsing command line arguments with optparse-applicative)
-- http://learnyouahaskell.com/making-our-own-types-and-typeclasses (for help defining types)
-- https://llvm.org/docs/LangRef.html (LLVM documentation)
-- https://hackage.haskell.org/package/llvm-hs-pure-9.0.0/docs/ (llvm-hs documentation)
 
 ### Tools
 
 - Language: Haskell
-- Haskell/management tools: GHCup, Stack, Cabal, GHC 9.2, Nix
-- Libraries: See `package.yaml`
+- Haskell tools: GHCup, Stack, Cabal, GHC 9.2
+- Libraries: megaparsec, parser-combinators, text, process, llvm-hs 15, llvm-hs-pure 15,
 - Dependencies: llvm 15, clang 15
 - IDE: VSCodium
 - Git platform: Forgejo

example/1.fs

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

example/1.hear

@@ -1,13 +0,0 @@
-printInt(5*(3-2)+-4-4);
-printBool(true);
-printBool(false);
-printBool(5 * 3 >= 5 + 9);
-printBool(5*(3-2)+-4-4 < -3);
-printBool(5 == 5);
-printBool(5 == 6);
-printBool(5 != 5);
-printBool(true == true);
-printBool(true && true);
-printBool(true && false);
-printBool(!true);
-printBool(!(5 == 5));

example/2.fs

@@ -0,0 +1 @@
+6 8 3 / + .

example/2.hear

@@ -1,2 +0,0 @@
- print(6+8/3);
- print(5000);

package.yaml

@@ -7,14 +7,9 @@ dependencies:
   - parser-combinators
   - text
   - process
-  - mtl
-  - containers
   - llvm-hs >= 15 && < 16
   - llvm-hs-pure >= 15 && < 16
   - bytestring
-  - string-conversions
-  - transformers
-  - optparse-applicative >= 0.17 && < 1
 tested-with: GHC == 9.2.8
 category: Compilers/Interpreters
 

really-bad-compiler-in-haskell.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.35.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -16,9 +16,9 @@ tested-with:
 executable really-bad-compiler-in-haskell
   main-is: Main.hs
   other-modules:
-      Main.LLVMGen
-      Main.Parser.Megaparsec
-      Main.Types
+      Forth.LLVMGen
+      Forth.Parser
+      Forth.Types.Token
       Paths_really_bad_compiler_in_haskell
   hs-source-dirs:
       src
@@ -28,15 +28,10 @@ executable really-bad-compiler-in-haskell
   build-depends:
       base >=4.14.3 && <5
     , bytestring
-    , containers
     , llvm-hs ==15.*
     , llvm-hs-pure ==15.*
     , megaparsec >=9.0.1 && <10
-    , mtl
-    , optparse-applicative >=0.17 && <1
     , parser-combinators
     , process
-    , string-conversions
     , text
-    , transformers
   default-language: Haskell2010

src/Forth/LLVMGen.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo #-}
+
+-- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
+
+module Forth.LLVMGen (llvmGen) where
+
+import Data.ByteString (ByteString)
+import Forth.Types.Token as Token
+import LLVM (moduleLLVMAssembly, withModuleFromAST)
+import LLVM.AST hiding (function)
+import LLVM.AST.Type
+import LLVM.Context
+import LLVM.IRBuilder.Constant
+import LLVM.IRBuilder.Instruction
+import LLVM.IRBuilder.Module
+import LLVM.IRBuilder.Monad
+
+getLLVM :: Token -> Module
+getLLVM expr =
+  buildModule "program" $ mdo
+    -- TODO: better module name
+    printf <- externVarArgs "printf" [ptr] i32
+    function "main" [] i32 $ \_ -> mdo
+      numFormatStr <- globalStringPtr "%d\n" (mkName "str")
+      ourExpression <- exprToLLVM expr
+      _ <- call (FunctionType i32 [ptr] True) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])]
+      ret (int32 0)
+
+exprToLLVM ::
+  ( MonadIRBuilder m,
+    MonadModuleBuilder m
+  ) =>
+  Token ->
+  m Operand
+exprToLLVM (Lit prim) = pure $ primToLLVM prim
+exprToLLVM (Token.Add a b) = mdo
+  lhs <- exprToLLVM a
+  rhs <- exprToLLVM b
+  add lhs rhs
+exprToLLVM (Token.Sub a b) = mdo
+  lhs <- exprToLLVM a
+  rhs <- exprToLLVM b
+  sub lhs rhs
+exprToLLVM (Token.Mul a b) = mdo
+  lhs <- exprToLLVM a
+  rhs <- exprToLLVM b
+  mul lhs rhs
+exprToLLVM (Token.Div a b) = mdo
+  lhs <- exprToLLVM a
+  rhs <- exprToLLVM b
+  sdiv lhs rhs
+
+primToLLVM :: Int -> Operand
+primToLLVM i = int32 (fromIntegral i)
+
+llvmGen :: Token -> IO ByteString
+llvmGen expr = do
+  let l = getLLVM expr
+  withContext
+    ( \c ->
+        withModuleFromAST c l moduleLLVMAssembly
+    )

src/Forth/Parser.hs

@@ -0,0 +1,54 @@
+-- see https://markkarpov.com/tutorial/megaparsec.html
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Forth.Parser (parse) where
+
+import Data.Text
+import Data.Void (Void)
+import Forth.Types.Token
+import Text.Megaparsec as MP hiding (Token, parse)
+import Text.Megaparsec qualified as MP
+import Text.Megaparsec.Char qualified as C
+import Text.Megaparsec.Char.Lexer qualified as L
+import Prelude hiding (div)
+
+type Parser = Parsec Void Text
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme C.space
+
+int :: Parser Int
+int = lexeme $ L.signed (return ()) L.decimal
+
+symbol :: Text -> Parser Text
+symbol = L.symbol C.space
+
+item :: Parser Token
+item =
+  try
+    ( Lit
+        <$> int
+    )
+    <|> Add
+    <$ symbol "+"
+      <|> Sub
+    <$ symbol "-"
+      <|> Mul
+    <$ symbol "*"
+      <|> Div
+    <$ symbol "/"
+      <|> Pop
+    <$ symbol "."
+
+items :: Parser [Token]
+items = many item
+
+parseItems :: Text -> Either (ParseErrorBundle Text Void) [Token]
+parseItems = MP.parse items ""
+
+parse :: Text -> [Token]
+parse t = do
+  case parseItems t of
+    Left err -> [] -- putStrLn $ errorBundlePretty err
+    Right tns -> tns

src/Forth/Parser.hs.old

@@ -0,0 +1,58 @@
+-- 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/Forth/Types/Expr.hs.old

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

src/Forth/Types/Token.hs

@@ -0,0 +1,12 @@
+module Forth.Types.Token (Token (..)) where
+
+data Token
+  = Lit Int
+  | Add
+  | Sub
+  | Mul
+  | Div
+  | Pop
+  deriving
+    ( Show
+    )

src/Main.hs

@@ -5,47 +5,19 @@ module Main (main) where
 
 import Data.ByteString.Char8 qualified as B
 import Data.Text.IO qualified as T
-import Main.LLVMGen
-import Main.Parser.Megaparsec
-import Options.Applicative
+import Forth.LLVMGen
+import Forth.Parser
 import System.Environment
-import System.Process (callCommand)
-
-data Opt = Opt
-  { filePath :: String,
-    showLLVM :: Bool,
-    showDebug :: Bool
-  }
-
-run :: Opt -> IO ()
-run opts = do
-  let fileName = filePath opts
-  contents <- T.readFile fileName
-  T.putStrLn "- Generating LLVM to './a.out.ll'..."
-  let parseResult = parse contents
-  case parseResult of
-    Right r -> do
-      result <- llvmGen r
-      B.writeFile "a.out.ll" result
-      T.putStrLn "- Compiling to executable './a.out'..."
-      callCommand "clang a.out.ll"
-      T.putStrLn "- Done."
-    Left l -> putStrLn l
+import System.Process
 
 main :: IO ()
-main = execParser opts >>= run
-  where
-    parser =
-      Opt
-        <$> argument str (metavar "FILE_PATH")
-        <*> switch
-          ( short 'l'
-              <> long "showLLVM"
-              <> help "Create <file>.ll with LLVM used to compile the binary"
-          )
-        <*> switch
-          ( short 'd'
-              <> long "showDebug"
-              <> help "Show debug output"
-          )
-    opts = info parser mempty
+main = do
+  fileName <- fmap head getArgs
+  contents <- T.readFile fileName
+  T.putStrLn "- Parsing file..."
+  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'..."
+  -- callCommand "clang a.out.ll"
+  T.putStrLn "- Done."

src/Main/LLVMGen.hs

@@ -1,181 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
--- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
--- see https://blog.josephmorag.com/posts/mcc3/
-
-module Main.LLVMGen (llvmGen) where
-
-import Control.Monad.State
-import Control.Monad.Trans.Class (lift)
-import Data.ByteString (ByteString)
-import Data.Map qualified as M
-import Data.String.Conversions
-import Data.Text
-import LLVM (moduleLLVMAssembly, withModuleFromAST)
-import LLVM.AST hiding (function)
-import LLVM.AST.IntegerPredicate
-import LLVM.AST.Type
-import LLVM.AST.Type qualified as AST
-import LLVM.Context
-import LLVM.IRBuilder.Constant
-import LLVM.IRBuilder.Instruction
-import LLVM.IRBuilder.Module
-import LLVM.IRBuilder.Monad
-import Main.Types qualified as T
-
-data Env = Env
-  { operands :: M.Map Text Operand,
-    strings :: M.Map Text Operand
-  }
-  deriving (Eq, Show)
-
-registerOperand :: (MonadState Env m) => Text -> Operand -> m ()
-registerOperand name op =
-  modify $ \env -> env {operands = M.insert name op (operands env)}
-
-registerString :: (MonadState Env m) => Text -> Operand -> m ()
-registerString name op =
-  modify $ \env -> env {strings = M.insert name op (operands env)}
-
-getOperand :: (MonadState Env m, MonadModuleBuilder m, MonadIRBuilder m) => Text -> m Operand
-getOperand name = do
-  env <- get
-  case M.lookup name (operands env) of
-    Just op -> return op
-    Nothing -> error $ "Unknown operand: " ++ show name
-
-getString :: (MonadState Env m, MonadModuleBuilder m, MonadIRBuilder m) => Text -> m Operand
-getString str = do
-  env <- get
-  case M.lookup str (strings env) of
-    Just s -> return s
-    Nothing -> do
-      s <- globalStringPtr (unpack str) (mkName "str")
-      let operand = ConstantOperand s
-      modify $ \env -> env {strings = M.insert str operand (strings env)}
-      return operand
-
-getLLVM :: [T.Statement] -> Module
-getLLVM statement =
-  flip evalState (Env {operands = M.empty, strings = M.empty}) $
-    buildModuleT "program" $ mdo
-      -- TODO: better module name
-      printf <- externVarArgs "printf" [ptr] i32
-      lift $ registerOperand "printf" printf
-      function "main" [] i32 $ \_ -> mdo
-        printNumStr <- globalStringPtr "%d\n" (mkName "str")
-        lift $ registerString "%d\n" $ ConstantOperand printNumStr
-        _ <- forM_ statement statementToLLVM
-        ret $ int32 0
-
---
--- ourExpression <- exprToLLVM expr
--- _ <- call (FunctionType i32 [ptr] True) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])]
--- ret $ int32 0
-
-statementToLLVM ::
-  ( MonadIRBuilder m,
-    MonadModuleBuilder m,
-    MonadState Env m
-  ) =>
-  T.Statement ->
-  m Operand
-statementToLLVM (T.PrintInt e) = mdo
-  val <- intExprToLLVM e
-  printf <- getOperand "printf"
-  formatStr <- getString "%d\n"
-  _ <- call (FunctionType i32 [ptr] True) printf [(formatStr, []), (val, [])]
-  pure val
-statementToLLVM (T.PrintBool e) = mdo
-  val <- boolExprToLLVM e
-  val32 <- zext val i32
-  printf <- getOperand "printf"
-  formatStr <- getString "%d\n"
-  _ <- call (FunctionType i32 [ptr] True) printf [(formatStr, []), (val32, [])]
-  pure val
-
-intExprToLLVM ::
-  ( MonadIRBuilder m,
-    MonadModuleBuilder m,
-    MonadState Env m
-  ) =>
-  T.Int ->
-  m Operand
-intExprToLLVM (T.Int prim) = pure $ int32 $ fromIntegral prim
-intExprToLLVM (T.IntArith T.Add a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  add lhs rhs
-intExprToLLVM (T.IntArith T.Sub a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  sub lhs rhs
-intExprToLLVM (T.IntArith T.Mul a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  mul lhs rhs
-intExprToLLVM (T.IntArith T.Div a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  sdiv lhs rhs
-
-boolExprToLLVM ::
-  ( MonadIRBuilder m,
-    MonadModuleBuilder m,
-    MonadState Env m
-  ) =>
-  T.Bool ->
-  m Operand
-boolExprToLLVM (T.Bool prim) =
-  if prim then pure $ bit 1 else pure $ bit 0
-boolExprToLLVM (T.IntOrdCmp T.GT a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  icmp SGT lhs rhs
-boolExprToLLVM (T.IntOrdCmp T.GTE a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  icmp SGE lhs rhs
-boolExprToLLVM (T.IntOrdCmp T.LT a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  icmp SLT lhs rhs
-boolExprToLLVM (T.IntOrdCmp T.LTE a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  icmp SLE lhs rhs
-boolExprToLLVM (T.IntEq T.EQ a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  icmp LLVM.AST.IntegerPredicate.EQ lhs rhs
-boolExprToLLVM (T.IntEq T.NE a b) = mdo
-  lhs <- intExprToLLVM a
-  rhs <- intExprToLLVM b
-  icmp LLVM.AST.IntegerPredicate.NE lhs rhs
-boolExprToLLVM (T.BoolEq T.EQ a b) = mdo
-  lhs <- boolExprToLLVM a
-  rhs <- boolExprToLLVM b
-  icmp LLVM.AST.IntegerPredicate.EQ lhs rhs
-boolExprToLLVM (T.BoolEq T.NE a b) = mdo
-  lhs <- boolExprToLLVM a
-  rhs <- boolExprToLLVM b
-  icmp LLVM.AST.IntegerPredicate.NE lhs rhs
-boolExprToLLVM (T.BoolLogic T.AND a b) = mdo
-  lhs <- boolExprToLLVM a
-  rhs <- boolExprToLLVM b
-  LLVM.IRBuilder.Instruction.and lhs rhs
-boolExprToLLVM (T.BoolLogic T.OR a b) = mdo
-  lhs <- boolExprToLLVM a
-  rhs <- boolExprToLLVM b
-  LLVM.IRBuilder.Instruction.or lhs rhs
-boolExprToLLVM (T.BoolNeg a) = mdo
-  l <- boolExprToLLVM a
-  LLVM.IRBuilder.Instruction.xor l $ bit 1
-
-llvmGen :: [T.Statement] -> IO ByteString
-llvmGen expr = do
-  let l = getLLVM expr
-  withContext $ \c -> withModuleFromAST c l moduleLLVMAssembly

src/Main/Parser/Megaparsec.hs

@@ -1,145 +0,0 @@
--- 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 qualified as M
-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)
-
-parens :: Parser a -> Parser a
-parens = container "(" ")"
-
-intExprTerm :: ParsecT Void Text Data.Functor.Identity.Identity M.Int
-intExprTerm =
-  choice
-    [ M.Int <$> int,
-      parens intExpr
-    ]
-
-intExprTable :: [[Operator Parser M.Int]]
-intExprTable =
-  [ [ binaryOp "*" (M.IntArith M.Mul),
-      binaryOp "/" (M.IntArith M.Div)
-    ],
-    [ binaryOp "+" (M.IntArith M.Add),
-      binaryOp "-" (M.IntArith M.Sub)
-    ]
-  ]
-
-intExpr :: Parser M.Int
-intExpr = makeExprParser intExprTerm intExprTable
-
-intOrdCmpExpr :: ParsecT Void Text Data.Functor.Identity.Identity (M.OrdCmpOp, M.Int, M.Int)
-intOrdCmpExpr = do
-  b <- intExpr
-  a <-
-    choice
-      [ M.GTE <$ string ">=" <* C.space,
-        M.LTE <$ string "<=" <* C.space,
-        M.GT <$ string ">" <* C.space,
-        M.LT <$ string "<" <* C.space
-      ]
-  c <- intExpr
-  return (a, b, c)
-
-intEqExpr :: ParsecT Void Text Data.Functor.Identity.Identity (M.EqOp, M.Int, M.Int)
-intEqExpr = do
-  b <- intExpr
-  a <-
-    choice
-      [ M.EQ <$ string "==" <* C.space,
-        M.NE <$ string "!=" <* C.space
-      ]
-  c <- intExpr
-  return (a, b, c)
-
-boolExprTable :: [[Operator Parser M.Bool]]
-boolExprTable =
-  [ [ binaryOp "==" (M.BoolEq M.EQ),
-      binaryOp "!=" (M.BoolEq M.NE)
-    ],
-    [prefixOp "!" M.BoolNeg],
-    [binaryOp "&&" (M.BoolLogic M.AND)],
-    [binaryOp "||" (M.BoolLogic M.OR)]
-  ]
-
--- boolEqExpr :: ParsecT Void Text Data.Functor.Identity.Identity (M.EqOp, M.Bool, M.Bool)
--- boolEqExpr = do
---   b <-
---       choice
---       [
-
---       ]
---   a <-
---     choice
---       [ M.EQ <$ string "==" <* C.space,
---         M.NE <$ string "!=" <* C.space
---       ]
---   c <- intExpr
---   return (a, b, c)
-
-uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
-uncurry3 f (x, y, z) = f x y z
-
-boolExprTerm :: ParsecT Void Text Data.Functor.Identity.Identity M.Bool
-boolExprTerm =
-  choice
-    [ try (uncurry3 M.IntOrdCmp <$> intOrdCmpExpr),
-      parens boolExpr,
-      uncurry3 M.IntEq <$> intEqExpr,
-      M.Bool True <$ string "true" <* C.space,
-      M.Bool False <$ string "false" <* C.space
-    ]
-
-boolExpr :: ParsecT Void Text Data.Functor.Identity.Identity M.Bool
-boolExpr = makeExprParser boolExprTerm boolExprTable
-
-binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
-binaryOp name f = InfixL $ f <$ string name <* C.space
-
-prefixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
-prefixOp name f = Prefix $ f <$ symbol name
-
-statement :: Parser M.Statement
-statement =
-  choice
-    [ string "printInt" *> (M.PrintInt <$> parens intExpr),
-      string "printBool" *> (M.PrintBool <$> parens boolExpr)
-    ]
-    <* symbol ";"
-
-parseStatements :: Text -> Either (ParseErrorBundle Text Void) [M.Statement]
-parseStatements = MP.parse (C.space *> many statement <* eof) ""
-
-parse :: Text -> Either String [M.Statement]
-parse t =
-  case parseStatements t of
-    Right r -> Right r
-    Left e -> Left (errorBundlePretty e)
-
--- TODO: add error handling

src/Main/Types.hs

@@ -1,42 +0,0 @@
-module Main.Types
-  ( ArithOp (..),
-    EqOp (..),
-    OrdCmpOp (..),
-    LogicOp (..),
-    -- BinExpr (..),
-    Int (..),
-    Bool (..),
-    Statement (..),
-  )
-where
-
-import qualified Prelude as P
-
-data ArithOp = Add | Sub | Mul | Div deriving (P.Show)
-
-data EqOp = EQ | NE deriving (P.Show)
-
-data OrdCmpOp = GT | GTE | LT | LTE deriving (P.Show)
-
-data LogicOp = AND | OR deriving (P.Show)
-
--- newtype BinExpr op i o = BinExpr (op -> i -> i -> o)
-
-data Int
-  = Int P.Int
-  | IntArith ArithOp Int Int -- (BinExpr ArithOp Int Int)
-  deriving (P.Show)
-
-data Bool
-  = Bool P.Bool
-  | BoolNeg Bool
-  | IntEq EqOp Int Int -- (BinExpr EqOp Int Bool)
-  | IntOrdCmp OrdCmpOp Int Int -- (BinExpr OrdCmpOp Int Bool)
-  | BoolEq EqOp Bool Bool -- (BinExpr EqOp Bool Bool)
-  | BoolLogic LogicOp Bool Bool
-  deriving (P.Show)
-
-data Statement
-  = PrintInt Int
-  | PrintBool Bool
-  deriving (P.Show)

stack.yaml

@@ -1,11 +1,4 @@
 resolver: lts-20.26
-compiler: ghc-9.2.8
-# setup-info:
-#   ghc:
-#     aarch64:
-#       9.4.6:
-#         url: "https://downloads.haskell.org/~ghc/9.4.6/ghc-9.4.6-aarch64-deb10-linux.tar.xz"
-#         sha256: "05896fc4bc52c117d281eac9c621c6c3a0b14f9f9eed5e42cce5e1c4485c7623"
 
 packages:
   - .
@@ -19,4 +12,4 @@ nix:
   enable: true
   packages: [llvm_15, clang_15, libxml2]
 system-ghc: true
-install-ghc: false
+install-ghc: true