Generate LLVM code and print to console

pull/21/head
Ethan Reece 2023-09-28 23:42:59 -05:00
parent 9f9642347b
commit 30df05afa9
Signed by: me
GPG Key ID: D3993665FF92E1C3
9 changed files with 130 additions and 17 deletions

7
.vscode/extensions.json vendored 100644
View File

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

46
.vscode/launch.json vendored 100644
View File

@ -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
}
]
}

50
.vscode/tasks.json vendored 100644
View File

@ -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"
}
]
}

View File

@ -11,6 +11,10 @@ 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 `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`). - 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 ## Known bugs
### Building ### Building

View File

@ -7,7 +7,8 @@ eval (Lit x) = x
eval (Add x y) = eval x + eval y eval (Add x y) = eval x + eval y
eval (Sub x y) = eval x - eval y eval (Sub x y) = eval x - eval y
eval (Mul x y) = eval x * eval y eval (Mul x y) = eval x * eval y
eval (Div x y) = eval x `div` eval y
-- eval (Div x y) = eval x `div` eval y
evalExpr :: Expr -> Int evalExpr :: Expr -> Int
evalExpr = eval evalExpr = eval

View File

@ -1,11 +1,14 @@
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
-- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs -- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
module LLVMGen.Expr (getLLVMStr) where module LLVMGen.Expr (getLLVMStr) where
import Control.Monad.IO.Class
import Data.Text.Lazy import Data.Text.Lazy
import Debug.Trace
import LLVM.AST hiding (function) import LLVM.AST hiding (function)
import LLVM.AST.Type import LLVM.AST.Type
import LLVM.IRBuilder.Constant import LLVM.IRBuilder.Constant
@ -15,19 +18,20 @@ import LLVM.IRBuilder.Monad
import LLVM.Pretty import LLVM.Pretty
import Types.Expr as Expr import Types.Expr as Expr
-- charStar :: LLVM.Type
-- charStar = LLVM.ptr LLVM.i8
getLLVM :: Expr -> Module getLLVM :: Expr -> Module
getLLVM expr = getLLVM expr =
buildModule "program" $ do buildModule "program" $ mdo
-- TODO: better naming -- TODO: better module name
printf <- externVarArgs "printf" [ptr] i32 -- or LLVM.ptr LLVM.i8 printf <- externVarArgs "printf" [ptr] i32
-- let printf = extern "printf" [(ptr)] i32
let numFormatStr = globalStringPtr "%d\n" (mkName "str") let numFormatStr = globalStringPtr "%d\n" (mkName "str")
function "main" [] i32 $ \_ -> do function "main" [] i32 $ \_ -> mdo
ourExpression <- exprToLLVM expr ourExpression <- exprToLLVM expr
nfs <- numFormatStr nfs <- numFormatStr
_ <- call i32 printf [(ConstantOperand nfs, []), (ourExpression, [])] traceShow ourExpression $ pure ()
-- llvmCode <- moduleLLVMAssembly
-- liftIO $ putStrLn llvmCode
_ <- call (FunctionType i32 [i32] False) printf [(ConstantOperand nfs, []), (ourExpression, [])]
ret (int32 0) ret (int32 0)
exprToLLVM :: exprToLLVM ::
@ -37,15 +41,15 @@ exprToLLVM ::
Expr -> Expr ->
m Operand m Operand
exprToLLVM (Lit prim) = pure $ primToLLVM prim exprToLLVM (Lit prim) = pure $ primToLLVM prim
exprToLLVM (Expr.Add a b) = do exprToLLVM (Expr.Add a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
add lhs rhs add lhs rhs
exprToLLVM (Expr.Sub a b) = do exprToLLVM (Expr.Sub a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
sub lhs rhs sub lhs rhs
exprToLLVM (Expr.Mul a b) = do exprToLLVM (Expr.Mul a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
mul lhs rhs mul lhs rhs

View File

@ -22,4 +22,5 @@ main = do
contents <- readFile fileName contents <- readFile fileName
let result = getResult contents let result = getResult contents
print result print result
T.putStrLn (getLLVMStr (getRight (parseExpr contents))) let parsed = getRight (parseExpr contents)
T.putStrLn (getLLVMStr parsed)

View File

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

View File

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