{-# LANGUAGE TypeFamilies #-}
module Data.Array.Knead.Code where

import qualified Data.Array.Knead.Index.Nested.Shape as Shape

import qualified LLVM.Extra.Multi.Value as MultiValue

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

import Foreign.Ptr (Ptr, FunPtr, )

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

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


getElementPtr ::
   (Shape.C sh, Shape.Index sh ~ ix) =>
   MultiValue.T sh -> LLVM.Value (Ptr a) ->
   MultiValue.T ix ->
   LLVM.CodeGenFunction r (LLVM.Value (Ptr a))
getElementPtr sh ptr ix = do
   n <- Shape.flattenIndex sh ix
   LLVM.getElementPtr ptr (n, ())


compile :: String -> Exec funcs -> IO funcs
compile name (Compose bld) = do
   LLVM.initializeNativeTarget
   m <- LLVM.newModule
   (funcs, mappings) <-
      LLVM.defineModule m $ do
         LLVM.setTarget LLVM.hostTriple
         liftM2 (,) bld LLVM.getGlobalMappings
   LLVM.writeBitcodeToFile (name ++ ".bc") m
   when False $ do
      void $ Opt.optimizeModule 3 m
      LLVM.writeBitcodeToFile (name ++ "-opt.bc") m
   EE.runEngineAccessWithModule m $
      EE.addGlobalMappings mappings >> funcs


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

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