X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs.git;a=blobdiff_plain;f=Main.hs;h=ca6629ab447cd64b7c8748eec07ffa7fe6b34e9d;hp=76a9bdb5d48831da2e59c811ecbcbb5a379bdfb5;hb=fb7d66e2e530c51a6a20239f8f2cd644f40fecea;hpb=30a26b7d2b0e17ea523ee34cb5d37242a38882df diff --git a/Main.hs b/Main.hs index 76a9bdb..ca6629a 100644 --- a/Main.hs +++ b/Main.hs @@ -1 +1,53 @@ -main = pure () +{-# LANGUAGE OverloadedStrings #-} + +import AST as K -- K for Kaleidoscope +import Utils +import Control.Monad.IO.Class +import qualified Data.Text.Lazy.IO as Text +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.IRBuilder +import LLVM.Pretty +import System.IO +import Text.Read (readMaybe) + +main = buildModuleT "main" repl + +repl :: ModuleBuilderT IO () +repl = do + liftIO $ hPutStr stderr "ready> " + ast <- liftIO $ readMaybe <$> getLine + case ast of + Nothing -> liftIO $ hPutStrLn stderr "Couldn't parse" + Just x -> do + hoist $ buildAST x + mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll + repl + where + +buildAST :: AST -> ModuleBuilder Operand +buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $ + const $ buildExpr x >>= ret + +buildExpr :: Expr -> IRBuilderT ModuleBuilder Operand +buildExpr (Num x) = pure $ ConstantOperand (Float (Double x)) +buildExpr (BinOp op a b) = do + opA <- buildExpr a + opB <- buildExpr b + tmp <- instr opA opB + if isCmp + then uitofp tmp Type.double + else return tmp + where isCmp + | Cmp _ <- op = True + | otherwise = False + instr = case op of + K.Add -> fadd + K.Sub -> fsub + K.Mul -> fmul + K.Cmp LT -> fcmp OLT + K.Cmp GT -> fcmp OGT + K.Cmp EQ -> fcmp OEQ