X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=Main.hs;h=97407fee2fbf6ef7907f3f45a934e737fa29d593;hb=705b0b8458673edb7273e6e19914390a55e51d23;hp=bc7c3077f9b6bbdda78273381921826110acf62a;hpb=18c4b939a6ba1099cd7296b839428f829533f3c8;p=kaleidoscope-hs.git

diff --git a/Main.hs b/Main.hs
index bc7c307..97407fe 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,60 @@ 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)]
+
+buildExpr (For name init cond mStep body) = mdo
+  preheaderB <- block `named` "preheader"
+
+  initV <- buildExpr init `named` "init"
+  
+  -- build the condition expression with 'i' in the bindings
+  initCondV <- withReaderT (Map.insert name initV) $
+                (buildExpr cond >>= fcmp ONE zero) `named` "initcond"
+
+  -- skip the loop if we don't meet the condition with the init
+  condBr initCondV loopB afterB
+
+  loopB <- block `named` "loop"
+  i <- phi [(initV, preheaderB), (nextVar, loopB)] `named` "i"
+
+  -- build the body expression with 'i' in the bindings
+  withReaderT (Map.insert name i) $ buildExpr body `named` "body"
+
+  -- default to 1 if there's no step defined
+  stepV <- case mStep of
+    Just step -> buildExpr step
+    Nothing -> return $ ConstantOperand (Float (Double 1))
+
+  nextVar <- fadd i stepV `named` "nextvar"
+
+  let zero = ConstantOperand (Float (Double 0))
+  -- again we need 'i' in the bindings
+  condV <- withReaderT (Map.insert name i) $
+            (buildExpr cond >>= fcmp ONE zero) `named` "cond"
+  condBr condV loopB afterB
+
+  afterB <- block `named` "after"
+  -- since a for loop doesn't really have a value, return 0
+  return $ ConstantOperand (Float (Double 0))
+