X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs-old.git;a=blobdiff_plain;f=Main.hs;h=eba1ce1c7ae6e8072b4e78862c2daf750280bdd4;hp=89fd91a39cf663048b77497b879e9d01903e5751;hb=e9d3bf0386f5654857fe6eaabe74ca651f9df76d;hpb=93653d435fe06ccc03a4b63bff1c86afba6e1ca0 diff --git a/Main.hs b/Main.hs index 89fd91a..eba1ce1 100644 --- a/Main.hs +++ b/Main.hs @@ -23,10 +23,9 @@ import LLVM.AST.Float import LLVM.AST.FloatingPointPredicate hiding (False, True) import LLVM.AST.Operand import LLVM.AST.Type as Type +import LLVM.AST.Typed import LLVM.Pretty -import Debug.Trace - type ModuleBuilderE = ModuleBuilderT (Either String) foreign import ccall "dynamic" exprFun :: FunPtr (IO Float) -> IO Float @@ -51,6 +50,22 @@ main = do let f' = castFunPtr f :: FunPtr (IO Float) exprFun f' >>= print +evalProg :: AST.Program -> IO (Maybe Float) +evalProg (AST.Program asts) = do + let eitherMdl = buildModuleT "main" $ mapM buildAST asts + case eitherMdl of + Left _ -> return Nothing + Right mdl -> withContext $ \ctx -> + withMCJIT ctx Nothing Nothing Nothing Nothing $ \mcjit -> + withModuleFromAST ctx mdl $ \mdl' -> + withModuleInEngine mcjit mdl' $ \emdl -> do + Just f <- getFunction emdl "expr" + let f' = castFunPtr f :: FunPtr (IO Float) + Just <$> exprFun f' + +-- | Builds up programs at the top-level of an LLVM Module +-- >>> evalProg (read "31 - 5") +-- Just 26.0 buildAST :: AST.AST -> ModuleBuilderE Operand buildAST (AST.Function nameStr paramStrs body) = do let n = fromString nameStr @@ -61,6 +76,11 @@ buildAST (AST.Function nameStr paramStrs body) = do buildAST (AST.Eval e) = function "expr" [] float $ \_ -> buildExpr mempty e >>= ret +-- | Builds up expressions, which are operands in LLVM IR +-- >>> evalProg (read "def foo(x) x * 2; foo(6)") +-- Just 12.0 +-- >>> evalProg (read "if 3 > 2 then 42 else 12") +-- Just 42.0 buildExpr :: Map.Map String Operand -> AST.Expr -> IRBuilderT ModuleBuilderE Operand buildExpr _ (AST.Num a) = pure $ ConstantOperand (Float (Single a)) buildExpr binds (AST.Var n) = case binds Map.!? n of @@ -90,7 +110,9 @@ buildExpr binds (AST.BinOp op a b) = do buildExpr binds (AST.If cond thenE elseE) = mdo _ifB <- block `named` "if" + condV <- buildExpr binds cond + when (typeOf condV /= i1) $ lift $ lift $ Left "Not a boolean" condBr condV thenB elseB thenB <- block `named` "then" @@ -102,4 +124,4 @@ buildExpr binds (AST.If cond thenE elseE) = mdo br mergeB mergeB <- block `named` "ifcont" - traceShowId <$> phi [(thenOp, thenB), (elseOp, elseB)] + phi [(thenOp, thenB), (elseOp, elseB)]