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 System.IO.Error
19 import Text.Read (readMaybe)
22 main = buildModuleT "main" repl >>= Text.hPutStrLn stderr . ("\n" <>) . ppll
24 repl :: ModuleBuilderT IO ()
26 liftIO $ hPutStr stderr "ready> "
27 mline <- liftIO $ catchIOError (Just <$> getLine) eofHandler
32 Nothing -> liftIO $ hPutStrLn stderr "Couldn't parse"
35 mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll
39 | isEOFError e = return Nothing
40 | otherwise = ioError e
42 type Binds = Map.Map String Operand
44 buildAST :: AST -> ModuleBuilder Operand
45 buildAST (Function (Prototype nameStr paramStrs) body) = do
46 let n = fromString nameStr
47 function n params Type.double $ \ops -> do
48 let binds = Map.fromList (zip paramStrs ops)
49 flip runReaderT binds $ buildExpr body >>= ret
50 where params = zip (repeat Type.double) (map fromString paramStrs)
52 buildAST (Extern (Prototype nameStr params)) =
53 extern (fromString nameStr) (replicate (length params) Type.double) Type.double
55 buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $
56 const $ flip runReaderT mempty $ buildExpr x >>= ret
58 buildExpr :: Expr -> ReaderT Binds (IRBuilderT ModuleBuilder) Operand
59 buildExpr (Num x) = pure $ ConstantOperand (Float (Double x))
60 buildExpr (Var n) = do
62 case binds Map.!? n of
64 Nothing -> error $ "'" <> n <> "' doesn't exist in scope"
66 buildExpr (BinOp op a b) = do
71 then uitofp tmp Type.double