{-# LANGUAGE TypeFamilies #-}
module LLVM.DSL.Execution where

import qualified LLVM.DSL.Dump as Dump

import qualified LLVM.ExecutionEngine as EE
import qualified LLVM.Util.Optimize as Opt
import qualified LLVM.Core as LLVM

import Foreign.Ptr (FunPtr)

import Control.Monad (void, liftM2, when)
import Control.Applicative (liftA2, pure, (<$>))

import Data.Functor.Compose (Compose(Compose))

import Prelude2010
import Prelude ()


dumper :: String -> IO (String -> LLVM.Module -> IO ())
dumper = Dump.writer

compile :: String -> Exec funcs -> IO funcs
compile name (Compose bld) = do
   LLVM.initializeNativeTarget
   td <- EE.getTargetData
   m <- LLVM.newNamedModule name
   (funcs, mappings) <-
      LLVM.defineModule m $ do
         LLVM.setTarget LLVM.hostTriple
         LLVM.setDataLayout $ EE.dataLayoutStr td
         liftM2 (,) bld LLVM.getGlobalMappings
   writeBitcodeToFile <- dumper name
   writeBitcodeToFile "" m
   when True $ do
      void $ Opt.optimizeModule 3 m
      writeBitcodeToFile "-opt" m
   EE.runEngineAccessWithModule m $
      EE.addGlobalMappings mappings >> funcs


type Exec = Compose LLVM.CodeGenModule EE.EngineAccess
type Importer f = FunPtr f -> f

createLLVMFunction ::
   (LLVM.FunctionArgs f) =>
   String -> LLVM.FunctionCodeGen f -> LLVM.CodeGenModule (LLVM.Function f)
createLLVMFunction = LLVM.createNamedFunction LLVM.ExternalLinkage

createFunction ::
   (EE.ExecutionFunction f, LLVM.FunctionArgs f) =>
   Importer f -> String -> LLVM.FunctionCodeGen f -> Exec f
createFunction importer name f =
   Compose $ EE.getExecutionFunction importer <$> createLLVMFunction name f


type Finalizer a = (EE.ExecutionEngine, LLVM.Ptr a -> IO ())

createFinalizer ::
   (EE.ExecutionFunction f, LLVM.FunctionArgs f) =>
   Importer f -> String -> LLVM.FunctionCodeGen f ->
   Exec (EE.ExecutionEngine, f)
createFinalizer importer name f =
   liftA2 (,)
      (Compose $ pure EE.getEngine)
      (createFunction importer name f)