From: Luke Lau <luke_lau@icloud.com>
Date: Sat, 18 May 2019 21:52:15 +0000 (+0100)
Subject: Begin codegen
X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs.git;a=commitdiff_plain;h=38600a47841e2c5837b5693b32c35d2093864458

Begin codegen

Now the fun begins.
You should start by installing the llvm-hs packages. This tutorial will
be keeping things "vanilla" by just installing the packages globally
rather than using a .cabal file.

$ cabal new-install --lib llvm-hs llvm-hs-pure llvm-hs-pretty --write-ghc-environment-files=always

The above command should be enough to install them, assuming you already
have LLVM installed correctly. (At the time of writing llvm-hs-pretty
needs to be installed from source for llvm-8.0:
https://github.com/llvm-hs/llvm-hs-pretty)

Like our parsing, our code generation is also monadic (this is a Haskell
tutorial). There are two monads that we can use: IRBuilder and
ModuleBuilder. The former is for LLVM IR instructions and the latter for
function definitions, constants and the like.

The original tutorial puts everything into one module, so we are going
to follow suit here. This makes things a bit hairy since now the repl
needs to take place inside of a ModuleBuilderT IO. In an effort to keep
our code as pure as possible, we've added a hoist function so that we
can keep our codegen code inside ModuleBuilder.

There's also a helper function to grab the most recent definition so
that we can print out similar to in the tutorial. This and hoist have
been tucked away into Util.hs.

So far we only generate code for numbers: But this now paves the way for
the rest of the code generation.
---

diff --git a/AST.hs b/AST.hs
index b57d7cb..dfa43b7 100644
--- a/AST.hs
+++ b/AST.hs
@@ -4,7 +4,7 @@ import Data.Char
 import Text.Read 
 import Text.ParserCombinators.ReadP hiding ((+++), choice)
 
-data Expr = Num Float
+data Expr = Num Double
           | Var String
           | BinOp BinOp Expr Expr
           | Call String [Expr]
diff --git a/Main.hs b/Main.hs
index ec0de8c..816692b 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,10 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 import AST
+import Utils
+import Control.Monad.IO.Class
+import qualified Data.Text.Lazy.IO as Text
+import LLVM.AST.Constant
+import LLVM.AST.Float
+import LLVM.AST.Operand
+import LLVM.AST.Type as Type
+import LLVM.IRBuilder
+import LLVM.Pretty
 import System.IO
-import Text.Read
-main = do
-  hPutStr stderr "ready> "
-  ast <- (readMaybe <$> getLine) :: IO (Maybe AST)
+import Text.Read (readMaybe)
+
+main = buildModuleT "main" repl
+
+repl :: ModuleBuilderT IO ()
+repl = do
+  liftIO $ hPutStr stderr "ready> "
+  ast <- liftIO $ readMaybe <$> getLine
   case ast of
-    Just x -> hPrint stderr x
-    Nothing ->  hPutStrLn stderr "Couldn't parse"
-  main
+    Nothing ->  liftIO $ hPutStrLn stderr "Couldn't parse"
+    Just x -> do
+      hoist $ buildAST x
+      mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll
+  repl
+  where 
+
+buildAST :: AST -> ModuleBuilder Operand
+buildAST (TopLevelExpr x) = function "__anon_expr" [] Type.double $
+  const $ buildExpr x >>= ret
+
+buildExpr :: Expr -> IRBuilderT ModuleBuilder Operand
+buildExpr (Num x) = pure $ ConstantOperand (Float (Double x))
diff --git a/Utils.hs b/Utils.hs
new file mode 100644
index 0000000..2a83c35
--- /dev/null
+++ b/Utils.hs
@@ -0,0 +1,17 @@
+{-|
+Shoving away gross stuff into this one module.
+-}
+module Utils where
+
+import Control.Monad.Trans.State
+import Data.Functor.Identity
+import LLVM.AST
+import LLVM.IRBuilder.Module
+import LLVM.IRBuilder.Internal.SnocList
+
+mostRecentDef :: Monad m => ModuleBuilderT m Definition
+mostRecentDef = last . getSnocList . builderDefs <$> liftModuleState get
+
+hoist :: Monad m => ModuleBuilder a -> ModuleBuilderT m a
+hoist m = ModuleBuilderT $ StateT $
+  return . runIdentity . runStateT (unModuleBuilderT m)