Add print functionality

example/2.hear

@@ -1 +1 @@
-6+8/3
+ (6+8/3)

package.yaml

@@ -7,9 +7,13 @@ dependencies:
   - parser-combinators
   - text
   - process
+  - mtl
+  - containers
   - llvm-hs >= 15 && < 16
   - llvm-hs-pure >= 15 && < 16
   - bytestring
+  - string-conversions
+  - transformers
 tested-with: GHC == 9.2.8
 category: Compilers/Interpreters
 

really-bad-compiler-in-haskell.cabal

@@ -28,10 +28,14 @@ executable really-bad-compiler-in-haskell
   build-depends:
       base >=4.14.3 && <5
     , bytestring
+    , containers
     , llvm-hs ==15.*
     , llvm-hs-pure ==15.*
     , megaparsec >=9.0.1 && <10
+    , mtl
     , parser-combinators
     , process
+    , string-conversions
     , text
+    , transformers
   default-language: Haskell2010

src/Main/LLVMGen.hs

@@ -1,12 +1,19 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecursiveDo #-}
 
 -- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
+-- see https://blog.josephmorag.com/posts/mcc3/
 
 module Main.LLVMGen (llvmGen) where
 
+import Control.Monad.State
+import Control.Monad.Trans.Class (lift)
 import Data.ByteString (ByteString)
+import Data.Map qualified as M
+import Data.String.Conversions
+import Data.Text
 import LLVM (moduleLLVMAssembly, withModuleFromAST)
 import LLVM.AST hiding (function)
 import LLVM.AST.Type
@@ -17,34 +24,71 @@ import LLVM.IRBuilder.Module
 import LLVM.IRBuilder.Monad
 import Main.Types.Expr as Expr
 
--- printf :: Operand
--- printf = externVarArgs "printf" [ptr] i32
+data Env = Env
+  { operands :: M.Map Text Operand,
+    strings :: M.Map Text Operand
+  }
+  deriving (Eq, Show)
+
+registerOperand :: (MonadState Env m) => Text -> Operand -> m ()
+registerOperand name op =
+  modify $ \env -> env {operands = M.insert name op (operands env)}
+
+registerString :: (MonadState Env m) => Text -> Operand -> m ()
+registerString name op =
+  modify $ \env -> env {strings = M.insert name op (operands env)}
+
+getOperand :: (MonadState Env m, MonadModuleBuilder m, MonadIRBuilder m) => Text -> m Operand
+getOperand name = do
+  env <- get
+  case M.lookup name (operands env) of
+    Just op -> return op
+    Nothing -> error $ "Unknown operand: " ++ show name
+
+getString :: (MonadState Env m, MonadModuleBuilder m, MonadIRBuilder m) => Text -> m Operand
+getString str = do
+  env <- get
+  case M.lookup str (strings env) of
+    Just s -> return s
+    Nothing -> do
+      s <- globalStringPtr (unpack str) (mkName "str")
+      let operand = ConstantOperand s
+      modify $ \env -> env {strings = M.insert str operand (strings env)}
+      return operand
 
 getLLVM :: Expr -> Module
 getLLVM expr =
-  buildModule "program" $ mdo
+  flip evalState (Env {operands = M.empty, strings = M.empty}) $
+    buildModuleT "program" $ mdo
       -- TODO: better module name
       printf <- externVarArgs "printf" [ptr] i32
+      lift $ registerOperand "printf" printf
       function "main" [] i32 $ \_ -> mdo
-      numFormatStr <- globalStringPtr "%d\n" (mkName "str")
-      ourExpression <- exprToLLVM expr
-      _ <- call (FunctionType i32 [ptr] True) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])]
+        printNumStr <- globalStringPtr "%d\n" (mkName "str")
+        lift $ registerString "%d\n" $ ConstantOperand printNumStr
+        _ <- exprToLLVM expr
         ret $ int32 0
 
--- getLLVM2 expr =
--- getLLVM $
-
--- return (printf)
+--
+-- ourExpression <- exprToLLVM expr
+-- _ <- call (FunctionType i32 [ptr] True) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])]
+-- ret $ int32 0
 
 exprToLLVM ::
   ( MonadIRBuilder m,
-    MonadModuleBuilder m
+    MonadModuleBuilder m,
+    MonadState Env m
   ) =>
   Expr ->
   m Operand
 exprToLLVM (Lit prim) = pure $ primToLLVM prim
 exprToLLVM (Paren e) = exprToLLVM e
--- exprToLLVM (Print e) = mdo
+exprToLLVM (Print e) = mdo
+  val <- exprToLLVM e
+  printf <- getOperand "printf"
+  formatStr <- getString "%d\n"
+  _ <- call (FunctionType i32 [ptr] True) printf [(formatStr, []), (val, [])]
+  pure val
 exprToLLVM (Expr.Add a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b