1 {-# LANGUAGE OverloadedStrings #-}
3 import AST as K -- K for Kaleidoscope
5 import Control.Monad.Trans.Reader
6 import Control.Monad.IO.Class
8 import qualified Data.Map as Map
9 import qualified Data.Text.Lazy.IO as Text
10 import LLVM.AST.Constant
12 import LLVM.AST.FloatingPointPredicate hiding (False, True)
13 import LLVM.AST.Operand
14 import LLVM.AST.Type as Type
18 import Text.Read (readMaybe)
20 main = buildModuleT "main" repl
22 repl :: ModuleBuilderT IO ()
24 liftIO $ hPutStr stderr "ready> "
25 ast <- liftIO $ readMaybe <$> getLine
27 Nothing -> liftIO $ hPutStrLn stderr "Couldn't parse"
30 mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll
34 type Binds = Map.Map String Operand
36 buildAST :: AST -> ModuleBuilder Operand
37 buildAST (Function (Prototype nameStr paramStrs) body) = do
38 let n = fromString nameStr
39 function n params Type.double $ \ops -> do
40 let binds = Map.fromList (zip paramStrs ops)
41 flip runReaderT binds $ buildExpr body >>= ret
42 where params = zip (repeat Type.double) (map fromString paramStrs)
44 buildAST (Extern (Prototype nameStr params)) =
45 extern (fromString nameStr) (replicate (length params) Type.double) Type.double
47 buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $
48 const $ flip runReaderT mempty $ buildExpr x >>= ret
50 buildExpr :: Expr -> ReaderT Binds (IRBuilderT ModuleBuilder) Operand
51 buildExpr (Num x) = pure $ ConstantOperand (Float (Double x))
52 buildExpr (Var n) = do
54 case binds Map.!? n of
56 Nothing -> error $ "'" <> n <> "' doesn't exist in scope"
58 buildExpr (BinOp op a b) = do
63 then uitofp tmp Type.double