Compare commits

..

11 Commits

16 changed files with 245 additions and 125 deletions

2
.gitignore vendored
View File

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

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

@ -1,15 +1,23 @@
# Really Bad Compiler in Haskell # Really Bad Compiler in Haskell
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. 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 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). - Install `ghcup` (for managing Haskell tools) and `nix` (for managing external dependencies).
- Clone the repo. - 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`. - 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`). - 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 ## Known bugs
@ -27,20 +35,23 @@ Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
### Learning Resources Used ### Learning Resources Used
- Introduction to Compiler Design class at The University of Texas at Dallas, taught by Charles Averill - 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://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://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://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) - 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)
### Tools ### Tools
- Language: Haskell - Language: Haskell
- Haskell tools: GHCup, Stack, Cabal - Haskell tools: GHCup, Stack, Cabal, GHC 9.2
- Libraries: megaparsec, parser-combinators, text, llvm-hs-pure - Libraries: megaparsec, parser-combinators, text, process, llvm-hs 15, llvm-hs-pure 15,
- Dependencies: llvm, clang - Dependencies: llvm 15, clang 15
- IDE: VSCodium - IDE: VSCodium
- Git platform: Forgejo - Git platform: Forgejo
- AI: Phind - AI: Phind (GPT-4), ollama (codellama)
- Search: Kagi, Stack Overflow - Search: Kagi, Stack Overflow

View File

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

View File

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

View File

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

View File

@ -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)

View File

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

28
main/Main.hs 100644
View File

@ -0,0 +1,28 @@
{-# 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."

View File

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

11
main/Types/Expr.hs 100644
View File

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

View File

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

View File

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

View File

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