diff --git a/main/Compiler/ExeGen.hs b/main/Compiler/ExeGen.hs new file mode 100644 index 0000000..d35f82e --- /dev/null +++ b/main/Compiler/ExeGen.hs @@ -0,0 +1 @@ +module Compiler.ExeGen () where diff --git a/main/LLVMGen/Expr.hs b/main/Compiler/LLVMGen.hs similarity index 73% rename from main/LLVMGen/Expr.hs rename to main/Compiler/LLVMGen.hs index 35736e4..14d0431 100644 --- a/main/LLVMGen/Expr.hs +++ b/main/Compiler/LLVMGen.hs @@ -4,11 +4,9 @@ -- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs -module LLVMGen.Expr (getLLVMStr) where +module Compiler.LLVMGen (llvmGen) where -import Control.Monad.IO.Class import Data.Text.Lazy -import Debug.Trace import LLVM.AST hiding (function) import LLVM.AST.Type import LLVM.IRBuilder.Constant @@ -23,15 +21,10 @@ getLLVM expr = buildModule "program" $ mdo -- TODO: better module name printf <- externVarArgs "printf" [ptr] i32 - -- let printf = extern "printf" [(ptr)] i32 - let numFormatStr = globalStringPtr "%d\n" (mkName "str") function "main" [] i32 $ \_ -> mdo + numFormatStr <- globalStringPtr "%d\n" (mkName "str") ourExpression <- exprToLLVM expr - nfs <- numFormatStr - traceShow ourExpression $ pure () - -- llvmCode <- moduleLLVMAssembly - -- liftIO $ putStrLn llvmCode - _ <- call (FunctionType i32 [i32] False) printf [(ConstantOperand nfs, []), (ourExpression, [])] + _ <- call (FunctionType i32 [i32] False) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])] ret (int32 0) exprToLLVM :: @@ -57,5 +50,5 @@ exprToLLVM (Expr.Mul a b) = mdo primToLLVM :: Int -> Operand primToLLVM i = int32 (fromIntegral i) -getLLVMStr :: Expr -> Text -getLLVMStr expr = ppllvm (getLLVM expr) \ No newline at end of file +llvmGen :: Expr -> Text +llvmGen expr = ppllvm (getLLVM expr) \ No newline at end of file diff --git a/main/Eval/Expr.hs b/main/Eval/Expr.hs deleted file mode 100644 index e4fc440..0000000 --- a/main/Eval/Expr.hs +++ /dev/null @@ -1,14 +0,0 @@ -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 \ No newline at end of file diff --git a/main/LLVMGen/Expr.hs.old b/main/LLVMGen/Expr.hs.old deleted file mode 100644 index fac2110..0000000 --- a/main/LLVMGen/Expr.hs.old +++ /dev/null @@ -1,74 +0,0 @@ -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_ \ No newline at end of file diff --git a/main/Main.hs b/main/Main.hs index 3805b0b..d2669c1 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -3,9 +3,9 @@ module Main (main) where +-- import Compiler.ExeGen +import Compiler.LLVMGen import Data.Text.Lazy.IO qualified as T -import Eval.Expr -import LLVMGen.Expr import Parser.Expr import System.Environment import Types.Expr @@ -13,14 +13,9 @@ 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 - let result = getResult contents - print result let parsed = getRight (parseExpr contents) - T.putStrLn (getLLVMStr parsed) + T.putStrLn (llvmGen parsed) diff --git a/really-bad-compiler-in-haskell.cabal b/really-bad-compiler-in-haskell.cabal index 8d3b947..fe722e3 100644 --- a/really-bad-compiler-in-haskell.cabal +++ b/really-bad-compiler-in-haskell.cabal @@ -16,8 +16,8 @@ tested-with: executable really-bad-compiler-in-haskell main-is: Main.hs other-modules: - Eval.Expr - LLVMGen.Expr + Compiler.ExeGen + Compiler.LLVMGen Parser.Expr Types.Expr Paths_really_bad_compiler_in_haskell