{-# 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