{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}

-- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs

module Compiler.LLVMGen (llvmGen) where

-- import LLVM.Pretty

import Data.ByteString (ByteString)
import Debug.Trace
import LLVM (moduleLLVMAssembly, withModuleFromAST, writeLLVMAssemblyToFile)
import LLVM.AST hiding (function)
import LLVM.AST.Type
import LLVM.Context
import LLVM.IRBuilder.Constant
import LLVM.IRBuilder.Instruction
import LLVM.IRBuilder.Module
import LLVM.IRBuilder.Monad
import Types.Expr as Expr

getLLVM :: Expr -> Module
getLLVM expr =
  buildModule "program" $ mdo
    -- TODO: better module name
    printf <- externVarArgs "printf" [ptr] i32
    function "main" [] i32 $ \_ -> mdo
      numFormatStr <- globalStringPtr "%d\n" (mkName "str")
      traceShow numFormatStr $ pure ()
      ourExpression <- exprToLLVM expr
      -- _ <- call (FunctionType i32 [i32])
      _ <- call (FunctionType i32 [ptr] True) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])]
      ret (int32 0)

exprToLLVM ::
  ( MonadIRBuilder m,
    MonadModuleBuilder m
  ) =>
  Expr ->
  m Operand
exprToLLVM (Lit prim) = pure $ primToLLVM prim
exprToLLVM (Expr.Add a b) = mdo
  lhs <- exprToLLVM a
  rhs <- exprToLLVM b
  add lhs rhs
exprToLLVM (Expr.Sub a b) = mdo
  lhs <- exprToLLVM a
  rhs <- exprToLLVM b
  sub lhs rhs
exprToLLVM (Expr.Mul a b) = mdo
  lhs <- exprToLLVM a
  rhs <- exprToLLVM b
  mul lhs rhs

primToLLVM :: Int -> Operand
primToLLVM i = int32 (fromIntegral i)

llvmGen :: Expr -> IO ByteString
llvmGen expr = do
  let l = getLLVM expr
  withContext
    ( \c ->
        withModuleFromAST c l moduleLLVMAssembly
    )