Merge pull request 'feature/comparisons' (#29) from feature/comparisons into main

Reviewed-on: https://git.sudoer.ch/me/really-bad-compiler-in-haskell/pulls/29

.gitignore

@@ -21,3 +21,5 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
+a.out
+a.out.ll

.vscode/extensions.json

@@ -0,0 +1,7 @@
+{
+    "recommendations": [
+        "gattytto.phoityne-vscode",
+        "haskell.haskell",
+        "justusadam.language-haskell"
+    ]
+}

.vscode/launch.json

@@ -0,0 +1,46 @@
+{
+    // Use IntelliSense to learn about possible attributes.
+    // Hover to view descriptions of existing attributes.
+    // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387
+    "version": "0.2.0",
+    "configurations": [
+        {
+            "type": "ghc",
+            "request": "launch",
+            "name": "haskell(stack)",
+            "internalConsoleOptions": "openOnSessionStart",
+            "workspace": "${workspaceFolder}",
+            "startup": "${workspaceFolder}/test/Spec.hs",
+            "startupFunc": "",
+            "startupArgs": "",
+            "stopOnEntry": false,
+            "mainArgs": "",
+            "ghciPrompt": "H>>= ",
+            "ghciInitialPrompt": "Prelude>",
+            "ghciCmd": "stack ghci --test --no-load --no-build --main-is TARGET",
+            "ghciEnv": {},
+            "logFile": "${workspaceFolder}/.vscode/phoityne.log",
+            "logLevel": "WARNING",
+            "forceInspect": false
+        },
+        {
+            "type": "ghc",
+            "request": "launch",
+            "name": "haskell(cabal)",
+            "internalConsoleOptions": "openOnSessionStart",
+            "workspace": "${workspaceFolder}",
+            "startup": "${workspaceFolder}/Main.hs",
+            "startupFunc": "",
+            "startupArgs": "",
+            "stopOnEntry": false,
+            "mainArgs": "",
+            "ghciPrompt": "H>>= ",
+            "ghciInitialPrompt": "Prelude>",
+            "ghciCmd": "cabal exec -- ghci-dap --interactive -i -i${workspaceFolder}",
+            "ghciEnv": {},
+            "logFile": "${workspaceFolder}/.vscode/phoityne.log",
+            "logLevel": "WARNING",
+            "forceInspect": false
+        }
+    ]
+}

.vscode/tasks.json

@@ -0,0 +1,50 @@
+
+{
+  // Automatically created by phoityne-vscode extension.
+
+  "version": "2.0.0",
+  "presentation": {
+    "reveal": "always",
+    "panel": "new"
+  },
+  "tasks": [
+    {
+      // F7
+      "group": {
+        "kind": "build",
+        "isDefault": true
+      },
+      "label": "haskell build",
+      "type": "shell",
+      //"command": "cabal configure && cabal build"
+      "command": "stack build"
+    },
+    {
+      // F6
+      "group": "build",
+      "type": "shell",
+      "label": "haskell clean & build",
+      //"command": "cabal clean && cabal configure && cabal build"
+      "command": "stack clean && stack build"
+      //"command": "stack clean ; stack build"  // for powershell
+    },
+    {
+      // F8
+      "group": {
+        "kind": "test",
+        "isDefault": true
+      },
+      "type": "shell",
+      "label": "haskell test",
+      //"command": "cabal test"
+      "command": "stack test"
+    },
+    {
+      // F6
+      "isBackground": true,
+      "type": "shell",
+      "label": "haskell watch",
+      "command": "stack build --test --no-run-tests --file-watch"
+    }
+  ]
+}

README.md

@@ -1,30 +1,69 @@
-# Really Bad Compiler in Haskell
+# HEAR Compiler in Haskell
 
-A compiler written in Haskell that is really bad (I do not know what language I am going to compile yet). 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
 
-## Build Instructions
+## Setup Instructions
 
+- Install `ghcup` (for managing Haskell tools) and `nix` (for managing external dependencies).
 - Clone the repo.
-- Use `ghcup` to install all of the Haskell tools.
+- Use `ghcup` to install `stack 2.11.1`, `HLS 2.3.0.0`, and `cabal 3.8.1.0`.
-- Use `stack build` and `stack run <file>` to run the program.
+
+## Run Instructions
+
+- 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`.
+
+## Currently Supported functionality
+
+- Arithmetic
+- Parenthesis
+- print() statement
+
+## To edit
+
+I recommend using VSCodium, which is preconfigured to have syntax highlighting and (currently broken) debugging features and will automatically suggest the Haskell extensions to install.
+
+## Known bugs
+
+### Building
+
+- If llvm_16 is in the nix store, stack will use it for some reason and the build will fail. Currently, you may need to run `nix-store --delete /nix/store/<llvm16devdirectory>` to build it.
+
+## File structure
+
+- `src` - contains the compiler program
+- `example` - contains example programs that can be compiled
 
 ## Credits
 
 ### Learning Resources Used
 
 - Introduction to Compiler Design class at The University of Texas at Dallas, taught by Charles Averill
-- learnyouahaskell.com (for learning Haskell basics)
+- https://learnyouahaskell.com (for learning Haskell basics)
 - https://akashagrawal.me/2017/01/19/beginners-guide-to-megaparsec.html
-- https://markkarpov.com/tutorial/megaparsec.html (for help writing a Haskell equation parser)
+- https://markkarpov.com/tutorial/megaparsec.html (for help writing a Haskell equation parser using megaparsec)
+- https://www.forth.com/starting-forth/1-forth-stacks-dictionary/ (for learning Forth)
+- https://blog.josephmorag.com/posts/mcc0/ (Haskell compiler tutorial with megaparsec, llvm-hs, and nix)
+- https://gh.sudoer.ch/llvm-hs/llvm-hs-examples (for help writing an llvm code generator using llvm-hs)
+- 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 tools: GHCup, Stack, Cabal
+- Haskell/management tools: GHCup, Stack, Cabal, GHC 9.2, Nix
-- Libraries: megaparsec, parser-combinators, text
+- Libraries: See `package.yaml`
+- Dependencies: llvm 15, clang 15
 - IDE: VSCodium
 - Git platform: Forgejo
-- AI: Phind
+- AI: Phind (GPT-4), ollama (codellama)
 - Search: Kagi, Stack Overflow

app/Eval/Expression.hs

@@ -1,13 +0,0 @@
-module Eval.Expression (evalExpr) where
-
-import Objects.Expression
-
-eval :: Expr -> Int
-eval (Lit x) = x
-eval (Add x y) = eval x + eval y
-eval (Sub x y) = eval x - eval y
-eval (Mul x y) = eval x * eval y
-eval (Div x y) = eval x `div` eval y
-
-evalExpr :: Expr -> Int
-evalExpr = eval

app/Main.hs

@@ -1,22 +0,0 @@
-module Main (main) where
-
-import Control.Monad
-import Data.Either
-import Eval.Expression
-import Objects.Expression
-import Parser.Expression
-import System.Environment
-import System.IO
-import Text.Megaparsec
-
-getRight :: ParseResult -> Expr
-getRight (Right r) = r
-
-getResult :: String -> Int
-getResult str = evalExpr (getRight (parseExpr str))
-
-main = do
-  fileName <- fmap head getArgs
-  contents <- readFile fileName
-  let result = getResult contents
-  print result

app/Objects/Expression.hs

@@ -1,19 +0,0 @@
-module Objects.Expression
-  ( Expr
-      ( Lit,
-        Add,
-        Sub,
-        Mul,
-        Div
-      ),
-      -- solve,
-  )
-where
-
-data Expr
-  = Lit Int
-  | Add Expr Expr
-  | Sub Expr Expr
-  | Mul Expr Expr
-  | Div Expr Expr
-  deriving (Show)

app/Parser/Expression.hs

@@ -1,44 +0,0 @@
-module Parser.Expression (parseExpr, ParseResult) where
-
-import Control.Monad.Combinators.Expr
-import Data.Void (Void)
-import Objects.Expression
-import Text.Megaparsec as MP
-import Text.Megaparsec.Char as C
-import Text.Megaparsec.Char.Lexer as L
-
-type Parser = Parsec Void String
-
-lexemeParser :: Parser a -> Parser a
-lexemeParser = L.lexeme C.space
-
-symbolParser :: String -> Parser String
-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 name f = InfixL (f <$ symbolParser name)
-
-expr :: Parser Expr
-expr = makeExprParser term table
-
-type ParseResult = Either (ParseErrorBundle String Void) Expr
-
-parseExpr :: String -> ParseResult
-parseExpr = MP.parse (C.space *> expr <* eof) ""
-
--- parseE = parseExpr

example/1.hear

@@ -0,0 +1,13 @@
+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.hear

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

package.yaml

@@ -0,0 +1,35 @@
+name: really-bad-compiler-in-haskell
+version: 0
+author: sudoer777
+dependencies:
+  - base >= 4.14.3 && < 5
+  - megaparsec >= 9.0.1 && < 10
+  - 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
+
+ghc-options: -threaded -Wall -j8 +RTS -A64M -RTS -fllvm
+
+# library:
+#   source-dirs: src
+
+executable:
+  source-dirs: src
+  main: Main.hs
+# tests:
+#   testall:
+#     main: Testall.hs
+#     source-dirs: test
+
+default-extensions: OverloadedStrings, LambdaCase
+# flags: -fno-hs-llvm=true

really-bad-compiler-in-haskell.cabal

@@ -1,39 +1,42 @@
-cabal-version:      2.4
+cabal-version: 1.12
-name:               really-bad-compiler-in-haskell
-version:            0.1.0.0
 
--- A short (one-line) description of the package.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
--- synopsis:
+--
+-- see: https://github.com/sol/hpack
 
--- A longer description of the package.
+name:           really-bad-compiler-in-haskell
--- description:
+version:        0
-
+category:       Compilers/Interpreters
--- A URL where users can report bugs.
+author:         sudoer777
--- bug-reports:
+maintainer:     sudoer777
-
+build-type:     Simple
--- The license under which the package is released.
+tested-with:
--- license:
+    GHC == 9.2.8
-author:             sudoer777
-maintainer:         git@sudoer.ch
-
--- A copyright notice.
--- copyright:
--- category:
-extra-source-files:
-    CHANGELOG.md
-    README.md
 
 executable really-bad-compiler-in-haskell
-    main-is:          Main.hs
+  main-is: Main.hs
-
+  other-modules:
-    -- Modules included in this executable, other than Main.
+      Main.LLVMGen
-    -- other-modules:
+      Main.Parser.Megaparsec
-
+      Main.Types
-    -- LANGUAGE extensions used by modules in this package.
+      Paths_really_bad_compiler_in_haskell
-    -- other-extensions:
+  hs-source-dirs:
-    build-depends:    base ^>=4.16.4.0
+      src
-                    , megaparsec >= 9.2.2
+  default-extensions:
-                    , parser-combinators
+      OverloadedStrings, LambdaCase
-                    , text
+  ghc-options: -threaded -Wall -j8 +RTS -A64M -RTS -fllvm
-    hs-source-dirs:   app
+  build-depends:
-    default-language: Haskell2010
+      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/Main.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+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 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
+
+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

src/Main/LLVMGen.hs

@@ -0,0 +1,181 @@
+{-# 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

@@ -0,0 +1,145 @@
+-- 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

@@ -0,0 +1,42 @@
+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,67 +1,22 @@
-# This file was automatically generated by 'stack init'
+resolver: lts-20.26
-#
+compiler: ghc-9.2.8
-# Some commonly used options have been documented as comments in this file.
+# setup-info:
-# For advanced use and comprehensive documentation of the format, please see:
+#   ghc:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
+#     aarch64:
+#       9.4.6:
+#         url: "https://downloads.haskell.org/~ghc/9.4.6/ghc-9.4.6-aarch64-deb10-linux.tar.xz"
+#         sha256: "05896fc4bc52c117d281eac9c621c6c3a0b14f9f9eed5e42cce5e1c4485c7623"
 
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-#
-# The location of a snapshot can be provided as a file or url. Stack assumes
-# a snapshot provided as a file might change, whereas a url resource does not.
-#
-# resolver: ./custom-snapshot.yaml
-# resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
-
-# User packages to be built.
-# Various formats can be used as shown in the example below.
-#
-# packages:
-# - some-directory
-# - https://example.com/foo/bar/baz-0.0.2.tar.gz
-#   subdirs:
-#   - auto-update
-#   - wai
 packages:
-- .
+  - .
-# Dependency packages to be pulled from upstream that are not in the resolver.
+extra-deps:
-# These entries can reference officially published versions as well as
+  - github: llvm-hs/llvm-hs
-# forks / in-progress versions pinned to a git hash. For example:
+    commit: 5bca2c1a2a3aa98ecfb19181e7a5ebbf3e212b76
-#
+    subdirs:
-# extra-deps:
+      - llvm-hs-pure
-# - acme-missiles-0.3
+      - llvm-hs
-# - git: https://github.com/commercialhaskell/stack.git
+nix:
-#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+  enable: true
-#
+  packages: [llvm_15, clang_15, libxml2]
-# extra-deps: []
+system-ghc: true
-
+install-ghc: false
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of Stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=2.9"
-#
-# Override the architecture used by Stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by Stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor

stack.yaml.lock

@@ -3,11 +3,36 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages: []
+packages:
+- completed:
+    name: llvm-hs-pure
+    pantry-tree:
+      sha256: b512f9e5f8f2b3e3a06bad2fa5ff053a83d817798c7efcd47e254e68c842169d
+      size: 2712
+    sha256: 526b67e2da9ce25b3856c221b6772e699a7593dbb5ba38e7ee2436349de70966
+    size: 9802209
+    subdir: llvm-hs-pure
+    url: https://github.com/llvm-hs/llvm-hs/archive/5bca2c1a2a3aa98ecfb19181e7a5ebbf3e212b76.tar.gz
+    version: 15.0.0
+  original:
+    subdir: llvm-hs-pure
+    url: https://github.com/llvm-hs/llvm-hs/archive/5bca2c1a2a3aa98ecfb19181e7a5ebbf3e212b76.tar.gz
+- completed:
+    name: llvm-hs
+    pantry-tree:
+      sha256: 21f74a6f51fae6c0a0fcf3e6620a59f341289ac743998b41ed3276fd1b7d8862
+      size: 12716
+    sha256: 526b67e2da9ce25b3856c221b6772e699a7593dbb5ba38e7ee2436349de70966
+    size: 9802209
+    subdir: llvm-hs
+    url: https://github.com/llvm-hs/llvm-hs/archive/5bca2c1a2a3aa98ecfb19181e7a5ebbf3e212b76.tar.gz
+    version: 15.0.0
+  original:
+    subdir: llvm-hs
+    url: https://github.com/llvm-hs/llvm-hs/archive/5bca2c1a2a3aa98ecfb19181e7a5ebbf3e212b76.tar.gz
 snapshots:
 - completed:
     sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2
     size: 650475
     url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
-  original:
+  original: lts-20.26
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml