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.AddrSpace
11 import LLVM.AST.Constant
13 import LLVM.AST.FloatingPointPredicate hiding (False, True)
14 import LLVM.AST.Operand
15 import LLVM.AST.Type as Type
19 import LLVM.PassManager
23 import System.IO.Error
24 import Text.Read (readMaybe)
28 mdl' <- buildModuleT "main" repl
29 withContext $ \ctx -> withHostTargetMachine $ \tm ->
30 withModuleFromAST ctx mdl' $ \mdl -> do
31 let spec = defaultCuratedPassSetSpec { optLevel = Just 3 }
32 -- this returns true if the module was modified
33 withPassManager spec $ flip runPassManager mdl
34 Text.hPutStrLn stderr . ("\n" <>) . ppllvm =<< moduleAST mdl
36 repl :: ModuleBuilderT IO ()
38 liftIO $ hPutStr stderr "ready> "
39 mline <- liftIO $ catchIOError (Just <$> getLine) eofHandler
44 Nothing -> liftIO $ hPutStrLn stderr "Couldn't parse"
47 mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll
51 | isEOFError e = return Nothing
52 | otherwise = ioError e
54 type Binds = Map.Map String Operand
56 buildAST :: AST -> ModuleBuilder Operand
57 buildAST (Function (Prototype nameStr paramStrs) body) = do
58 let n = fromString nameStr
59 function n params Type.double $ \ops -> do
60 let binds = Map.fromList (zip paramStrs ops)
61 flip runReaderT binds $ buildExpr body >>= ret
62 where params = zip (repeat Type.double) (map fromString paramStrs)
64 buildAST (Extern (Prototype nameStr params)) =
65 extern (fromString nameStr) (replicate (length params) Type.double) Type.double
67 buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $
68 const $ flip runReaderT mempty $ buildExpr x >>= ret
70 buildExpr :: Expr -> ReaderT Binds (IRBuilderT ModuleBuilder) Operand
71 buildExpr (Num x) = pure $ ConstantOperand (Float (Double x))
72 buildExpr (Var n) = do
74 case binds Map.!? n of
76 Nothing -> error $ "'" <> n <> "' doesn't exist in scope"
78 buildExpr (BinOp op a b) = do
83 then uitofp tmp Type.double
96 buildExpr (Call callee params) = do
97 paramOps <- mapM buildExpr params
98 let nam = fromString callee
99 -- get a pointer to the function
100 typ = FunctionType Type.double (replicate (length params) Type.double) False
101 ptrTyp = Type.PointerType typ (AddrSpace 0)
102 ref = GlobalReference ptrTyp nam
103 call (ConstantOperand ref) (zip paramOps (repeat []))