{-# 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.Extra.Execution as Exec

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

import Foreign.Ptr (Ptr, )

import Control.Monad (void, liftM2, when, )


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 ::
   (Exec.Compile funcs) =>
   String ->
   LLVM.CodeGenModule (Exec.LLVMFunction funcs) ->
   IO funcs
compile name bld = do
   LLVM.initializeNativeTarget
   m <- LLVM.newModule
   (funcs, mappings) <-
      LLVM.defineModule m $
      liftM2 (,) bld LLVM.getGlobalMappings
   LLVM.writeBitcodeToFile (name ++ ".bc") m
   when False $ do
      void $ Opt.optimizeModule 3 m
      LLVM.writeBitcodeToFile (name ++ "-opt.bc") m
   EE.runEngineAccess $
      EE.addModule m >>
      EE.addGlobalMappings mappings >>
      Exec.compile funcs