lapack-0.3: src/Numeric/LAPACK/Vector/Private.hs

module Numeric.LAPACK.Vector.Private where

import qualified Numeric.LAPACK.Shape.Private as ShapePriv

import qualified Numeric.LAPACK.FFI.Complex as LapackComplex
import qualified Numeric.BLAS.FFI.Generic as BlasGen
import qualified Numeric.Netlib.Utility as Call
import qualified Numeric.Netlib.Class as Class

import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (Ptr)
import Foreign.C.Types (CInt)

import Control.Monad.Trans.Cont (ContT(ContT), evalContT)
import Control.Monad.IO.Class (liftIO)

import qualified Data.Array.Comfort.Storable.Unchecked as Array
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable.Unchecked (Array(Array))


mac ::
   (Shape.C sh, Class.Floating a) =>
   a -> Array sh a -> Array sh a -> Array sh a
mac alpha (Array shX x) (Array _shY y) =
   Array.unsafeCreateWithSize shX $ \n szPtr -> evalContT $ do
      nPtr <- Call.cint n
      saPtr <- Call.number alpha
      sxPtr <- ContT $ withForeignPtr x
      incxPtr <- Call.cint 1
      syPtr <- ContT $ withForeignPtr y
      incyPtr <- Call.cint 1
      inczPtr <- Call.cint 1
      liftIO $ BlasGen.copy nPtr syPtr incyPtr szPtr inczPtr
      liftIO $ BlasGen.axpy nPtr saPtr sxPtr incxPtr szPtr inczPtr


newtype ArgMaximum a =
   ArgMaximum {runArgMaximum :: Ptr CInt -> Ptr a -> Ptr CInt -> IO CInt}

absMax :: Class.Floating a => Ptr CInt -> Ptr a -> Ptr CInt -> IO CInt
absMax =
   runArgMaximum $
   Class.switchFloating
      (ArgMaximum BlasGen.iamax)
      (ArgMaximum BlasGen.iamax)
      (ArgMaximum LapackComplex.imax1)
      (ArgMaximum LapackComplex.imax1)


uncheck :: Array sh a -> Array (ShapePriv.Unchecked sh) a
uncheck = Array.mapShape ShapePriv.Unchecked

recheck :: Array (ShapePriv.Unchecked sh) a -> Array sh a
recheck = Array.mapShape ShapePriv.deconsUnchecked