{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.Matrix.Hermitian.Basic (
   Hermitian,
   HermitianP,
   Transposition(..),
   diagonal,
   takeDiagonal,

   sumRank1,
   sumRank2,
   ) where

import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Scalar as Scalar
import Numeric.LAPACK.Matrix.Hermitian.Private (Diagonal(..), TakeDiagonal(..))
import Numeric.LAPACK.Matrix.Symmetric.Unified (complement)
import Numeric.LAPACK.Matrix.Mosaic.Private
         (forPointers, diagonalPointerPairs,
          rowMajorPointers, columnMajorPointers,
          withPacking, noLabel, applyFuncPair, triArg)
import Numeric.LAPACK.Matrix.Layout.Private
         (Order(RowMajor,ColumnMajor), uploFromOrder)
import Numeric.BLAS.Matrix.Modifier
         (Transposition(NonTransposed, Transposed),
          Conjugation(Conjugated), conjugatedOnRowMajor)
import Numeric.LAPACK.Vector (Vector)
import Numeric.LAPACK.Scalar (RealOf, zero)
import Numeric.LAPACK.Private (fill, realPtr, condConjugate)

import qualified Numeric.BLAS.FFI.Generic as BlasGen
import qualified Numeric.BLAS.FFI.Complex as BlasComplex
import qualified Numeric.BLAS.FFI.Real as BlasReal
import qualified Numeric.Netlib.Utility as Call
import qualified Numeric.Netlib.Class as Class

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))

import Foreign.C.Types (CInt, CChar)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable, poke, peek)

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

import Data.Foldable (forM_)


type Hermitian sh = Array (Layout.Hermitian sh)
type HermitianP pack sh = Array (Layout.HermitianP pack sh)


diagonal ::
   (Shape.C sh, Class.Floating a) =>
   Order -> Vector sh (RealOf a) -> Hermitian sh a
diagonal :: forall sh a.
(C sh, Floating a) =>
Order -> Vector sh (RealOf a) -> Hermitian sh a
diagonal Order
order =
   Diagonal
  (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
-> Array sh (RealOf a)
-> Array (Mosaic Packed ConjugateMirror Upper sh) a
forall (f :: * -> *) (g :: * -> *) a.
Diagonal f g a -> g (RealOf a) -> f a
runDiagonal (Diagonal
   (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
 -> Array sh (RealOf a)
 -> Array (Mosaic Packed ConjugateMirror Upper sh) a)
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
-> Array sh (RealOf a)
-> Array (Mosaic Packed ConjugateMirror Upper sh) a
forall a b. (a -> b) -> a -> b
$
   Diagonal
  (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Float
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Double
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Float)
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Double)
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
forall (f :: * -> *).
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((Array sh (RealOf Float)
 -> Array (Mosaic Packed ConjugateMirror Upper sh) Float)
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Float
forall (f :: * -> *) (g :: * -> *) a.
(g (RealOf a) -> f a) -> Diagonal f g a
Diagonal ((Array sh (RealOf Float)
  -> Array (Mosaic Packed ConjugateMirror Upper sh) Float)
 -> Diagonal
      (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Float)
-> (Array sh (RealOf Float)
    -> Array (Mosaic Packed ConjugateMirror Upper sh) Float)
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Float
forall a b. (a -> b) -> a -> b
$ Order
-> Vector sh Float
-> Array (Mosaic Packed ConjugateMirror Upper sh) Float
forall sh a ar.
(C sh, Floating a, RealOf a ~ ar, Storable ar) =>
Order -> Vector sh ar -> Hermitian sh a
diagonalAux Order
order) ((Array sh (RealOf Double)
 -> Array (Mosaic Packed ConjugateMirror Upper sh) Double)
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Double
forall (f :: * -> *) (g :: * -> *) a.
(g (RealOf a) -> f a) -> Diagonal f g a
Diagonal ((Array sh (RealOf Double)
  -> Array (Mosaic Packed ConjugateMirror Upper sh) Double)
 -> Diagonal
      (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Double)
-> (Array sh (RealOf Double)
    -> Array (Mosaic Packed ConjugateMirror Upper sh) Double)
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Double
forall a b. (a -> b) -> a -> b
$ Order
-> Vector sh Double
-> Array (Mosaic Packed ConjugateMirror Upper sh) Double
forall sh a ar.
(C sh, Floating a, RealOf a ~ ar, Storable ar) =>
Order -> Vector sh ar -> Hermitian sh a
diagonalAux Order
order)
      ((Array sh (RealOf (Complex Float))
 -> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Float))
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Float)
forall (f :: * -> *) (g :: * -> *) a.
(g (RealOf a) -> f a) -> Diagonal f g a
Diagonal ((Array sh (RealOf (Complex Float))
  -> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Float))
 -> Diagonal
      (Array (Mosaic Packed ConjugateMirror Upper sh))
      (Array sh)
      (Complex Float))
-> (Array sh (RealOf (Complex Float))
    -> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Float))
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Float)
forall a b. (a -> b) -> a -> b
$ Order
-> Vector sh Float
-> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Float)
forall sh a ar.
(C sh, Floating a, RealOf a ~ ar, Storable ar) =>
Order -> Vector sh ar -> Hermitian sh a
diagonalAux Order
order) ((Array sh (RealOf (Complex Double))
 -> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Double))
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Double)
forall (f :: * -> *) (g :: * -> *) a.
(g (RealOf a) -> f a) -> Diagonal f g a
Diagonal ((Array sh (RealOf (Complex Double))
  -> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Double))
 -> Diagonal
      (Array (Mosaic Packed ConjugateMirror Upper sh))
      (Array sh)
      (Complex Double))
