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

import qualified LLVM.DSL.Dump as Dump

import qualified LLVM.Extra.Function as LLVMFunction

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 :: String -> IO (String -> Module -> IO ())
dumper = String -> IO (String -> Module -> IO ())
Dump.writer

compile :: String -> Exec funcs -> IO funcs
compile :: forall funcs. String -> Exec funcs -> IO funcs
compile String
name (Compose CodeGenModule (EngineAccess funcs)
bld) = do
   IO ()
LLVM.initializeNativeTarget
   TargetData
td <- IO TargetData
EE.getTargetData
   Module
m <- String -> IO Module
LLVM.newNamedModule String
name
   (EngineAccess funcs
funcs, GlobalMappings
mappings) <-
      Module
-> CodeGenModule (EngineAccess funcs, GlobalMappings)
-> IO (EngineAccess funcs, GlobalMappings)
forall a. Module -> CodeGenModule a -> IO a
LLVM.defineModule Module
m (CodeGenModule (EngineAccess funcs, GlobalMappings)
 -> IO (EngineAccess funcs, GlobalMappings))
-> CodeGenModule (EngineAccess funcs, GlobalMappings)
-> IO (EngineAccess funcs, GlobalMappings)
forall a b. (a -> b) -> a -> b
$ do
         String -> CodeGenModule ()
LLVM.setTarget String
LLVM.hostTriple
         String -> CodeGenModule ()
LLVM.setDataLayout (String -> CodeGenModule ()) -> String -> CodeGenModule ()
forall a b. (a -> b) -> a -> b
$ TargetData -> String
EE.dataLayoutStr TargetData
td
         (EngineAccess funcs
 -> GlobalMappings -> (EngineAccess funcs, GlobalMappings))
-> CodeGenModule (EngineAccess funcs)
-> CodeGenModule GlobalMappings
-> CodeGenModule (EngineAccess funcs, GlobalMappings)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) CodeGenModule (EngineAccess funcs)
bld CodeGenModule GlobalMappings
LLVM.getGlobalMappings
   String -> Module -> IO ()
writeBitcodeToFile <- String -> IO (String -> Module -> IO ())
dumper String
name
   String -> Module -> IO ()
writeBitcodeToFile String
"" Module
m
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
True (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Module -> IO Bool
Opt.optimizeModule Int
3 Module
m
      String -> Module -> IO ()
writeBitcodeToFile String
"-opt" Module
m
   Module -> EngineAccess funcs -> IO funcs
forall a. Module -> EngineAccess a -> IO a
EE.runEngineAccessWithModule Module
m (EngineAccess funcs -> IO funcs) -> EngineAccess funcs -> IO funcs
forall a b. (a -> b) -> a -> b
$
      GlobalMappings -> EngineAccess ()
EE.addGlobalMappings GlobalMappings
mappings EngineAccess () -> EngineAccess funcs -> EngineAccess funcs
forall a b. EngineAccess a -> EngineAccess b -> EngineAccess b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EngineAccess funcs
funcs


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

createLLVMFunction ::
   (LLVMFunction.C f) =>
   String -> LLVMFunction.CodeGen f -> LLVM.CodeGenModule (LLVM.Function f)
createLLVMFunction :: forall f. C f => String -> CodeGen f -> CodeGenModule (Function f)
createLLVMFunction = Linkage -> String -> CodeGen f -> CodeGenModule (Value (FunPtr f))
forall f.
C f =>
Linkage -> String -> CodeGen f -> CodeGenModule (Function f)
LLVMFunction.createNamed Linkage
LLVM.ExternalLinkage

createFunction ::
   (EE.ExecutionFunction f, LLVMFunction.C f) =>
   Importer f -> String -> LLVMFunction.CodeGen f -> Exec f
createFunction :: forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
createFunction Importer f
importer String
name CodeGen f
f =
   CodeGenModule (EngineAccess f)
-> Compose CodeGenModule EngineAccess f
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (CodeGenModule (EngineAccess f)
 -> Compose CodeGenModule EngineAccess f)
-> CodeGenModule (EngineAccess f)
-> Compose CodeGenModule EngineAccess f
forall a b. (a -> b) -> a -> b
$ Importer f -> Function f -> EngineAccess f
forall f.
ExecutionFunction f =>
Importer f -> Function f -> EngineAccess f
EE.getExecutionFunction Importer f
importer (Function f -> EngineAccess f)
-> CodeGenModule (Function f) -> CodeGenModule (EngineAccess f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> CodeGen f -> CodeGenModule (Function f)
forall f. C f => String -> CodeGen f -> CodeGenModule (Function f)
createLLVMFunction String
name CodeGen f
f


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

createFinalizer ::
   (EE.ExecutionFunction f, LLVMFunction.C f) =>
   Importer f -> String -> LLVMFunction.CodeGen f ->
   Exec (EE.ExecutionEngine, f)
createFinalizer :: forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec (ExecutionEngine, f)
createFinalizer Importer f
importer String
name CodeGen f
f =
   (ExecutionEngine -> f -> (ExecutionEngine, f))
-> Compose CodeGenModule EngineAccess ExecutionEngine
-> Compose CodeGenModule EngineAccess f
-> Compose CodeGenModule EngineAccess (ExecutionEngine, f)
forall a b c.
(a -> b -> c)
-> Compose CodeGenModule EngineAccess a
-> Compose CodeGenModule EngineAccess b
-> Compose CodeGenModule EngineAccess c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
      (CodeGenModule (EngineAccess ExecutionEngine)
-> Compose CodeGenModule EngineAccess ExecutionEngine
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (CodeGenModule (EngineAccess ExecutionEngine)
 -> Compose CodeGenModule EngineAccess ExecutionEngine)
-> CodeGenModule (EngineAccess ExecutionEngine)
-> Compose CodeGenModule EngineAccess ExecutionEngine
forall a b. (a -> b) -> a -> b
$ EngineAccess ExecutionEngine
-> CodeGenModule (EngineAccess ExecutionEngine)
forall a. a -> CodeGenModule a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EngineAccess ExecutionEngine
EE.getEngine)
      (Importer f
-> String -> CodeGen f -> Compose CodeGenModule EngineAccess f
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
createFunction Importer f
importer String
name CodeGen f
f)