X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs.git;a=blobdiff_plain;f=Main.hs;h=2a5a7e0fbc6c490b0d90af2da2e54a843138341f;hp=2eae262967be844fff1886ac2d34318912b17e53;hb=795fc872e603cc359ec6e307969ac925c3b5dc4d;hpb=8cd4f6315dc3efd76822337e935b7d465a134a5e diff --git a/Main.hs b/Main.hs index 2eae262..2a5a7e0 100644 --- a/Main.hs +++ b/Main.hs @@ -7,6 +7,7 @@ import Control.Monad.IO.Class import Data.String import qualified Data.Map as Map import qualified Data.Text.Lazy.IO as Text +import LLVM.AST.AddrSpace import LLVM.AST.Constant import LLVM.AST.Float import LLVM.AST.FloatingPointPredicate hiding (False, True) @@ -15,21 +16,29 @@ import LLVM.AST.Type as Type import LLVM.IRBuilder import LLVM.Pretty import System.IO +import System.IO.Error import Text.Read (readMaybe) -main = buildModuleT "main" repl +main :: IO () +main = buildModuleT "main" repl >>= Text.hPutStrLn stderr . ("\n" <>) . ppll repl :: ModuleBuilderT IO () repl = do liftIO $ hPutStr stderr "ready> " - ast <- liftIO $ readMaybe <$> getLine - case ast of + mline <- liftIO $ catchIOError (Just <$> getLine) eofHandler + case mline of + Nothing -> return () + Just l -> do + case readMaybe l of Nothing -> liftIO $ hPutStrLn stderr "Couldn't parse" - Just x -> do - hoist $ buildAST x + Just ast -> do + hoist $ buildAST ast mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll repl where + eofHandler e + | isEOFError e = return Nothing + | otherwise = ioError e type Binds = Map.Map String Operand @@ -41,6 +50,9 @@ buildAST (Function (Prototype nameStr paramStrs) body) = do flip runReaderT binds $ buildExpr body >>= ret where params = zip (repeat Type.double) (map fromString paramStrs) +buildAST (Extern (Prototype nameStr params)) = + extern (fromString nameStr) (replicate (length params) Type.double) Type.double + buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $ const $ flip runReaderT mempty $ buildExpr x >>= ret @@ -69,3 +81,12 @@ buildExpr (BinOp op a b) = do K.Cmp LT -> fcmp OLT K.Cmp GT -> fcmp OGT K.Cmp EQ -> fcmp OEQ + +buildExpr (Call callee params) = do + paramOps <- mapM buildExpr params + let nam = fromString callee + -- get a pointer to the function + typ = FunctionType Type.double (replicate (length params) Type.double) False + ptrTyp = Type.PointerType typ (AddrSpace 0) + ref = GlobalReference ptrTyp nam + call (ConstantOperand ref) (zip paramOps (repeat []))