.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

@@ -11,10 +11,6 @@ Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
 - Use `ghcup` to install `stack 2.9.3`, `HLS 2.2.0.0`, `GHC 9.2.8`, and `cabal 3.6.2.0`.
 - Use `stack run <file>` to run the program (for example, `stack run example/1`).
 
-## 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
@@ -45,7 +41,7 @@ I recommend using VSCodium, which is preconfigured to have syntax highlighting a
 
 - Language: Haskell
 - Haskell tools: GHCup, Stack, Cabal, GHC 9.2
-- Libraries: megaparsec, parser-combinators, text, process, llvm-hs-pure 15, llvm-hs-pretty-15
+- Libraries: megaparsec, parser-combinators, text, llvm-hs-pure 15, llvm-hs-pretty-15
 - Dependencies: llvm 15, clang 15
 - IDE: VSCodium
 - Git platform: Forgejo

main/Compiler/LLVMGen.hs

@@ -1,65 +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")
-      traceShow numFormatStr $ pure ()
-      ourExpression <- exprToLLVM expr
-      -- _ <- call (FunctionType i32 [i32])
-      _ <- 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
-
-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/Eval/Expr.hs

@@ -0,0 +1,13 @@
+module Eval.Expr (evalExpr) where
+
+import Types.Expr
+
+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

main/LLVMGen/Expr.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
+
+module LLVMGen.Expr (getLLVMStr) where
+
+import Data.Text.Lazy
+import LLVM.AST hiding (function)
+import LLVM.AST.Type
+import LLVM.IRBuilder.Constant
+import LLVM.IRBuilder.Instruction
+import LLVM.IRBuilder.Module
+import LLVM.IRBuilder.Monad
+import LLVM.Pretty
+import Types.Expr as Expr
+
+-- charStar :: LLVM.Type
+-- charStar = LLVM.ptr LLVM.i8
+
+getLLVM :: Expr -> Module
+getLLVM expr =
+  buildModule "program" $ do
+    -- TODO: better naming
+    printf <- externVarArgs "printf" [ptr] i32 -- or LLVM.ptr LLVM.i8
+    let numFormatStr = globalStringPtr "%d\n" (mkName "str")
+    function "main" [] i32 $ \_ -> do
+      ourExpression <- exprToLLVM expr
+      nfs <- numFormatStr
+      _ <- call i32 printf [(ConstantOperand nfs, []), (ourExpression, [])]
+      ret (int32 0)
+
+exprToLLVM ::
+  ( MonadIRBuilder m,
+    MonadModuleBuilder m
+  ) =>
+  Expr ->
+  m Operand
+exprToLLVM (Lit prim) = pure $ primToLLVM prim
+exprToLLVM (Expr.Add a b) = do
+  lhs <- exprToLLVM a
+  rhs <- exprToLLVM b
+  add lhs rhs
+exprToLLVM (Expr.Sub a b) = do
+  lhs <- exprToLLVM a
+  rhs <- exprToLLVM b
+  sub lhs rhs
+exprToLLVM (Expr.Mul a b) = do
+  lhs <- exprToLLVM a
+  rhs <- exprToLLVM b
+  mul lhs rhs
+
+primToLLVM :: Int -> Operand
+primToLLVM i = int32 (fromIntegral i)
+
+getLLVMStr :: Expr -> Text
+getLLVMStr expr = ppllvm (getLLVM expr)

main/LLVMGen/Expr.hs.old

