X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs-old.git;a=blobdiff_plain;f=Main.hs;h=eba1ce1c7ae6e8072b4e78862c2daf750280bdd4;hp=328aaf3c72c56d9b1d13f4f1de4376cf07b5681d;hb=e9d3bf0386f5654857fe6eaabe74ca651f9df76d;hpb=f250f7c0e621f1f94b6d2377f6a634314f306ace diff --git a/Main.hs b/Main.hs index 328aaf3..eba1ce1 100644 --- a/Main.hs +++ b/Main.hs @@ -26,8 +26,6 @@ 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 @@ -52,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 @@ -62,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 @@ -105,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)]