Reorganize program, removing unnecessary code

main/Compiler/ExeGen.hs

@@ -0,0 +1 @@
+module Compiler.ExeGen () where

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
+      _ <- call (FunctionType i32 [i32] False) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])]
-      traceShow ourExpression $ pure ()
-      -- llvmCode <- moduleLLVMAssembly
-      -- liftIO $ putStrLn llvmCode
-      _ <- call (FunctionType i32 [i32] False) printf [(ConstantOperand nfs, []), (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
+llvmGen :: Expr -> Text
-getLLVMStr expr = ppllvm (getLLVM expr)
+llvmGen expr = ppllvm (getLLVM expr)

main/Eval/Expr.hs

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

main/LLVMGen/Expr.hs.old

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

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)

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
+      Compiler.ExeGen
-      LLVMGen.Expr
+      Compiler.LLVMGen
       Parser.Expr
       Types.Expr
       Paths_really_bad_compiler_in_haskell