-> (Array sh (RealOf (Complex Double))
    -> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Double))
-> Diagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Double)
forall a b. (a -> b) -> a -> b
$ Order
-> Vector sh Double
-> Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Double)
forall sh a ar.
(C sh, Floating a, RealOf a ~ ar, Storable ar) =>
Order -> Vector sh ar -> Hermitian sh a
diagonalAux Order
order)

diagonalAux ::
   (Shape.C sh, Class.Floating a, RealOf a ~ ar, Storable ar) =>
   Order -> Vector sh ar -> Hermitian sh a
diagonalAux :: forall sh a ar.
(C sh, Floating a, RealOf a ~ ar, Storable ar) =>
Order -> Vector sh ar -> Hermitian sh a
diagonalAux Order
order (Array sh
sh ForeignPtr ar
x) =
   Hermitian sh -> (Int -> Ptr a -> IO ()) -> Array (Hermitian sh) a
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize (Order -> sh -> Hermitian sh
forall size. Order -> size -> Hermitian size
Layout.hermitian Order
order sh
sh) ((Int -> Ptr a -> IO ()) -> Array (Hermitian sh) a)
-> (Int -> Ptr a -> IO ()) -> Array (Hermitian sh) a
forall a b. (a -> b) -> a -> b
$
      \Int
triSize Ptr a
aPtr -> do
   a -> Int -> Ptr a -> IO ()
