{-# LANGUAGE OverloadedStrings #-} import AST as K -- K for Kaleidoscope import Utils import Control.Monad.Trans.Reader import Control.Monad.IO.Class import Data.String import qualified Data.Map as Map 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 type Binds = Map.Map String Operand buildAST :: AST -> ModuleBuilder Operand buildAST (Function (Prototype nameStr paramStrs) body) = do let n = fromString nameStr function n params Type.double $ \ops -> do let binds = Map.fromList (zip paramStrs ops) flip runReaderT binds $ buildExpr body >>= ret where params = zip (repeat Type.double) (map fromString paramStrs) buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $ const $ flip runReaderT mempty $ buildExpr x >>= ret buildExpr :: Expr -> ReaderT Binds (IRBuilderT ModuleBuilder) Operand buildExpr (Num x) = pure $ ConstantOperand (Float (Double x)) buildExpr (Var n) = do binds <- ask case binds Map.!? n of Just x -> pure x Nothing -> error $ "'" <> n <> "' doesn't exist in scope" 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