Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Main where
   4
   5 import qualified AST
   6 import qualified Data.Text.Lazy.IO as Text
   7 import Foreign.Ptr
   8 import System.IO
   9 import LLVM.Context
  10 import LLVM.CodeModel
  11 import LLVM.ExecutionEngine
  12 import LLVM.Module
  13 import LLVM.IRBuilder
  14 import LLVM.AST.Constant
  15 import LLVM.AST.Float
  16 import LLVM.AST.Operand
  17 import LLVM.AST.Type
  18 import LLVM.Pretty
  19
  20 foreign import ccall "dynamic" exprFun :: FunPtr (IO Float) -> IO Float
  21
  22 main :: IO ()
  23 main = do
  24   ast <- read <$> getContents
  25   let mdl = buildModule "main" $
  26         function "expr" [] float $ \_ -> build ast >>= ret
  27   Text.hPutStrLn stderr (ppllvm mdl)
  28   withContext $ \ctx ->
  29     withMCJIT ctx Nothing Nothing Nothing Nothing $ \mcjit ->
  30       withModuleFromAST ctx mdl $ \mdl' ->
  31         withModuleInEngine mcjit mdl' $ \emdl -> do
  32           Just f <- getFunction emdl "expr"
  33           let f' = castFunPtr f :: FunPtr (IO Float)
  34           exprFun f' >>= print
  35
  36 build :: AST.Expr -> IRBuilderT ModuleBuilder Operand
  37 build (AST.Num a) = pure $ ConstantOperand (Float (Single a))
  38 build (AST.BinOp op a b) = do
  39   va <- build a
  40   vb <- build b
  41   let instr = case op of
  42                 AST.Add -> fadd
  43                 AST.Sub -> fsub
  44                 AST.Mul -> fmul
  45   instr va vb