forall a. Floating a => a -> Int -> Ptr a -> IO ()
fill a
forall a. Floating a => a
zero Int
triSize Ptr a
aPtr
   ForeignPtr ar -> (Ptr ar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ar
x ((Ptr ar -> IO ()) -> IO ()) -> (Ptr ar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ar
xPtr ->
      [(Ptr ar, Ptr a)] -> ((Ptr ar, Ptr a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Order -> Int -> Ptr ar -> Ptr a -> [(Ptr ar, Ptr a)]
forall a b.
(Storable a, Storable b) =>
Order -> Int -> Ptr a -> Ptr b -> [(Ptr a, Ptr b)]
diagonalPointerPairs Order
order (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh) Ptr ar
xPtr Ptr a
aPtr) (((Ptr ar, Ptr a) -> IO ()) -> IO ())
-> ((Ptr ar, Ptr a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
         \(Ptr ar
srcPtr,Ptr a
dstPtr) -> Ptr ar -> ar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a -> Ptr (RealOf a)
forall a. Ptr a -> Ptr (RealOf a)
realPtr Ptr a
dstPtr) (ar -> IO ()) -> IO ar -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ar -> IO ar
forall a. Storable a => Ptr a -> IO a
peek Ptr ar
srcPtr


takeDiagonal ::
   (Shape.C sh, Class.Floating a) =>
   Hermitian sh a -> Vector sh (RealOf a)
takeDiagonal :: forall sh a.
(C sh, Floating a) =>
Hermitian sh a -> Vector sh (RealOf a)
takeDiagonal =
   TakeDiagonal
  (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
-> Array (Mosaic Packed ConjugateMirror Upper sh) a
-> Array sh (RealOf a)
forall (f :: * -> *) (g :: * -> *) a.
TakeDiagonal f g a -> f a -> g (RealOf a)
runTakeDiagonal (TakeDiagonal
   (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
 -> Array (Mosaic Packed ConjugateMirror Upper sh) a
 -> Array sh (RealOf a))
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
-> Array (Mosaic Packed ConjugateMirror Upper sh) a
-> Array sh (RealOf a)
forall a b. (a -> b) -> a -> b
$
   TakeDiagonal
  (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Float
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Double
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Float)
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Double)
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
forall (f :: * -> *).
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((Array (Mosaic Packed ConjugateMirror Upper sh) Float
 -> Array sh (RealOf Float))
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Float
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal Array (Mosaic Packed ConjugateMirror Upper sh) Float
-> Vector sh Float
Array (Mosaic Packed ConjugateMirror Upper sh) Float
-> Array sh (RealOf Float)
forall sh a ar.
(C sh, Storable a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
takeDiagonalAux) ((Array (Mosaic Packed ConjugateMirror Upper sh) Double
 -> Array sh (RealOf Double))
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh)) (Array sh) Double
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal Array (Mosaic Packed ConjugateMirror Upper sh) Double
-> Vector sh Double
Array (Mosaic Packed ConjugateMirror Upper sh) Double
-> Array sh (RealOf Double)
forall sh a ar.
(C sh, Storable a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
takeDiagonalAux)
      ((Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Float)
 -> Array sh (RealOf (Complex Float)))
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Float)
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Float)
-> Vector sh Float
Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Float)
-> Array sh (RealOf (Complex Float))
forall sh a ar.
(C sh, Storable a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
takeDiagonalAux) ((Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Double)
 -> Array sh (RealOf (Complex Double)))
-> TakeDiagonal
     (Array (Mosaic Packed ConjugateMirror Upper sh))
     (Array sh)
     (Complex Double)
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Double)
-> Vector sh Double
Array (Mosaic Packed ConjugateMirror Upper sh) (Complex Double)
-> Array sh (RealOf (Complex Double))
forall sh a ar.
(C sh, Storable a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
takeDiagonalAux)

takeDiagonalAux ::
   (Shape.C sh, Storable a, RealOf a ~ ar, Storable ar) =>
   Hermitian sh a -> Vector sh ar
takeDiagonalAux :: forall sh a ar.
(C sh, Storable a, RealOf a ~ ar, Storable ar) =>
Hermitian sh a -> Vector sh ar
takeDiagonalAux (Array (Layout.Mosaic PackingSingleton Packed
_pack MirrorSingleton ConjugateMirror
_mirror UpLoSingleton Upper
_upper Order
order sh
sh) ForeignPtr a
a) =
   sh -> (Int -> Ptr ar -> IO ()) -> Array sh ar
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize sh
sh ((Int -> Ptr ar -> IO ()) -> Array sh ar)
-> (Int -> Ptr ar -> IO ()) -> Array sh ar
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr ar
xPtr ->
   ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
aPtr ->
      [(Ptr ar, Ptr a)] -> ((Ptr ar, Ptr a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Order -> Int -> Ptr ar -> Ptr a -> [(Ptr ar, Ptr a)]
forall a b.
(Storable a, Storable b) =>
Order -> Int -> Ptr a -> Ptr b -> [(Ptr a, Ptr b)]
diagonalPointerPairs Order
order Int
n Ptr ar
xPtr Ptr a
aPtr) (((Ptr ar, Ptr a) -> IO ()) -> IO ())
-> ((Ptr ar, Ptr a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
         \(Ptr ar
dstPtr,Ptr a
srcPtr) -> Ptr ar -> ar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr ar
dstPtr (ar -> IO ()) -> IO ar -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ar -> IO ar
forall a. Storable a => Ptr a -> IO a
peek (Ptr a -> Ptr (RealOf a)
forall a. Ptr a -> Ptr (RealOf a)
realPtr Ptr a
srcPtr)


withConjBuffer ::
   (Shape.C sh, Class.Floating a) =>
   Layout.PackingSingleton pack -> Order -> sh -> Int -> Ptr a ->
   (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ()) -> ContT r IO ()
withConjBuffer :: forall sh a pack r.
(C sh, Floating a) =>
PackingSingleton pack
-> Order
-> sh
-> Int
-> Ptr a
-> (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT r IO ()
withConjBuffer PackingSingleton pack
pack Order
order sh
sh Int
triSize Ptr a
aPtr Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ()
act = do
   Ptr CChar
uploPtr <- Char -> FortranIO r (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO r (Ptr CChar))
-> Char -> FortranIO r (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
order
   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
   Ptr CInt
nPtr <- Int -> FortranIO r (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr CInt
incxPtr <- Int -> FortranIO r (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
   Ptr CInt
sizePtr <- Int -> FortranIO r (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
triSize
   IO () -> ContT r IO ()
forall a. IO a -> ContT r IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ()) -> IO () -> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ do
      a -> Int -> Ptr a -> IO ()
forall a. Floating a => a -> Int -> Ptr a -> IO ()
fill a
forall a. Floating a => a
zero Int
triSize Ptr a
aPtr
      Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ()
act Ptr CChar
uploPtr Int
n Ptr CInt
nPtr Ptr CInt
incxPtr
      Conjugation -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
condConjugate (Order -> Conjugation
conjugatedOnRowMajor Order
order) Ptr CInt
sizePtr Ptr a
aPtr Ptr CInt
incxPtr
      PackingSingleton pack
-> Conjugation -> Order -> Int -> Ptr a -> IO ()
forall a pack.
Floating a =>
PackingSingleton pack
-> Conjugation -> Order -> Int -> Ptr a -> IO ()
complement PackingSingleton pack
pack Conjugation
Conjugated Order
order Int
n Ptr a
aPtr


{-
Not easy to generalize to Symmetric
because LapackComplex.spr and LapackComplex.syr
expect complex parameter 'alpha'.
-}
sumRank1 ::
   (Layout.Packing pack, Shape.C sh, Eq sh, Class.Floating a) =>
   Order -> sh -> [(RealOf a, Vector sh a)] -> HermitianP pack sh a
sumRank1 :: forall pack sh a.
(Packing pack, C sh, Eq sh, Floating a) =>
Order -> sh -> [(RealOf a, Vector sh a)] -> HermitianP pack sh a
sumRank1 =
   SumRank1 pack sh a
-> Order
-> sh
-> [(RealOf a, Array sh a)]
-> Array (Mosaic pack ConjugateMirror Upper sh) a
forall pack sh a.
SumRank1 pack sh a -> SumRank1_ pack sh (RealOf a) a
getSumRank1 (SumRank1 pack sh a
 -> Order
 -> sh
 -> [(RealOf a, Array sh a)]
 -> Array (Mosaic pack ConjugateMirror Upper sh) a)
-> SumRank1 pack sh a
-> Order
-> sh
-> [(RealOf a, Array sh a)]
-> Array (Mosaic pack ConjugateMirror Upper sh) a
forall a b. (a -> b) -> a -> b
$
   SumRank1 pack sh Float
-> SumRank1 pack sh Double
-> SumRank1 pack sh (Complex Float)
-> SumRank1 pack sh (Complex Double)
-> SumRank1 pack sh a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
forall (f :: * -> *).
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      (SumRank1_ pack sh (RealOf Float) Float -> SumRank1 pack sh Float
forall pack sh a.
SumRank1_ pack sh (RealOf a) a -> SumRank1 pack sh a
SumRank1 SumRank1_ pack sh Float Float
SumRank1_ pack sh (RealOf Float) Float
forall pack sh a ar.
(Packing pack, C sh, Eq sh, Floating a, RealOf a ~ ar,
 Storable ar) =>
SumRank1_ pack sh ar a
sumRank1Aux) (SumRank1_ pack sh (RealOf Double) Double -> SumRank1 pack sh Double
forall pack sh a.
SumRank1_ pack sh (RealOf a) a -> SumRank1 pack sh a
SumRank1 SumRank1_ pack sh Double Double
SumRank1_ pack sh (RealOf Double) Double
forall pack sh a ar.
(Packing pack, C sh, Eq sh, Floating a, RealOf a ~ ar,
 Storable ar) =>
SumRank1_ pack sh ar a
sumRank1Aux)
      (SumRank1_ pack sh (RealOf (Complex Float)) (Complex Float)
-> SumRank1 pack sh (Complex Float)
forall pack sh a.
SumRank1_ pack sh (RealOf a) a -> SumRank1 pack sh a
SumRank1 SumRank1_ pack sh Float (Complex Float)
SumRank1_ pack sh (RealOf (Complex Float)) (Complex Float)
forall pack sh a ar.
(Packing pack, C sh, Eq sh, Floating a, RealOf a ~ ar,
 Storable ar) =>
SumRank1_ pack sh ar a
sumRank1Aux) (SumRank1_ pack sh (RealOf (Complex Double)) (Complex Double)
-> SumRank1 pack sh (Complex Double)
forall pack sh a.
SumRank1_ pack sh (RealOf a) a -> SumRank1 pack sh a
SumRank1 SumRank1_ pack sh Double (Complex Double)
SumRank1_ pack sh (RealOf (Complex Double)) (Complex Double)
forall pack sh a ar.
(Packing pack, C sh, Eq sh, Floating a, RealOf a ~ ar,
 Storable ar) =>
SumRank1_ pack sh ar a
sumRank1Aux)

type SumRank1_ pack sh ar a =
      Order -> sh -> [(ar, Vector sh a)] -> HermitianP pack sh a

newtype SumRank1 pack sh a =
      SumRank1 {forall pack sh a.
SumRank1 pack sh a -> SumRank1_ pack sh (RealOf a) a
getSumRank1 :: SumRank1_ pack sh (RealOf a) a}

sumRank1Aux ::
   (Layout.Packing pack, Shape.C sh, Eq sh,
    Class.Floating a, RealOf a ~ ar, Storable ar) =>
   SumRank1_ pack sh ar a
sumRank1Aux :: forall pack sh a ar.
(Packing pack, C sh, Eq sh, Floating a, RealOf a ~ ar,
 Storable ar) =>
SumRank1_ pack sh ar a
sumRank1Aux Order
order sh
sh [(ar, Vector sh a)]
xs =
   let pack :: PackingSingleton pack
pack = PackingSingleton pack
forall pack. Packing pack => PackingSingleton pack
Layout.autoPacking
   in HermitianP pack sh
-> (Int -> Ptr a -> IO ()) -> Array (HermitianP pack sh) a
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize (PackingSingleton pack -> Order -> sh -> HermitianP pack sh
forall pack size.
PackingSingleton pack -> Order -> size -> HermitianP pack size
Layout.hermitianP PackingSingleton pack
pack Order
order sh
sh) ((Int -> Ptr a -> IO ()) -> Array (HermitianP pack sh) a)
-> (Int -> Ptr a -> IO ()) -> Array (HermitianP pack sh) a
forall a b. (a -> b) -> a -> b
$
      \Int
triSize Ptr a
aPtr ->
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr ar
alphaPtr <- FortranIO () (Ptr ar)
forall a r. Storable a => FortranIO r (Ptr a)
Call.alloca
      PackingSingleton pack
-> Order
-> sh
-> Int
-> Ptr a
-> (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT () IO ()
forall sh a pack r.
(C sh, Floating a) =>
PackingSingleton pack
-> Order
-> sh
-> Int
-> Ptr a
-> (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT r IO ()
withConjBuffer PackingSingleton pack
pack Order
order sh
sh Int
triSize Ptr a
aPtr ((Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
 -> ContT () IO ())
-> (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
uploPtr Int
n Ptr CInt
nPtr Ptr CInt
incxPtr -> do
         [(ar, Vector sh a)] -> ((ar, Vector sh a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ar, Vector sh a)]
xs (((ar, Vector sh a) -> IO ()) -> IO ())
-> ((ar, Vector sh a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ar
alpha, Array sh
shX ForeignPtr a
x) ->
            ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr -> do
               String -> Bool -> IO ()
Call.assert
                  String
"Hermitian.sumRank1: non-matching vector size" (sh
shsh -> sh -> Bool
forall a. Eq a => a -> a -> Bool
==sh
shX)
               Ptr ar -> ar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr ar
alphaPtr ar
alpha
               ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PackingSingleton pack
-> Labelled2 () () (IO ()) (IO ()) -> ContT () IO ()
forall pack r.
PackingSingleton pack
-> Labelled2 r () (IO ()) (IO ()) -> ContT r IO ()
withPacking PackingSingleton pack
pack (Labelled2 () () (IO ()) (IO ()) -> ContT () IO ())
-> Labelled2 () () (IO ()) (IO ()) -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
                  case Ptr a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor Ptr a
aPtr of
                     ComplexSingleton a
Scalar.Real ->
                        Labelled
  (FuncCont
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr a
      -> Ptr CInt
      -> TriArg a
      -> Labelled2 () () (IO ()) (IO ())))
  ()
  (FuncPacked
     (Ptr CChar
      -> Ptr CInt
      -> Ptr ar
      -> Ptr a
      -> Ptr CInt
      -> TriArg a
      -> Labelled2 () () (IO ()) (IO ())))
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (FuncUnpacked
        (Ptr CChar
         -> Ptr CInt
         -> Ptr ar
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
-> Ptr CChar
-> Ptr CInt
-> Ptr ar
-> Ptr a
-> Ptr CInt
-> TriArg a
-> Labelled2 () () (IO ()) (IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair
                           ((Ptr CChar
 -> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> IO ())
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (Ptr CChar
      -> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> IO ())
forall a r. a -> Labelled r () a
noLabel Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> IO ()
BlasReal.spr) ((Ptr CChar
 -> Ptr CInt
 -> Ptr a
 -> Ptr a
 -> Ptr CInt
 -> Ptr a
 -> Ptr CInt
 -> IO ())
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> IO ())
forall a r. a -> Labelled r () a
noLabel Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
BlasReal.syr)
                           Ptr CChar
uploPtr Ptr CInt
nPtr Ptr ar
alphaPtr Ptr a
xPtr Ptr CInt
incxPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
aPtr Int
n)
                     ComplexSingleton a
Scalar.Complex ->
                        Labelled
  (FuncCont
     (Ptr CChar
      -> Ptr CInt
      -> Ptr ar
      -> Ptr (Complex ar)
      -> Ptr CInt
      -> TriArg (Complex ar)
      -> Labelled2 () () (IO ()) (IO ())))
  ()
  (FuncPacked
     (Ptr CChar
      -> Ptr CInt
      -> Ptr ar
      -> Ptr a
      -> Ptr CInt
      -> TriArg a
      -> Labelled2 () () (IO ()) (IO ())))
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr ar
         -> Ptr (Complex ar)
         -> Ptr CInt
         -> TriArg (Complex ar)
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (FuncUnpacked
        (Ptr CChar
         -> Ptr CInt
         -> Ptr ar
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
-> Ptr CChar
-> Ptr CInt
-> Ptr ar
-> Ptr a
-> Ptr CInt
-> TriArg a
-> Labelled2 () () (IO ()) (IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair
                           ((Ptr CChar
 -> Ptr CInt
 -> Ptr ar
 -> Ptr (Complex ar)
 -> Ptr CInt
 -> Ptr (Complex ar)
 -> IO ())
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr ar
         -> Ptr (Complex ar)
         -> Ptr CInt
         -> TriArg (Complex ar)
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (Ptr CChar
      -> Ptr CInt
      -> Ptr ar
      -> Ptr (Complex ar)
      -> Ptr CInt
      -> Ptr (Complex ar)
      -> IO ())
forall a r. a -> Labelled r () a
noLabel Ptr CChar
-> Ptr CInt
-> Ptr ar
-> Ptr (Complex ar)
-> Ptr CInt
-> Ptr (Complex ar)
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> IO ()
BlasComplex.hpr) ((Ptr CChar
 -> Ptr CInt
 -> Ptr ar
 -> Ptr (Complex ar)
 -> Ptr CInt
 -> Ptr (Complex ar)
 -> Ptr CInt
 -> IO ())
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr ar
         -> Ptr (Complex ar)
         -> Ptr CInt
         -> TriArg (Complex ar)
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (Ptr CChar
      -> Ptr CInt
      -> Ptr ar
      -> Ptr (Complex ar)
      -> Ptr CInt
      -> Ptr (Complex ar)
      -> Ptr CInt
      -> IO ())
forall a r. a -> Labelled r () a
noLabel Ptr CChar
-> Ptr CInt
-> Ptr ar
-> Ptr (Complex ar)
-> Ptr CInt
-> Ptr (Complex ar)
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
BlasComplex.her)
                           Ptr CChar
uploPtr Ptr CInt
nPtr Ptr ar
alphaPtr Ptr a
xPtr Ptr CInt
incxPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
aPtr Int
n)


{-
Not easy to generalize to Symmetric
because there are no Complex.spr2 and Complex.syr2.
However, there is BlasComplex.syr2k.
-}
sumRank2 ::
   (Layout.Packing pack, Shape.C sh, Eq sh, Class.Floating a) =>
   Order -> sh -> [(a, (Vector sh a, Vector sh a))] -> HermitianP pack sh a
sumRank2 :: forall pack sh a.
(Packing pack, C sh, Eq sh, Floating a) =>
Order
-> sh -> [(a, (Vector sh a, Vector sh a))] -> HermitianP pack sh a
sumRank2 Order
order sh
sh [(a, (Vector sh a, Vector sh a))]
xys =
   let pack :: PackingSingleton pack
pack = PackingSingleton pack
forall pack. Packing pack => PackingSingleton pack
Layout.autoPacking
   in HermitianP pack sh
-> (Int -> Ptr a -> IO ()) -> Array (HermitianP pack sh) a
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize (PackingSingleton pack -> Order -> sh -> HermitianP pack sh
forall pack size.
PackingSingleton pack -> Order -> size -> HermitianP pack size
Layout.hermitianP PackingSingleton pack
pack Order
order sh
sh) ((Int -> Ptr a -> IO ()) -> Array (HermitianP pack sh) a)
-> (Int -> Ptr a -> IO ()) -> Array (HermitianP pack sh) a
forall a b. (a -> b) -> a -> b
$
      \Int
triSize Ptr a
aPtr ->
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr a
alphaPtr <- FortranIO () (Ptr a)
forall a r. Storable a => FortranIO r (Ptr a)
Call.alloca
      PackingSingleton pack
-> Order
-> sh
-> Int
-> Ptr a
-> (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT () IO ()
forall sh a pack r.
(C sh, Floating a) =>
PackingSingleton pack
-> Order
-> sh
-> Int
-> Ptr a
-> (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT r IO ()
withConjBuffer PackingSingleton pack
pack Order
order sh
sh Int
triSize Ptr a
aPtr ((Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
 -> ContT () IO ())
-> (Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
uploPtr Int
n Ptr CInt
nPtr Ptr CInt
incPtr -> do
         [(a, (Vector sh a, Vector sh a))]
-> ((a, (Vector sh a, Vector sh a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(a, (Vector sh a, Vector sh a))]
xys (((a, (Vector sh a, Vector sh a)) -> IO ()) -> IO ())
-> ((a, (Vector sh a, Vector sh a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(a
alpha, (Array sh
shX ForeignPtr a
x, Array sh
shY ForeignPtr a
y)) ->
            ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr ->
            ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
y ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
yPtr -> do
               String -> Bool -> IO ()
Call.assert
                  String
"Hermitian.sumRank2: non-matching x vector size" (sh
shsh -> sh -> Bool
forall a. Eq a => a -> a -> Bool
==sh
shX)
               String -> Bool -> IO ()
Call.assert
                  String
"Hermitian.sumRank2: non-matching y vector size" (sh
shsh -> sh -> Bool
forall a. Eq a => a -> a -> Bool
==sh
shY)
               Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
alphaPtr a
alpha
               ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PackingSingleton pack
-> Labelled2 () () (IO ()) (IO ()) -> ContT () IO ()
forall pack r.
PackingSingleton pack
-> Labelled2 r () (IO ()) (IO ()) -> ContT r IO ()
withPacking PackingSingleton pack
pack (Labelled2 () () (IO ()) (IO ()) -> ContT () IO ())
-> Labelled2 () () (IO ()) (IO ()) -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
                  Labelled
  (FuncCont
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> TriArg a
      -> Labelled2 () () (IO ()) (IO ())))
  ()
  (FuncPacked
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> TriArg a
      -> Labelled2 () () (IO ()) (IO ())))
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (FuncUnpacked
        (Ptr CChar
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
-> Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> TriArg a
-> Labelled2 () () (IO ()) (IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair ((Ptr CChar
 -> Ptr CInt
 -> Ptr a
 -> Ptr a
 -> Ptr CInt
 -> Ptr a
 -> Ptr CInt
 -> Ptr a
 -> IO ())
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> IO ())
forall a r. a -> Labelled r () a
noLabel Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> IO ()
BlasGen.hpr2) ((Ptr CChar
 -> Ptr CInt
 -> Ptr a
 -> Ptr a
 -> Ptr CInt
 -> Ptr a
 -> Ptr CInt
 -> Ptr a
 -> Ptr CInt
 -> IO ())
-> Labelled
     (FuncCont
        (Ptr CChar
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> Ptr a
         -> Ptr CInt
         -> TriArg a
         -> Labelled2 () () (IO ()) (IO ())))
     ()
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> IO ())
forall a r. a -> Labelled r () a
noLabel Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
BlasGen.her2)
                     Ptr CChar
uploPtr Ptr CInt
nPtr
                     Ptr a
alphaPtr Ptr a
xPtr Ptr CInt
incPtr Ptr a
yPtr Ptr CInt
incPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
aPtr Int
n)


_pack :: Class.Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
_pack :: forall a. Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
_pack Order
order Int
n Ptr a
fullPtr Ptr a
packedPtr =
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr CInt
incxPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
      IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
         case Order
order of
            Order
ColumnMajor ->
               [(Int, ((Ptr a, Ptr a), Ptr a))]
-> (Ptr CInt -> ((Ptr a, Ptr a), Ptr a) -> IO ()) -> IO ()
forall a. [(Int, a)] -> (Ptr CInt -> a -> IO ()) -> IO ()
forPointers (Int -> Ptr a -> Ptr a -> [(Int, ((Ptr a, Ptr a), Ptr a))]
forall a.
Storable a =>
Int -> Ptr a -> Ptr a -> [(Int, ((Ptr a, Ptr a), Ptr a))]
columnMajorPointers Int
n Ptr a
fullPtr Ptr a
packedPtr) ((Ptr CInt -> ((Ptr a, Ptr a), Ptr a) -> IO ()) -> IO ())
-> (Ptr CInt -> ((Ptr a, Ptr a), Ptr a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                  \Ptr CInt
nPtr ((Ptr a
_,Ptr a
srcPtr),Ptr a
dstPtr) ->
                     Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
BlasGen.copy Ptr CInt
nPtr Ptr a
srcPtr Ptr CInt
incxPtr Ptr a
dstPtr Ptr CInt
incxPtr
            Order
RowMajor ->
               [(Int, (Ptr a, Ptr a))]
-> (Ptr CInt -> (Ptr a, Ptr a) -> IO ()) -> IO ()
forall a. [(Int, a)] -> (Ptr CInt -> a -> IO ()) -> IO ()
forPointers (Int -> Ptr a -> Ptr a -> [(Int, (Ptr a, Ptr a))]
forall a.
Storable a =>
Int -> Ptr a -> Ptr a -> [(Int, (Ptr a, Ptr a))]
rowMajorPointers Int
n Ptr a
fullPtr Ptr a
packedPtr) ((Ptr CInt -> (Ptr a, Ptr a) -> IO ()) -> IO ())
-> (Ptr CInt -> (Ptr a, Ptr a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                  \Ptr CInt
nPtr (Ptr a
srcPtr,Ptr a
dstPtr) ->
                     Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
BlasGen.copy Ptr CInt
nPtr Ptr a
srcPtr Ptr CInt
incxPtr Ptr a
dstPtr Ptr CInt
incxPtr