X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=Main.hs;h=749f77188172479f341a8018650af7549c2d0c02;hb=023adfd1ca927790be8335c0df3334a861129da3;hp=bc7c3077f9b6bbdda78273381921826110acf62a;hpb=e82cbcc35f73376dcc628f8d537c80378e7ad4a7;p=kaleidoscope-hs.git diff --git a/Main.hs b/Main.hs index bc7c307..749f771 100644 --- a/Main.hs +++ b/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecursiveDo #-} import AST as K -- K for Kaleidoscope import Utils @@ -9,6 +10,7 @@ import Control.Monad.IO.Class import Data.String import qualified Data.Map as Map import qualified Data.Text.Lazy.IO as Text +import Foreign.Ptr import LLVM.AST.AddrSpace import LLVM.AST.Constant import LLVM.AST.Float @@ -27,6 +29,8 @@ import System.IO import System.IO.Error import Text.Read (readMaybe) +foreign import ccall "dynamic" mkFun :: FunPtr (IO Double) -> IO Double + data JITEnv = JITEnv { jitEnvContext :: Context , jitEnvCompileLayer :: IRCompileLayer ObjectLinkingLayer @@ -83,8 +87,10 @@ repl = do jit :: JITEnv -> Module -> IO Double jit JITEnv{jitEnvCompileLayer=compLayer, jitEnvModuleKey=mdlKey} mdl = - withModule compLayer mdlKey mdl $ - return 0 + withModule compLayer mdlKey mdl $ do + mangled <- mangleSymbol compLayer "__anon_expr" + Right (JITSymbol fPtr _) <- findSymbolIn compLayer mdlKey mangled False + mkFun (castPtrToFunPtr (wordPtrToPtr fPtr)) type Binds = Map.Map String Operand @@ -136,3 +142,24 @@ buildExpr (Call callee params) = do ptrTyp = Type.PointerType typ (AddrSpace 0) ref = GlobalReference ptrTyp nam call (ConstantOperand ref) (zip paramOps (repeat [])) + +buildExpr (If cond thenE elseE) = mdo + _ifB <- block `named` "if" + + -- since everything is a double, false == 0 + let zero = ConstantOperand (Float (Double 0)) + condV <- buildExpr cond + cmp <- fcmp ONE zero condV `named` "cmp" + + condBr cmp thenB elseB + + thenB <- block `named` "then" + thenOp <- buildExpr thenE + br mergeB + + elseB <- block `named` "else" + elseOp <- buildExpr elseE + br mergeB + + mergeB <- block `named` "ifcont" + phi [(thenOp, thenB), (elseOp, elseB)]