projects
/
kaleidoscope-hs-old.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
fff481b
)
Implement codegen for if statements
author
Luke Lau
<luke_lau@icloud.com>
Sun, 10 Mar 2019 16:07:39 +0000
(16:07 +0000)
committer
Luke Lau
<luke_lau@icloud.com>
Wed, 17 Apr 2019 22:38:30 +0000
(23:38 +0100)
Main.hs
patch
|
blob
|
history
diff --git
a/Main.hs
b/Main.hs
index 29592b18b0d3a4612c7d034bfae4822e12ef04d9..89fd91a39cf663048b77497b879e9d01903e5751 100644
(file)
--- a/
Main.hs
+++ b/
Main.hs
@@
-1,14
+1,17
@@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo #-}
module Main where
import qualified AST
module Main where
import qualified AST
+import Control.Monad
+import Control.Monad.Trans.Class
import qualified Data.Map as Map
import qualified Data.Text.Lazy.IO as Text
import Data.String
import Foreign.Ptr
import qualified Data.Map as Map
import qualified Data.Text.Lazy.IO as Text
import Data.String
import Foreign.Ptr
-import System.IO
import System.Exit
import System.Exit
+import System.IO
import LLVM.Context
import LLVM.ExecutionEngine
import LLVM.Module
import LLVM.Context
import LLVM.ExecutionEngine
import LLVM.Module
@@
-17,11
+20,12
@@
import LLVM.IRBuilder
import LLVM.AST.AddrSpace
import LLVM.AST.Constant
import LLVM.AST.Float
import LLVM.AST.AddrSpace
import LLVM.AST.Constant
import LLVM.AST.Float
+import LLVM.AST.FloatingPointPredicate hiding (False, True)
import LLVM.AST.Operand
import LLVM.AST.Type as Type
import LLVM.Pretty
import LLVM.AST.Operand
import LLVM.AST.Type as Type
import LLVM.Pretty
-import Control.Monad
-import
Control.Monad.Trans.Class
+
+import
Debug.Trace
type ModuleBuilderE = ModuleBuilderT (Either String)
type ModuleBuilderE = ModuleBuilderT (Either String)
@@
-33,11
+37,14
@@
main = do
let eitherMdl = buildModuleT "main" $ mapM buildAST asts
case eitherMdl of
Left err -> die err
let eitherMdl = buildModuleT "main" $ mapM buildAST asts
case eitherMdl of
Left err -> die err
- Right mdl -> withContext $ \ctx ->
+ Right mdl -> withContext $ \ctx -> do
+ hPutStrLn stderr "Before optimisation:"
+ Text.hPutStrLn stderr (ppllvm mdl)
withMCJIT ctx Nothing Nothing Nothing Nothing $ \mcjit ->
withModuleFromAST ctx mdl $ \mdl' ->
withPassManager defaultCuratedPassSetSpec $ \pm -> do
runPassManager pm mdl' >>= guard
withMCJIT ctx Nothing Nothing Nothing Nothing $ \mcjit ->
withModuleFromAST ctx mdl $ \mdl' ->
withPassManager defaultCuratedPassSetSpec $ \pm -> do
runPassManager pm mdl' >>= guard
+ hPutStrLn stderr "After optimisation:"
Text.hPutStrLn stderr . ppllvm =<< moduleAST mdl'
withModuleInEngine mcjit mdl' $ \emdl -> do
Just f <- getFunction emdl "expr"
Text.hPutStrLn stderr . ppllvm =<< moduleAST mdl'
withModuleInEngine mcjit mdl' $ \emdl -> do
Just f <- getFunction emdl "expr"
@@
-76,4
+83,23
@@
buildExpr binds (AST.BinOp op a b) = do
AST.Add -> fadd
AST.Sub -> fsub
AST.Mul -> fmul
AST.Add -> fadd
AST.Sub -> fsub
AST.Mul -> fmul
+ AST.Cmp GT -> fcmp OGT
+ AST.Cmp LT -> fcmp OLT
+ AST.Cmp EQ -> fcmp OEQ
instr va vb
instr va vb
+
+buildExpr binds (AST.If cond thenE elseE) = mdo
+ _ifB <- block `named` "if"
+ condV <- buildExpr binds cond
+ condBr condV thenB elseB
+
+ thenB <- block `named` "then"
+ thenOp <- buildExpr binds thenE
+ br mergeB
+
+ elseB <- block `named` "else"
+ elseOp <- buildExpr binds elseE
+ br mergeB
+
+ mergeB <- block `named` "ifcont"
+ traceShowId <$> phi [(thenOp, thenB), (elseOp, elseB)]