Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import AST as K -- K for Kaleidoscope
   4 import Utils
   5 import Control.Monad.IO.Class
   6 import qualified Data.Text.Lazy.IO as Text
   7 import LLVM.AST.Constant
   8 import LLVM.AST.Float
   9 import LLVM.AST.FloatingPointPredicate hiding (False, True)
  10 import LLVM.AST.Operand
  11 import LLVM.AST.Type as Type
  12 import LLVM.IRBuilder
  13 import LLVM.Pretty
  14 import System.IO
  15 import Text.Read (readMaybe)
  16
  17 main = buildModuleT "main" repl
  18
  19 repl :: ModuleBuilderT IO ()
  20 repl = do
  21   liftIO $ hPutStr stderr "ready> "
  22   ast <- liftIO $ readMaybe <$> getLine
  23   case ast of
  24     Nothing ->  liftIO $ hPutStrLn stderr "Couldn't parse"
  25     Just x -> do
  26       hoist $ buildAST x
  27       mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll
  28   repl
  29   where
  30
  31 buildAST :: AST -> ModuleBuilder Operand
  32 buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $
  33   const $ buildExpr x >>= ret
  34
  35 buildExpr :: Expr -> IRBuilderT ModuleBuilder Operand
  36 buildExpr (Num x) = pure $ ConstantOperand (Float (Double x))
  37 buildExpr (BinOp op a b) = do
  38   opA <- buildExpr a
  39   opB <- buildExpr b
  40   tmp <- instr opA opB
  41   if isCmp
  42     then uitofp tmp Type.double
  43     else return tmp
  44   where isCmp
  45           | Cmp _ <- op = True
  46           | otherwise = False
  47         instr = case op of
  48                   K.Add -> fadd
  49                   K.Sub -> fsub
  50                   K.Mul -> fmul
  51                   K.Cmp LT -> fcmp OLT
  52                   K.Cmp GT -> fcmp OGT
  53                   K.Cmp EQ -> fcmp OEQ