@@ -0,0 +1,74 @@
+module LLVMGen.Expr (getLLVM) where
+
+import qualified Objects.Expr as Expr
+
+import LLVM.AST
+import qualified LLVM.AST as AST
+import LLVM.AST.Global
+import LLVM.AST.Constant
+import LLVM.AST.Type
+import LLVM.AST.Name
+import LLVM.Context
+import LLVM.Module
+
+import Data.ByteString.Char8 as BS
+
+int :: Type
+int = IntegerType 32
+
+defMain :: Definition
+defMain = GlobalDefinition functionDefaults
+  { name = Name "main"
+  , parameters =
+      ( []
+      , False )
+  , returnType = int
+  , basicBlocks = [body]
+  }
+  where
+    body = BasicBlock
+        (Name "entry")
+        [ Name "calltmp" :=
+            Call
+            { tailCallKind = Nothing
+            , function = Right (ConstantOperand (GlobalReference (PointerType (FunctionType int [int, int] False) defaultAddrSpace) (Name "add")))
+            , arguments = [ (ConstantOperand (Int 32 10), []), (ConstantOperand (Int 32 20), []) ]
+            }
+        ]
+        (Do $ Ret (Just (ConstantOperand (Int 32 0))) [])
+
+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" :=
+            AST.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 = [defMain, defAdd]
+  }
+
+
+toLLVM :: AST.Module -> IO ()
+toLLVM modul = withContext $ \ctx -> do
+  llvm <- withModuleFromAST ctx modul moduleLLVMAssembly
+  BS.putStrLn llvm
+
+getLLVM :: IO ()
+getLLVM = toLLVM module_

main/Main.hs

@@ -3,26 +3,23 @@
 
 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 Eval.Expr
+import LLVMGen.Expr
 import Parser.Expr
 import System.Environment
-import System.Process
 import Types.Expr
 
 getRight :: ParseResult -> Expr
 getRight (Right r) = r
 
+getResult :: String -> Int
+getResult str = evalExpr (getRight (parseExpr str)) -- TODO: add error messages
+
 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."
+  let result = getResult contents
+  print result
+  T.putStrLn (getLLVMStr (getRight (parseExpr contents)))

main/Parser/Expr.hs

@@ -27,8 +27,8 @@ term = Lit <$> intParser
 
 table :: [[Operator Parser Expr]]
 table =
-  [ [ binaryOp "*" Mul
-  -- binaryOp "/" Div
+  [ [ binaryOp "*" Mul,
+      binaryOp "/" Div
     ],
     [ binaryOp "+" Add,
       binaryOp "-" Sub

main/Types/Expr.hs

@@ -5,7 +5,5 @@ data Expr
   | Add Expr Expr
   | Sub Expr Expr
   | Mul Expr Expr
-  deriving
-    ( -- | Div Expr Expr
-      Show
-    )
+  | Div Expr Expr
+  deriving (Show)

package.yaml

@@ -6,10 +6,9 @@ dependencies:
   - megaparsec >= 9.0.1 && < 10
   - parser-combinators
   - text
-  - process
-  - llvm-hs >= 15 && < 16
+  # - llvm-hs >= 15 && < 16
   - llvm-hs-pure >= 15 && < 16
-  # - llvm-hs-pretty >= 15 && < 16
+  - llvm-hs-pretty >= 15 && < 16
   - bytestring
 tested-with: GHC == 9.2.8
 category: Compilers/Interpreters

really-bad-compiler-in-haskell.cabal

@@ -16,7 +16,8 @@ tested-with:
 executable really-bad-compiler-in-haskell
   main-is: Main.hs
   other-modules:
-      Compiler.LLVMGen
+      Eval.Expr
+      LLVMGen.Expr
       Parser.Expr
       Types.Expr
       Paths_really_bad_compiler_in_haskell
@@ -28,10 +29,9 @@ executable really-bad-compiler-in-haskell
   build-depends:
       base >=4.14.3 && <5
     , bytestring
-    , llvm-hs ==15.*
+    , llvm-hs-pretty ==15.*
     , llvm-hs-pure ==15.*
     , megaparsec >=9.0.1 && <10
     , parser-combinators
-    , process
     , text
   default-language: Haskell2010

stack.yaml

@@ -9,7 +9,7 @@ extra-deps:
     commit: 5bca2c1a2a3aa98ecfb19181e7a5ebbf3e212b76
     subdirs:
       - llvm-hs-pure
-      - llvm-hs
+      # - llvm-hs
 nix:
   enable: true
   packages: [llvm_15, clang_15, libxml2]

stack.yaml.lock

@@ -28,19 +28,6 @@ packages:
   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