.gitignore

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

.vscode/extensions.json

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

.vscode/launch.json

@@ -1,46 +0,0 @@
-{
-    // 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

@@ -1,50 +0,0 @@
-
-{
-  // 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,23 +1,15 @@
 # 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 written in Haskell which can currently perform basic arithmetic using the megaparsec and llvm-hs libraries (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.
 
 Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
 
-## Setup Instructions
+## Build Instructions
 
 - Install `ghcup` (for managing Haskell tools) and `nix` (for managing external dependencies).
 - Clone the repo.
 - 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`).
-- The LLVM will be generated as `a.out.ll`, and the executable will be generated as `a.out`.
-
-## 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
 
@@ -35,23 +27,20 @@ I recommend using VSCodium, which is preconfigured to have syntax highlighting a
 ### Learning Resources Used
 
 - Introduction to Compiler Design class at The University of Texas at Dallas, taught by Charles Averill
-- https://learnyouahaskell.com (for learning Haskell basics)
+- 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 using megaparsec)
+- https://markkarpov.com/tutorial/megaparsec.html (for help writing a Haskell equation parser)
 - 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://gh.sudoer.ch/llvm-hs/llvm-hs-examples (for help writing an llvm code generator)
-- 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)
 
 ### Tools
 
 - Language: Haskell
-- Haskell tools: GHCup, Stack, Cabal, GHC 9.2
+- Haskell tools: GHCup, Stack, Cabal
-- Libraries: megaparsec, parser-combinators, text, process, llvm-hs 15, llvm-hs-pure 15,
+- Libraries: megaparsec, parser-combinators, text, llvm-hs-pure
-- Dependencies: llvm 15, clang 15
+- Dependencies: llvm, clang
 - IDE: VSCodium
 - Git platform: Forgejo
-- AI: Phind (GPT-4), ollama (codellama)
+- AI: Phind
 - Search: Kagi, Stack Overflow

app/Eval/Expression.hs

@@ -0,0 +1,13 @@
+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/LLVMGen/Expression.hs

@@ -0,0 +1,51 @@
+module LLVMGen.Expression () where
+
+import qualified Objects.Expression as Expr
+
+import LLVM.AST
+import qualified LLVM.AST as AST
+import LLVM.AST.Global
+import LLVM.Context
+import LLVM.Module
+
+import Data.ByteString.Char8 as BS
+
+int :: Type
+int = IntegerType 32
+
+defAdd :: Definition
+defAdd = GlobalDefinition functionDefaults
+  { name = Name "add"
+  , parameters =
+      ( [ Parameter int (Name "a") []
+        , Parameter int (Name "b") [] ]
+      , False )
+  , returnType = int
+  , basicBlocks = [body]
+  }
+  where
+    body = BasicBlock
+        (Name "entry")
+        [ Name "result" :=
+            Add False  -- no signed wrap
+                False  -- no unsigned wrap
+                (LocalReference int (Name "a"))
+                (LocalReference int (Name "b"))
+                []]
+        (Do $ Ret (Just (LocalReference int (Name "result"))) [])
+
+
+module_ :: AST.Module
+module_ = defaultModule
+  { moduleName = "basic"
+  , moduleDefinitions = [defAdd]
+  }
+
+
+toLLVM :: AST.Module -> IO ()
+toLLVM modul = withContext $ \ctx -> do
+  llvm <- withModuleFromAST ctx modul moduleLLVMAssembly
+  BS.putStrLn llvm
+
+main :: IO ()
+main = toLLVM module_

app/Main.hs

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

@@ -0,0 +1,19 @@
+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,15 +1,11 @@
--- see https://markkarpov.com/tutorial/megaparsec.html
+module Parser.Expression (parseExpr, ParseResult) where
-{-# LANGUAGE ImportQualifiedPost #-}
-
-module Parser.Expr (parseExpr, ParseResult) where
 
 import Control.Monad.Combinators.Expr
-import Data.Functor.Identity qualified
 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
-import Types.Expr
 
 type Parser = Parsec Void String
 
@@ -35,7 +31,6 @@ table =
     ]
   ]
 
-binaryOp :: String -> (a -> a -> a) -> Operator (ParsecT Void String Data.Functor.Identity.Identity) a
 binaryOp name f = InfixL (f <$ symbolParser name)
 
 expr :: Parser Expr

main/Compiler/LLVMGen.hs

@@ -1,67 +0,0 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecursiveDo #-}
-
--- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
-
-module Compiler.LLVMGen (llvmGen) where
-
--- import LLVM.Pretty
-
-import Data.ByteString (ByteString)
-import Debug.Trace
-import LLVM (moduleLLVMAssembly, withModuleFromAST, writeLLVMAssemblyToFile)
-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
-import Types.Expr as Expr
-
-getLLVM :: Expr -> 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
-  ) =>
-  Expr ->
-  m Operand
-exprToLLVM (Lit prim) = pure $ primToLLVM prim
-exprToLLVM (Expr.Add a b) = mdo
-  lhs <- exprToLLVM a
-  rhs <- exprToLLVM b
-  add lhs rhs
-exprToLLVM (Expr.Sub a b) = mdo
-  lhs <- exprToLLVM a
-  rhs <- exprToLLVM b
-  sub lhs rhs
-exprToLLVM (Expr.Mul a b) = mdo
-  lhs <- exprToLLVM a
-  rhs <- exprToLLVM b
-  mul lhs rhs
-exprToLLVM (Expr.Div a b) = mdo
-  lhs <- exprToLLVM a
-  rhs <- exprToLLVM b
-  sdiv lhs rhs
-
-primToLLVM :: Int -> Operand
-primToLLVM i = int32 (fromIntegral i)
-
-llvmGen :: Expr -> IO ByteString
-llvmGen expr = do
-  let l = getLLVM expr
-  withContext
-    ( \c ->
-        withModuleFromAST c l moduleLLVMAssembly
-    )

main/Main.hs

@@ -1,28 +0,0 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main (main) where
-
--- import Compiler.ExeGen
-import Compiler.LLVMGen
-import Data.ByteString.Char8 qualified as B
-import Data.Text.Lazy.IO qualified as T
-import Parser.Expr
-import System.Environment
-import System.Process
-import Types.Expr
-
-getRight :: ParseResult -> Expr
-getRight (Right r) = r
-
-main :: IO ()
-main = do
-  fileName <- fmap head getArgs
-  contents <- readFile fileName
-  T.putStrLn "- Parsing file..."
-  let parsed = getRight (parseExpr 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."

main/Types/Expr.hs

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

package.yaml

@@ -6,9 +6,9 @@ dependencies:
   - megaparsec >= 9.0.1 && < 10
   - parser-combinators
   - text
-  - process
   - llvm-hs >= 15 && < 16
   - llvm-hs-pure >= 15 && < 16
+  # - llvm-hs-pretty >= 15 && < 16
   - bytestring
 tested-with: GHC == 9.2.8
 category: Compilers/Interpreters
@@ -19,7 +19,7 @@ ghc-options: -threaded -Wall -j8 +RTS -A64M -RTS -fllvm
 #   source-dirs: src
 
 executable:
-  source-dirs: main
+  source-dirs: app
   main: Main.hs
 # tests:
 #   testall:

really-bad-compiler-in-haskell.cabal

@@ -16,12 +16,13 @@ tested-with:
 executable really-bad-compiler-in-haskell
   main-is: Main.hs
   other-modules:
-      Compiler.LLVMGen
+      Eval.Expression
-      Parser.Expr
+      LLVMGen.Expression
-      Types.Expr
+      Objects.Expression
+      Parser.Expression
       Paths_really_bad_compiler_in_haskell
   hs-source-dirs:
-      main
+      app
   default-extensions:
       OverloadedStrings, LambdaCase
   ghc-options: -threaded -Wall -j8 +RTS -A64M -RTS -fllvm
@@ -32,6 +33,5 @@ executable really-bad-compiler-in-haskell
     , llvm-hs-pure ==15.*
     , megaparsec >=9.0.1 && <10
     , parser-combinators
-    , process
     , text
   default-language: Haskell2010

stack.yaml

@@ -3,6 +3,8 @@ resolver: lts-20.26
 packages:
   - .
 extra-deps:
+  # - github: hyunsooda/llvm-hs-pretty-15
+  #   commit: 79283942d1667168ecd65237667aff7fed730303
   - github: llvm-hs/llvm-hs
     commit: 5bca2c1a2a3aa98ecfb19181e7a5ebbf3e212b76
     subdirs: