{-# LANGUAGE ForeignFunctionInterface #-}
{- LANGUAGE CApiFFI #-}
module Numeric.CBLAS.FFI.Private (
   Routine.dotu, Routine.dotc, Routine.sum,
   omatcopy,
   copyMatrix,
   Routine.addMatrix,
   ) where

import qualified Numeric.CBLAS.FFI.Routine as Routine
import Numeric.CBLAS.FFI.Type (F77Int, F77Char)

import qualified Numeric.Netlib.Modifier as Modi
import qualified Numeric.Netlib.Class as Class
import qualified Numeric.Netlib.Utility as Call

import qualified Control.Monad.Trans.Cont as MC
-- import Control.Monad (join)

import Foreign.Marshal (with)
import Foreign.Ptr (Ptr)
-- import Foreign.C.Types

import Data.Complex (Complex)


type OMatCopy a =
      Ptr F77Char ->
      Ptr F77Int -> Ptr F77Int ->
      Ptr a ->
      Ptr a -> Ptr F77Int ->
      Ptr a -> Ptr F77Int ->
      IO ()

foreign import ccall "somatcopy" somatcopy :: OMatCopy Float
foreign import ccall "domatcopy" domatcopy :: OMatCopy Double
foreign import ccall "comatcopy" comatcopy :: OMatCopy (Complex Float)
foreign import ccall "zomatcopy" zomatcopy :: OMatCopy (Complex Double)
-- foreign import capi "blis/blis.h zomatcopy"

newtype OMATCOPY a = OMATCOPY {getOMATCOPY :: OMatCopy a}

omatcopy :: (Class.Floating a) => OMatCopy a
omatcopy =
   getOMATCOPY $
   Class.switchFloating
      (OMATCOPY somatcopy)
      (OMATCOPY domatcopy)
      (OMATCOPY comatcopy)
      (OMATCOPY zomatcopy)


copyMatrix ::
   (Class.Floating a) =>
   Modi.Transposition ->
   Int -> Int ->
   Ptr a -> Int ->
   Ptr a -> Int ->
   IO ()
copyMatrix transp rows cols a lda b ldb =
   transferMatrix transp rows cols 1 a lda b ldb

transferMatrix ::
   (Class.Floating a) =>
   Modi.Transposition ->
   Int -> Int ->
   a ->
   Ptr a -> Int ->
   Ptr a -> Int ->
   IO ()
transferMatrix transp rows cols alpha a lda b ldb =
   MC.evalContT $ Call.run $
   (pure omatcopy
--      <*> charArg 'C'
      <*> charArg
            (case transp of
               Modi.Transposed -> 'T'
               Modi.NonTransposed -> 'N')
      <*> intArg rows
      <*> intArg cols
      <*> Call.number alpha
      <*> pure a
      <*> intArg lda
      <*> pure b
      <*> intArg ldb)

charArg :: Char -> Call.FortranIO r (Ptr F77Char)
charArg = MC.ContT . with . fromIntegral . fromEnum

intArg :: Int -> Call.FortranIO r (Ptr F77Int)
intArg = MC.ContT . with . fromIntegral