{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.Matrix.Symmetric.Unified where

import qualified Numeric.LAPACK.Matrix.Mosaic.Unpacked as Unpacked
import qualified Numeric.LAPACK.Matrix.Mosaic.Packed as Packed
import qualified Numeric.LAPACK.Matrix.Mosaic.Generic as Mosaic
import qualified Numeric.LAPACK.Matrix.Mosaic.Private as MosaicPriv
import qualified Numeric.LAPACK.Matrix.Basic as Basic
import qualified Numeric.LAPACK.Matrix.Private as Matrix
import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Matrix.Shape.Omni as Omni
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import qualified Numeric.LAPACK.Vector as Vector
import qualified Numeric.LAPACK.Scalar as Scalar
import Numeric.LAPACK.Matrix.Mosaic.Private
         (Mosaic, recheck, copyTriangleToTemp, forPointers,
          diagonalPointers, columnMajorPointers, rowMajorPointers,
          withPacking, withPackingLinear, runPacking,
          noLabel, label, applyFuncPair, triArg,
          Labelled(Labelled))
import Numeric.LAPACK.Matrix.Layout.Private
         (Order(RowMajor,ColumnMajor), uploFromOrder, uploOrder)
import Numeric.LAPACK.Matrix.Modifier
         (Conjugation(NonConjugated, Conjugated), conjugatedOnRowMajor,
          Transposition(NonTransposed, Transposed), transposeOrder)
import Numeric.LAPACK.Matrix.Private (Full, General, Square)
import Numeric.LAPACK.Linear.Private (solver, withDeterminantInfo, diagonalMsg)
import Numeric.LAPACK.Vector (Vector)
import Numeric.LAPACK.Scalar (RealOf, zero, one)
import Numeric.LAPACK.Shape.Private (Unchecked(Unchecked))
import Numeric.LAPACK.Private
         (fill, copyBlock, copyToTemp,
          condConjugate, copyCondConjugate, condConjugateToTemp,
          withAutoWorkspace, pointerSeq)

import qualified Numeric.LAPACK.FFI.Complex as LapackComplex
import qualified Numeric.LAPACK.FFI.Generic as LapackGen
import qualified Numeric.BLAS.FFI.Complex as BlasComplex
import qualified Numeric.BLAS.FFI.Real as BlasReal
import qualified Numeric.BLAS.FFI.Generic as BlasGen
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.Marshal.Array (advancePtr)
import Foreign.C.Types (CInt, CChar)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable, peek)

import qualified System.IO.Lazy as LazyIO
import System.IO.Unsafe (unsafePerformIO)

import Control.Monad.Trans.Cont (ContT(ContT), evalContT)
import Control.Monad.IO.Class (liftIO)
import Control.Applicative ((<$>))



data MirrorSingleton mirror where
   SimpleMirror :: MirrorSingleton Layout.SimpleMirror
   ConjugateMirror :: MirrorSingleton Layout.ConjugateMirror

deriving instance Eq (MirrorSingleton mirror)
deriving instance Show (MirrorSingleton mirror)

class (Layout.Mirror mirror) => Mirror mirror where
   autoMirror :: MirrorSingleton mirror
instance Mirror Layout.SimpleMirror where autoMirror :: MirrorSingleton SimpleMirror
autoMirror = MirrorSingleton SimpleMirror
SimpleMirror
instance Mirror Layout.ConjugateMirror where autoMirror :: MirrorSingleton ConjugateMirror
autoMirror = MirrorSingleton ConjugateMirror
ConjugateMirror

narrowMirror :: (Mirror mirror) => f mirror -> MirrorSingleton mirror
narrowMirror :: f mirror -> MirrorSingleton mirror
narrowMirror f mirror
_ = MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
autoMirror

conjugationFromMirror :: (Mirror mirror) => f mirror -> Conjugation
conjugationFromMirror :: f mirror -> Conjugation
conjugationFromMirror f mirror
mirror =
   case f mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror f mirror
mirror of
      MirrorSingleton mirror
SimpleMirror -> Conjugation
NonConjugated
      MirrorSingleton mirror
ConjugateMirror -> Conjugation
Conjugated



{- |
> let b = takeHalf a
> ==>
> isTriangular b && a == addTransposed b
-}
takeHalf ::
   (Shape.C sh, Class.Floating a) =>
   Unpacked.Mosaic mirror Shape.Upper sh a ->
   Unpacked.Triangular Shape.Upper sh a
takeHalf :: Mosaic mirror Upper sh a -> Triangular Upper sh a
takeHalf (Array Mosaic Unpacked mirror Upper sh
shape ForeignPtr a
a) =
   Mosaic Unpacked NoMirror Upper sh
-> (Int -> Ptr a -> IO ()) -> Triangular Upper sh a
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize
         Mosaic Unpacked mirror Upper sh
shape{mosaicMirror :: MirrorSingleton NoMirror
Layout.mosaicMirror = MirrorSingleton NoMirror
Layout.NoMirror} ((Int -> Ptr a -> IO ()) -> Triangular Upper sh a)
-> (Int -> Ptr a -> IO ()) -> Triangular Upper sh a
forall a b. (a -> b) -> a -> b
$
      \Int
size Ptr a
bPtr -> 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
   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size (sh -> Int) -> sh -> Int
forall a b. (a -> b) -> a -> b
$ Mosaic Unpacked mirror Upper sh -> sh
forall pack mirror uplo size. Mosaic pack mirror uplo size -> size
Layout.mosaicSize Mosaic Unpacked mirror Upper sh
shape
   Ptr a
aPtr <- ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr a
alphaPtr <- a -> ContT () IO (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
0.5
   Ptr CInt
incxPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
   IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ do
      Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock Int
size Ptr a
aPtr Ptr a
bPtr
      Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> IO ()
BlasGen.scal Ptr CInt
nPtr Ptr a
alphaPtr Ptr a
bPtr Ptr CInt
incxPtr


toSquare ::
   (Mirror mirror, Shape.C sh, Class.Floating a) =>
   Packed.Mosaic mirror Shape.Upper sh a -> Square sh a
toSquare :: Mosaic mirror Upper sh a -> Square sh a
toSquare (Array (Layout.Mosaic PackingSingleton Packed
_pack MirrorSingleton mirror
mirror UpLoSingleton Upper
_uplo Order
order sh
sh) ForeignPtr a
a) =
   Square sh -> (Ptr a -> IO ()) -> Square sh a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (Order -> sh -> Square sh
forall sh. Order -> sh -> Square sh
Layout.square Order
order sh
sh) ((Ptr a -> IO ()) -> Square sh a)
-> (Ptr a -> IO ()) -> Square sh a
forall a b. (a -> b) -> a -> b
$ \Ptr a
bPtr ->
   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 -> 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

   let conj :: Conjugation
conj = MirrorSingleton mirror -> Conjugation
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> Conjugation
conjugationFromMirror MirrorSingleton mirror
mirror
   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
   Ptr CInt
incxPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
   Ptr CInt
incyPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   IO () -> ContT () IO ()
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
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
bPtr Ptr a
aPtr) ((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
dstPtr,Ptr a
srcPtr) -> do
            Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
copyCondConjugate Conjugation
conj Ptr CInt
nPtr Ptr a
srcPtr Ptr CInt
incxPtr Ptr a
dstPtr Ptr CInt
incyPtr
            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
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
bPtr Ptr a
aPtr) ((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
dstRowPtr,Ptr a
dstColumnPtr),Ptr a
srcPtr) -> do
            Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
copyCondConjugate Conjugation
conj Ptr CInt
nPtr Ptr a
srcPtr Ptr CInt
incxPtr Ptr a
dstRowPtr Ptr CInt
incyPtr
            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
dstColumnPtr Ptr CInt
incxPtr


addMirrored ::
   (Mirror mirror, Shape.C sh, Class.Floating a) =>
   Square sh a -> Packed.Mosaic mirror Shape.Upper sh a
addMirrored :: Square sh a -> Mosaic mirror Upper sh a
addMirrored (Array (Layout.Full Order
order Extent Shape Small Small sh sh
extent) ForeignPtr a
a) =
   let sh :: sh
sh = Extent Shape Small Small sh sh -> sh
forall shape. Square shape -> shape
Extent.squareSize Extent Shape Small Small sh sh
extent
       mirror :: MirrorSingleton mirror
mirror = MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
Layout.autoMirror
       shape :: Mosaic Packed mirror Upper sh
shape =
         PackingSingleton Packed
-> MirrorSingleton mirror
-> UpLoSingleton Upper
-> Order
-> sh
-> Mosaic Packed mirror Upper sh
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton Packed
Layout.Packed MirrorSingleton mirror
mirror UpLoSingleton Upper
Layout.Upper Order
order sh
sh
   in Mosaic Packed mirror Upper sh
-> (Ptr a -> IO ()) -> Mosaic mirror Upper sh a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate Mosaic Packed mirror Upper sh
shape ((Ptr a -> IO ()) -> Mosaic mirror Upper sh a)
-> (Ptr a -> IO ()) -> Mosaic mirror Upper sh a
forall a b. (a -> b) -> a -> b
$ \Ptr a
bPtr -> 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

   let conj :: Conjugation
conj = MirrorSingleton mirror -> Conjugation
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> Conjugation
conjugationFromMirror MirrorSingleton mirror
mirror
   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
   Ptr a
alphaPtr <- a -> FortranIO () (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
one
   Ptr CInt
incxPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
   Ptr CInt
incnPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr a
aPtr <- ((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
   IO () -> ContT () IO ()
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
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
aPtr Ptr a
bPtr) ((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) -> do
         Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
copyCondConjugate Conjugation
conj Ptr CInt
nPtr Ptr a
srcPtr Ptr CInt
incnPtr Ptr a
dstPtr Ptr CInt
incxPtr
         Ptr CInt
-> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CInt
-> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
BlasGen.axpy Ptr CInt
nPtr Ptr a
alphaPtr Ptr a
srcPtr Ptr CInt
incxPtr Ptr a
dstPtr Ptr CInt
incxPtr
      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
aPtr Ptr a
bPtr) ((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
srcRowPtr,Ptr a
srcColumnPtr),Ptr a
dstPtr) -> do
         Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
copyCondConjugate Conjugation
conj Ptr CInt
nPtr Ptr a
srcRowPtr Ptr CInt
incnPtr Ptr a
dstPtr Ptr CInt
incxPtr
         Ptr CInt
-> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CInt
-> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
BlasGen.axpy Ptr CInt
nPtr Ptr a
alphaPtr Ptr a
srcColumnPtr Ptr CInt
incxPtr Ptr a
dstPtr Ptr CInt
incxPtr


complementUnpacked ::
   (Class.Floating a) =>
   Conjugation -> Order -> Int -> Ptr a -> Ptr a -> IO ()
complementUnpacked :: Conjugation -> Order -> Int -> Ptr a -> Ptr a -> IO ()
complementUnpacked Conjugation
conj Order
order Int
n Ptr a
aPtr Ptr a
bPtr = 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
inc1Ptr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
   Ptr CInt
incnPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   let number :: [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
number = Int -> [(Int, (Ptr a, Ptr a))] -> [(Int, (Ptr a, Ptr a))]
forall a. Int -> [a] -> [a]
take Int
n ([(Int, (Ptr a, Ptr a))] -> [(Int, (Ptr a, Ptr a))])
-> ([(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))])
-> [(Ptr a, Ptr a)]
-> [(Int, (Ptr a, Ptr a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
   IO () -> ContT () IO ()
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
RowMajor ->
         [(Int, (Ptr a, Ptr a))]
-> (Ptr CInt -> (Ptr a, Ptr a) -> IO ()) -> IO ()
forall a. [(Int, a)] -> (Ptr CInt -> a -> IO ()) -> IO ()
forPointers ([(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
number ([(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))])
-> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. (a -> b) -> a -> b
$ [Ptr a] -> [Ptr a] -> [(Ptr a, Ptr a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Ptr a -> [Ptr a]
forall a. Storable a => Int -> Ptr a -> [Ptr a]
pointerSeq Int
1 Ptr a
aPtr) (Int -> Ptr a -> [Ptr a]
forall a. Storable a => Int -> Ptr a -> [Ptr a]
pointerSeq Int
n Ptr a
bPtr)) ((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) ->
            Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
copyCondConjugate Conjugation
conj Ptr CInt
nPtr Ptr a
srcPtr Ptr CInt
incnPtr Ptr a
dstPtr Ptr CInt
inc1Ptr
      Order
ColumnMajor ->
         [(Int, (Ptr a, Ptr a))]
-> (Ptr CInt -> (Ptr a, Ptr a) -> IO ()) -> IO ()
forall a. [(Int, a)] -> (Ptr CInt -> a -> IO ()) -> IO ()
forPointers ([(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
number ([(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))])
-> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. (a -> b) -> a -> b
$ [Ptr a] -> [Ptr a] -> [(Ptr a, Ptr a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Ptr a -> [Ptr a]
forall a. Storable a => Int -> Ptr a -> [Ptr a]
pointerSeq Int
n Ptr a
aPtr) (Int -> Ptr a -> [Ptr a]
forall a. Storable a => Int -> Ptr a -> [Ptr a]
pointerSeq Int
1 Ptr a
bPtr)) ((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) ->
            Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
copyCondConjugate Conjugation
conj Ptr CInt
nPtr Ptr a
srcPtr Ptr CInt
inc1Ptr Ptr a
dstPtr Ptr CInt
incnPtr

complement ::
   (Class.Floating a) =>
   Layout.PackingSingleton pack ->
   Conjugation -> Order -> Int -> Ptr a -> IO ()
complement :: PackingSingleton pack
-> Conjugation -> Order -> Int -> Ptr a -> IO ()
complement PackingSingleton pack
pack Conjugation
conj Order
order Int
n Ptr a
bPtr = do
   case PackingSingleton pack
pack of
      PackingSingleton pack
Layout.Packed -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      PackingSingleton pack
Layout.Unpacked -> Conjugation -> Order -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
Conjugation -> Order -> Int -> Ptr a -> Ptr a -> IO ()
complementUnpacked Conjugation
conj Order
order Int
n Ptr a
bPtr Ptr a
bPtr


type SPMV ar a =
      Ptr CChar -> Ptr CInt -> Ptr ar -> Ptr a ->
      Ptr a -> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> IO ()

type SYMV ar a =
      Ptr CChar -> Ptr CInt -> Ptr ar -> Ptr a -> Ptr CInt ->
      Ptr a -> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> IO ()

multiplyVectorCont ::
   (Class.Floating ar, Class.Floating a) =>
   SPMV ar a ->
   SYMV ar a ->
   Layout.PackingSingleton pack ->
   Layout.UpLoSingleton uplo ->
   Layout.Order ->
   Int ->
   ForeignPtr a -> Ptr a -> Ptr a -> ContT () IO ()
multiplyVectorCont :: SPMV ar a
-> SYMV ar a
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Order
-> Int
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> ContT () IO ()
multiplyVectorCont SPMV ar a
spmv SYMV ar a
symv PackingSingleton pack
pack UpLoSingleton uplo
uplo Order
order Int
n ForeignPtr a
a Ptr a
xPtr Ptr a
yPtr = do
   Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder (Order -> Char) -> Order -> Char
forall a b. (a -> b) -> a -> b
$ UpLoSingleton uplo -> Order -> Order
forall uplo. UpLoSingleton uplo -> Order -> Order
uploOrder UpLoSingleton uplo
uplo Order
order
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr ar
alphaPtr <- ar -> FortranIO () (Ptr ar)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number ar
forall a. Floating a => a
one
   Ptr a
aPtr <- ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
   Ptr CInt
incxPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
   Ptr a
betaPtr <- a -> ContT () IO (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
zero
   Ptr CInt
incyPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
   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
  ()
  ()
  (FuncPacked
     (Ptr CChar
      -> Ptr CInt
      -> Ptr ar
      -> TriArg a
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr a
      -> Ptr CInt
      -> Labelled2 () () (IO ()) (IO ())))
-> Labelled
     ()
     ()
     (FuncUnpacked
        (Ptr CChar
         -> Ptr CInt
         -> Ptr ar
         -> TriArg a
         -> Ptr a
         -> Ptr CInt
         -> Ptr a
         -> Ptr a
         -> Ptr CInt
         -> Labelled2 () () (IO ()) (IO ())))
-> Ptr CChar
-> Ptr CInt
-> Ptr ar
-> TriArg a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Labelled2 () () (IO ()) (IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair (SPMV ar a -> Labelled () () (SPMV ar a)
forall a r. a -> Labelled r () a
noLabel SPMV ar a
spmv) (SYMV ar a -> Labelled () () (SYMV ar a)
forall a r. a -> Labelled r () a
noLabel SYMV ar a
symv)
         Ptr CChar
uploPtr Ptr CInt
nPtr Ptr ar
alphaPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
aPtr Int
n)
         Ptr a
xPtr Ptr CInt
incxPtr Ptr a
betaPtr Ptr a
yPtr Ptr CInt
incyPtr

-- Triangular is a bit different, it has no alpha
multiplyVector ::
   (Mirror mirror, Shape.C sh, Eq sh, Class.Floating a) =>
   Mosaic pack mirror uplo sh a -> Vector sh a -> Vector sh a
multiplyVector :: Mosaic pack mirror uplo sh a -> Vector sh a -> Vector sh a
multiplyVector
   (Array (Layout.Mosaic PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order sh
shA) ForeignPtr a
a) (Array sh
shX ForeignPtr a
x) =
      sh -> (Int -> Ptr a -> IO ()) -> Vector sh a
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize sh
shX ((Int -> Ptr a -> IO ()) -> Vector sh a)
-> (Int -> Ptr a -> IO ()) -> Vector sh a
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr a
yPtr -> do
   String -> Bool -> IO ()
Call.assert String
"Symmetric.multiplyVector: width shapes mismatch" (sh
shA sh -> sh -> Bool
forall a. Eq a => a -> a -> Bool
== sh
shX)
   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
$
      case MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror of
         MirrorSingleton mirror
ConjugateMirror -> do
            let conj :: Conjugation
conj = Order -> Conjugation
conjugatedOnRowMajor Order
order
            Ptr a
xPtr <- Conjugation -> Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r.
Floating a =>
Conjugation -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
condConjugateToTemp Conjugation
conj Int
n ForeignPtr a
x
            SPMV a a
-> SYMV a a
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Order
-> Int
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> ContT () IO ()
forall ar a pack uplo.
(Floating ar, Floating a) =>
SPMV ar a
-> SYMV ar a
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Order
-> Int
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> ContT () IO ()
multiplyVectorCont SPMV a a
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
BlasGen.hpmv SYMV a a
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
BlasGen.hemv
               PackingSingleton pack
pack UpLoSingleton uplo
uplo Order
order Int
n ForeignPtr a
a Ptr a
xPtr Ptr a
yPtr
            Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
            Ptr CInt
incyPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
            IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Conjugation -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Conjugation -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
condConjugate Conjugation
conj Ptr CInt
nPtr Ptr a
yPtr Ptr CInt
incyPtr
         MirrorSingleton mirror
SimpleMirror -> do
            Ptr a
xPtr <- ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x
            case ForeignPtr a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor ForeignPtr a
x of
               ComplexSingleton a
Scalar.Real ->
                  SPMV a a
-> SYMV a a
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Order
-> Int
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> ContT () IO ()
forall ar a pack uplo.
(Floating ar, Floating a) =>
SPMV ar a
-> SYMV ar a
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Order
-> Int
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> ContT () IO ()
multiplyVectorCont SPMV a a
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
BlasReal.spmv SYMV a a
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
BlasReal.symv
                     PackingSingleton pack
pack UpLoSingleton uplo
uplo Order
order Int
n ForeignPtr a
a Ptr a
xPtr Ptr a
yPtr
               ComplexSingleton a
Scalar.Complex ->
                  SPMV (Complex a) (Complex a)
-> SYMV (Complex a) (Complex a)
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Order
-> Int
-> ForeignPtr (Complex a)
-> Ptr (Complex a)
-> Ptr (Complex a)
-> ContT () IO ()
forall ar a pack uplo.
(Floating ar, Floating a) =>
SPMV ar a
-> SYMV ar a
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Order
-> Int
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> ContT () IO ()
multiplyVectorCont SPMV (Complex a) (Complex a)
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
LapackComplex.spmv SYMV (Complex a) (Complex a)
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
LapackComplex.symv
                     PackingSingleton pack
pack UpLoSingleton uplo
uplo Order
order Int
n ForeignPtr a
ForeignPtr (Complex a)
a Ptr a
Ptr (Complex a)
xPtr Ptr a
Ptr (Complex a)
yPtr


multiplyFull ::
   (Layout.UpLo uplo, Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Class.Floating a) =>
   Mosaic pack mirror uplo height a ->
   Full meas vert horiz height width a ->
   Full meas vert horiz height width a
multiplyFull :: Mosaic pack mirror uplo height a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
multiplyFull =
   DiagSingleton Arbitrary
-> Mosaic mirror uplo height a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
forall uplo diag meas vert horiz height width a mirror.
(UpLo uplo, TriDiag diag, Measure meas, C vert, C horiz, C height,
 Eq height, C width, Floating a) =>
DiagSingleton diag
-> Mosaic mirror uplo height a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
Unpacked.multiplyFull DiagSingleton Arbitrary
Omni.Arbitrary (Mosaic mirror uplo height a
 -> Full meas vert horiz height width a
 -> Full meas vert horiz height width a)
-> (Mosaic pack mirror uplo height a
    -> Mosaic mirror uplo height a)
-> Mosaic pack mirror uplo height a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mosaic pack mirror uplo height a -> Mosaic mirror uplo height a
forall uplo sh a pack mirror.
(UpLo uplo, C sh, Floating a) =>
Mosaic pack mirror uplo sh a -> MosaicUnpacked mirror uplo sh a
Mosaic.unpackDirty


forceUpper ::
   (Layout.Packing pack, Mirror mirror, Shape.C sh, Class.Floating a) =>
   Mosaic pack mirror uplo sh a ->
   Mosaic pack mirror Shape.Upper sh a
forceUpper :: Mosaic pack mirror uplo sh a -> Mosaic pack mirror Upper sh a
forceUpper Mosaic pack mirror uplo sh a
a =
   case Mosaic pack mirror uplo sh -> UpLoSingleton uplo
forall pack mirror uplo size.
Mosaic pack mirror uplo size -> UpLoSingleton uplo
Layout.mosaicUplo (Mosaic pack mirror uplo sh -> UpLoSingleton uplo)
-> Mosaic pack mirror uplo sh -> UpLoSingleton uplo
forall a b. (a -> b) -> a -> b
$ Mosaic pack mirror uplo sh a -> Mosaic pack mirror uplo sh
forall sh a. Array sh a -> sh
Array.shape Mosaic pack mirror uplo sh a
a of
      UpLoSingleton uplo
Layout.Upper -> Mosaic pack mirror uplo sh a
Mosaic pack mirror Upper sh a
a
      UpLoSingleton uplo
Layout.Lower -> Mosaic pack mirror Lower sh a -> Mosaic pack mirror Upper sh a
forall pack mirror sh a.
(Packing pack, Mirror mirror, C sh, Floating a) =>
Mosaic pack mirror Lower sh a -> Mosaic pack mirror Upper sh a
upperFromLower Mosaic pack mirror uplo sh a
Mosaic pack mirror Lower sh a
a

upperFromLower ::
   (Layout.Packing pack, Mirror mirror, Shape.C sh, Class.Floating a) =>
   Mosaic pack mirror Shape.Lower sh a ->
   Mosaic pack mirror Shape.Upper sh a
upperFromLower :: Mosaic pack mirror Lower sh a -> Mosaic pack mirror Upper sh a
upperFromLower
      (Array (Layout.Mosaic PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton Lower
Layout.Lower Order
order sh
sh) ForeignPtr a
a) =

   (case MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror of
      MirrorSingleton mirror
SimpleMirror -> Mosaic pack mirror Upper sh a -> Mosaic pack mirror Upper sh a
forall a. a -> a
id
      MirrorSingleton mirror
ConjugateMirror -> Mosaic pack mirror Upper sh a -> Mosaic pack mirror Upper sh a
forall sh a. (C sh, Floating a) => Vector sh a -> Vector sh a
Vector.conjugate) (Mosaic pack mirror Upper sh a -> Mosaic pack mirror Upper sh a)
-> Mosaic pack mirror Upper sh a -> Mosaic pack mirror Upper sh a
forall a b. (a -> b) -> a -> b
$
   Mosaic pack mirror Upper sh
-> ForeignPtr a -> Mosaic pack mirror Upper sh a
forall sh a. sh -> ForeignPtr a -> Array sh a
Array
      (PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton Upper
-> Order
-> sh
-> Mosaic pack mirror Upper sh
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic
         PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton Upper
Layout.Upper (Order -> Order
Layout.flipOrder Order
order) sh
sh)
      ForeignPtr a
a


type SYR ar a f =
      Ptr CChar -> Ptr CInt -> Ptr ar -> Ptr a -> Ptr CInt -> Ptr a -> f

withSyrSingleton ::
   (Class.Floating a) => (Scalar.ComplexSingleton a -> SYR a a f) -> SYR a a f
withSyrSingleton :: (ComplexSingleton a -> SYR a a f) -> SYR a a f
withSyrSingleton ComplexSingleton a -> SYR a a f
f = ComplexSingleton a -> SYR a a f
f ComplexSingleton a
forall a. Floating a => ComplexSingleton a
Scalar.complexSingleton

spr :: (Class.Floating a) => SYR a a (IO ())
spr :: SYR a a (IO ())
spr = (ComplexSingleton a -> SYR a a (IO ())) -> SYR a a (IO ())
forall a f.
Floating a =>
(ComplexSingleton a -> SYR a a f) -> SYR a a f
withSyrSingleton ((ComplexSingleton a -> SYR a a (IO ())) -> SYR a a (IO ()))
-> (ComplexSingleton a -> SYR a a (IO ())) -> SYR a a (IO ())
forall a b. (a -> b) -> a -> b
$ \ComplexSingleton a
sw ->
   case ComplexSingleton a
sw of
      ComplexSingleton a
Scalar.Real -> SYR a a (IO ())
forall a.
Real a =>
Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> IO ()
BlasReal.spr
      ComplexSingleton a
Scalar.Complex -> SYR a a (IO ())
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> IO ()
LapackComplex.spr

syr :: (Class.Floating a) => SYR a a (Ptr CInt -> IO ())
syr :: SYR a a (Ptr CInt -> IO ())
syr = (ComplexSingleton a -> SYR a a (Ptr CInt -> IO ()))
-> SYR a a (Ptr CInt -> IO ())
forall a f.
Floating a =>
(ComplexSingleton a -> SYR a a f) -> SYR a a f
withSyrSingleton ((ComplexSingleton a -> SYR a a (Ptr CInt -> IO ()))
 -> SYR a a (Ptr CInt -> IO ()))
-> (ComplexSingleton a -> SYR a a (Ptr CInt -> IO ()))
-> SYR a a (Ptr CInt -> IO ())
forall a b. (a -> b) -> a -> b
$ \ComplexSingleton a
sw ->
   case ComplexSingleton a
sw of
      ComplexSingleton a
Scalar.Real -> SYR a 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
      ComplexSingleton a
Scalar.Complex -> SYR a a (Ptr CInt -> IO ())
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
LapackComplex.syr

outerCont ::
   (Class.Floating a, Class.Floating ar) =>
   SYR ar a (IO ()) ->
   SYR ar a (Ptr CInt -> IO ()) ->
   ForeignPtr a -> Int ->
   Layout.PackingSingleton pack ->
   Layout.UpLoSingleton uplo ->
   Ptr a -> ContT () IO ()
outerCont :: SYR ar a (IO ())
-> SYR ar a (Ptr CInt -> IO ())
-> ForeignPtr a
-> Int
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Ptr a
-> ContT () IO ()
outerCont SYR ar a (IO ())
spr_ SYR ar a (Ptr CInt -> IO ())
syr_ ForeignPtr a
x Int
n PackingSingleton pack
pack UpLoSingleton uplo
uplo Ptr a
aPtr = do
   Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ UpLoSingleton uplo -> Char
forall uplo. UpLoSingleton uplo -> Char
Layout.uploChar UpLoSingleton uplo
uplo
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr ar
alphaPtr <- ar -> FortranIO () (Ptr ar)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number ar
forall a. Floating a => a
one
   Ptr a
xPtr <- ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x
   Ptr CInt
incxPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
1
   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
  ()
  ()
  (FuncPacked
     (Ptr CChar
      -> Ptr CInt
      -> Ptr ar
      -> Ptr a
      -> Ptr CInt
      -> TriArg a
      -> Labelled2 () () (IO ()) (IO ())))
-> Labelled
     ()
     ()
     (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 (SYR ar a (IO ()) -> Labelled () () (SYR ar a (IO ()))
forall a r. a -> Labelled r () a
noLabel SYR ar a (IO ())
spr_) (SYR ar a (Ptr CInt -> IO ())
-> Labelled () () (SYR ar a (Ptr CInt -> IO ()))
forall a r. a -> Labelled r () a
noLabel SYR ar a (Ptr CInt -> IO ())
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)

outer ::
   (Layout.Packing pack, Mirror mirror, Layout.UpLo uplo,
    Shape.C sh, Class.Floating a) =>
   Vector sh a -> Mosaic pack mirror uplo sh a
outer :: Vector sh a -> Mosaic pack mirror uplo sh a
outer (Array sh
sh ForeignPtr a
x) =
   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
       pack :: PackingSingleton pack
pack = PackingSingleton pack
forall pack. Packing pack => PackingSingleton pack
Layout.autoPacking
       mirror :: MirrorSingleton mirror
mirror = MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
Layout.autoMirror
       uplo :: UpLoSingleton uplo
uplo = UpLoSingleton uplo
forall uplo. UpLo uplo => UpLoSingleton uplo
Layout.autoUplo
       order :: Order
order = Order
Layout.ColumnMajor
   in Mosaic pack mirror uplo sh
-> (Int -> Ptr a -> IO ()) -> Mosaic pack mirror uplo sh a
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize
         (PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> sh
-> Mosaic pack mirror uplo sh
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order sh
sh) ((Int -> Ptr a -> IO ()) -> Mosaic pack mirror uplo sh a)
-> (Int -> Ptr a -> IO ()) -> Mosaic pack mirror uplo 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
   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
$
      case (ForeignPtr a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor ForeignPtr a
x, MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) of
         (ComplexSingleton a
Scalar.Complex, MirrorSingleton mirror
ConjugateMirror) ->
            SYR a (Complex a) (IO ())
-> SYR a (Complex a) (Ptr CInt -> IO ())
-> ForeignPtr (Complex a)
-> Int
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Ptr (Complex a)
-> ContT () IO ()
forall a ar pack uplo.
(Floating a, Floating ar) =>
SYR ar a (IO ())
-> SYR ar a (Ptr CInt -> IO ())
-> ForeignPtr a
-> Int
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Ptr a
-> ContT () IO ()
outerCont SYR a (Complex a) (IO ())
forall a.
Real a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> IO ()
BlasComplex.hpr SYR a (Complex a) (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 ForeignPtr a
ForeignPtr (Complex a)
x Int
n PackingSingleton pack
pack UpLoSingleton uplo
uplo Ptr a
Ptr (Complex a)
aPtr
         (ComplexSingleton a, MirrorSingleton mirror)
_ -> SYR a a (IO ())
-> SYR a a (Ptr CInt -> IO ())
-> ForeignPtr a
-> Int
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Ptr a
-> ContT () IO ()
forall a ar pack uplo.
(Floating a, Floating ar) =>
SYR ar a (IO ())
-> SYR ar a (Ptr CInt -> IO ())
-> ForeignPtr a
-> Int
-> PackingSingleton pack
-> UpLoSingleton uplo
-> Ptr a
-> ContT () IO ()
outerCont SYR a a (IO ())
forall a. Floating a => SYR a a (IO ())
spr SYR a a (Ptr CInt -> IO ())
forall a. Floating a => SYR a a (Ptr CInt -> IO ())
syr ForeignPtr a
x Int
n PackingSingleton pack
pack UpLoSingleton uplo
uplo Ptr a
aPtr
   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 (MirrorSingleton mirror -> Conjugation
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> Conjugation
conjugationFromMirror MirrorSingleton mirror
mirror) (UpLoSingleton uplo -> Order -> Order
forall uplo. UpLoSingleton uplo -> Order -> Order
uploOrder UpLoSingleton uplo
uplo Order
order) Int
n Ptr a
aPtr

outerUpper ::
   (Layout.Packing pack, Mirror mirror, Shape.C sh, Class.Floating a) =>
   Order -> Vector sh a -> Mosaic pack mirror Shape.Upper sh a
outerUpper :: Order -> Vector sh a -> Mosaic pack mirror Upper sh a
outerUpper Order
order Vector sh a
x =
   case Order
order of
      Order
Layout.ColumnMajor -> Vector sh a -> Mosaic pack mirror Upper sh a
forall pack mirror uplo sh a.
(Packing pack, Mirror mirror, UpLo uplo, C sh, Floating a) =>
Vector sh a -> Mosaic pack mirror uplo sh a
outer Vector sh a
x
      Order
Layout.RowMajor -> Mosaic pack mirror Lower sh a -> Mosaic pack mirror Upper sh a
forall pack mirror sh a.
(Packing pack, Mirror mirror, C sh, Floating a) =>
Mosaic pack mirror Lower sh a -> Mosaic pack mirror Upper sh a
upperFromLower (Mosaic pack mirror Lower sh a -> Mosaic pack mirror Upper sh a)
-> Mosaic pack mirror Lower sh a -> Mosaic pack mirror Upper sh a
forall a b. (a -> b) -> a -> b
$ Vector sh a -> Mosaic pack mirror Lower sh a
forall pack mirror uplo sh a.
(Packing pack, Mirror mirror, UpLo uplo, C sh, Floating a) =>
Vector sh a -> Mosaic pack mirror uplo sh a
outer Vector sh a
x


upperShape ::
   (Layout.Mirror mirror) =>
   Layout.PackingSingleton pack ->
   Layout.MirrorSingleton mirror -> Order -> size ->
   Layout.Mosaic pack mirror Shape.Upper size
upperShape :: PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> size
-> Mosaic pack mirror Upper size
upperShape PackingSingleton pack
pack MirrorSingleton mirror
mirror = PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton Upper
-> Order
-> size
-> Mosaic pack mirror Upper size
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton Upper
Layout.Upper

unpackedShape ::
   (Layout.Mirror mirror) =>
   Layout.MirrorSingleton mirror -> Order -> size ->
   Layout.Mosaic Layout.Unpacked mirror Shape.Upper size
unpackedShape :: MirrorSingleton mirror
-> Order -> size -> Mosaic Unpacked mirror Upper size
unpackedShape = PackingSingleton Unpacked
-> MirrorSingleton mirror
-> Order
-> size
-> Mosaic Unpacked mirror Upper size
forall mirror pack size.
Mirror mirror =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> size
-> Mosaic pack mirror Upper size
upperShape PackingSingleton Unpacked
Layout.Unpacked

skipCheckCongruence ::
   ((sh -> Unchecked sh) -> matrix0 -> matrix1) ->
   (matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a) ->
   matrix0 -> Mosaic pack mirror uplo sh a
skipCheckCongruence :: ((sh -> Unchecked sh) -> matrix0 -> matrix1)
-> (matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> matrix0
-> Mosaic pack mirror uplo sh a
skipCheckCongruence (sh -> Unchecked sh) -> matrix0 -> matrix1
mapSize matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a
f  =  Mosaic pack mirror uplo (Unchecked sh) a
-> Mosaic pack mirror uplo sh a
forall pack mirror uplo sh a.
Mosaic pack mirror uplo (Unchecked sh) a
-> Mosaic pack mirror uplo sh a
recheck (Mosaic pack mirror uplo (Unchecked sh) a
 -> Mosaic pack mirror uplo sh a)
-> (matrix0 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> matrix0
-> Mosaic pack mirror uplo sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a
f (matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> (matrix0 -> matrix1)
-> matrix0
-> Mosaic pack mirror uplo (Unchecked sh) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (sh -> Unchecked sh) -> matrix0 -> matrix1
mapSize sh -> Unchecked sh
forall sh. sh -> Unchecked sh
Unchecked


postHook :: (Monad m) => m () -> ContT r m ()
postHook :: m () -> ContT r m ()
postHook m ()
hook = ((() -> m r) -> m r) -> ContT r m ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> m r) -> m r) -> ContT r m ())
-> ((() -> m r) -> m r) -> ContT r m ()
forall a b. (a -> b) -> a -> b
$ \() -> m r
act -> do r
r <- () -> m r
act (); m ()
hook; r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r

temporaryUnpacked ::
   (Mirror mirror, Class.Floating a) =>
   Layout.PackingSingleton pack -> MirrorSingleton mirror -> Order ->
   Int -> Ptr a -> ContT () IO (Ptr a)
temporaryUnpacked :: PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> Int
-> Ptr a
-> ContT () IO (Ptr a)
temporaryUnpacked PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order Int
n Ptr a
cpPtr =
   case PackingSingleton pack
pack of
      PackingSingleton pack
Layout.Packed -> do
         Ptr a
cPtr <- Int -> ContT () IO (Ptr a)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n)
         IO () -> ContT () IO ()
forall (m :: * -> *) r. Monad m => m () -> ContT r m ()
postHook (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Order -> Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
MosaicPriv.pack Order
order Int
n Ptr a
cPtr Ptr a
cpPtr
         Ptr a -> ContT () IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
cPtr
      PackingSingleton pack
Layout.Unpacked -> do
         IO () -> ContT () IO ()
forall (m :: * -> *) r. Monad m => m () -> ContT r m ()
postHook (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Conjugation -> Order -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
Conjugation -> Order -> Int -> Ptr a -> Ptr a -> IO ()
complementUnpacked
               (MirrorSingleton mirror -> Conjugation
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> Conjugation
conjugationFromMirror MirrorSingleton mirror
mirror) Order
order Int
n Ptr a
cpPtr Ptr a
cpPtr
         Ptr a -> ContT () IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
cpPtr


gramianParameters ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width) =>
   MirrorSingleton mirror ->
   Transposition ->
   Order ->
   Extent.Extent meas vert horiz height width ->
   ((Int, Int), (Char, Char, Int))
gramianParameters :: MirrorSingleton mirror
-> Transposition
-> Order
-> Extent meas vert horiz height width
-> ((Int, Int), (Char, Char, Int))
gramianParameters MirrorSingleton mirror
mirror Transposition
trans Order
order Extent meas vert horiz height width
extent =
   let (height
height, width
width) = Extent meas vert horiz height width -> (height, width)
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width -> (height, width)
Extent.dimensions Extent meas vert horiz height width
extent
       n :: Int
n = width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
       k :: Int
k = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
       mirrorChar :: Char
mirrorChar =
         case MirrorSingleton mirror
mirror of
            MirrorSingleton mirror
SimpleMirror -> Char
'T'
            MirrorSingleton mirror
ConjugateMirror -> Char
'C'
       transChar :: Char
transChar =
         case Transposition -> Order -> Order
transposeOrder Transposition
trans Order
order of
            Order
ColumnMajor -> Char
mirrorChar
            Order
RowMajor -> Char
'N'
       lda :: Int
lda =
         case Order
order of
            Order
ColumnMajor -> Int
k
            Order
RowMajor -> Int
n
    in (case Transposition
trans of Transposition
NonTransposed -> (Int
n,Int
k); Transposition
Transposed -> (Int
k,Int
n),
        (Order -> Char
uploFromOrder Order
order, Char
transChar, Int
lda))


{-
Another way to unify 'gramian' and 'gramianAdjoint'
would have been this function:

> gramianConjugation ::
>    Conjugation -> General height width a -> Hermitian width a

with

> gramianAdjoint a = gramianConjugation (transpose a)

but I would like to have

> order (gramianAdjoint a) = order a
-}
gramianIO ::
   (Mirror mirror, Class.Floating a) =>
   Layout.PackingSingleton pack -> MirrorSingleton mirror -> Order ->
   ForeignPtr a -> Ptr a ->
   ((Int, Int), (Char, Char, Int)) -> IO ()
gramianIO :: PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
gramianIO PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order ForeignPtr a
a Ptr a
cpPtr ((Int
n,Int
k), (Char
uplo,Char
trans,Int
lda)) = 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 CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
uplo
   Ptr CChar
transPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
trans
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr CInt
kPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
k
   Ptr a
aPtr <- ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
   Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
lda
   Ptr a
cPtr <- PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> Int
-> Ptr a
-> ContT () IO (Ptr a)
forall mirror a pack.
(Mirror mirror, Floating a) =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> Int
-> Ptr a
-> ContT () IO (Ptr a)
temporaryUnpacked PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order Int
n Ptr a
cpPtr
   Ptr CInt
ldcPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
   case (Int
k, MirrorSingleton mirror
mirror, ForeignPtr a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor ForeignPtr a
a) of
      (Int
0, MirrorSingleton mirror
_, ComplexSingleton a
_) -> IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ a -> Int -> Ptr a -> IO ()
forall a. Floating a => a -> Int -> Ptr a -> IO ()
fill a
forall a. Floating a => a
zero (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) Ptr a
cPtr
      (Int
_, MirrorSingleton mirror
ConjugateMirror, ComplexSingleton a
Scalar.Complex) -> do
         Ptr a
alphaPtr <- a -> FortranIO () (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
one
         Ptr a
betaPtr <- a -> FortranIO () (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
zero
         IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
BlasComplex.herk Ptr CChar
uploPtr Ptr CChar
transPtr
               Ptr CInt
nPtr Ptr CInt
kPtr Ptr a
alphaPtr Ptr a
Ptr (Complex a)
aPtr Ptr CInt
ldaPtr Ptr a
betaPtr Ptr a
Ptr (Complex a)
cPtr Ptr CInt
ldcPtr
      (Int, MirrorSingleton mirror, ComplexSingleton a)
_ -> do
         Ptr a
alphaPtr <- a -> ContT () IO (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
one
         Ptr a
betaPtr <- a -> ContT () IO (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
zero
         IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
BlasGen.syrk Ptr CChar
uploPtr Ptr CChar
transPtr
               Ptr CInt
nPtr Ptr CInt
kPtr Ptr a
alphaPtr Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
betaPtr Ptr a
cPtr Ptr CInt
ldcPtr

gramian ::
   (Layout.Packing pack, Mirror mirror,
    Shape.C height, Shape.C width, Class.Floating a) =>
   Matrix.General height width a ->
   Mosaic pack mirror Shape.Upper width a
gramian :: General height width a -> Mosaic pack mirror Upper width a
gramian (Array (Layout.Full Order
order Extent Size Big Big height width
extent) ForeignPtr a
a) =
   let pack :: PackingSingleton pack
pack = PackingSingleton pack
forall pack. Packing pack => PackingSingleton pack
Layout.autoPacking
       mirror :: MirrorSingleton mirror
mirror = MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
Layout.autoMirror
   in Mosaic pack mirror Upper width
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper width a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> width
-> Mosaic pack mirror Upper width
forall mirror pack size.
Mirror mirror =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> size
-> Mosaic pack mirror Upper size
upperShape PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order (width -> Mosaic pack mirror Upper width)
-> width -> Mosaic pack mirror Upper width
forall a b. (a -> b) -> a -> b
$ Extent Size Big Big height width -> width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width -> width
Extent.width Extent Size Big Big height width
extent) ((Ptr a -> IO ()) -> Mosaic pack mirror Upper width a)
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper width a
forall a b. (a -> b) -> a -> b
$
      \Ptr a
bPtr ->
         PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
forall mirror a pack.
(Mirror mirror, Floating a) =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
gramianIO PackingSingleton pack
pack (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Order
order ForeignPtr a
a Ptr a
bPtr (((Int, Int), (Char, Char, Int)) -> IO ())
-> ((Int, Int), (Char, Char, Int)) -> IO ()
forall a b. (a -> b) -> a -> b
$
         MirrorSingleton mirror
-> Transposition
-> Order
-> Extent Size Big Big height width
-> ((Int, Int), (Char, Char, Int))
forall meas vert horiz height width mirror.
(Measure meas, C vert, C horiz, C height, C width) =>
MirrorSingleton mirror
-> Transposition
-> Order
-> Extent meas vert horiz height width
-> ((Int, Int), (Char, Char, Int))
gramianParameters (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Transposition
NonTransposed Order
order Extent Size Big Big height width
extent

gramianTransposed ::
   (Layout.Packing pack, Mirror mirror,
    Shape.C height, Shape.C width, Class.Floating a) =>
   Matrix.General height width a ->
   Mosaic pack mirror Shape.Upper height a
gramianTransposed :: General height width a -> Mosaic pack mirror Upper height a
gramianTransposed (Array (Layout.Full Order
order Extent Size Big Big height width
extent) ForeignPtr a
a) =
   let pack :: PackingSingleton pack
pack = PackingSingleton pack
forall pack. Packing pack => PackingSingleton pack
Layout.autoPacking
       mirror :: MirrorSingleton mirror
mirror = MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
Layout.autoMirror
   in Mosaic pack mirror Upper height
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper height a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> height
-> Mosaic pack mirror Upper height
forall mirror pack size.
Mirror mirror =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> size
-> Mosaic pack mirror Upper size
upperShape PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order (height -> Mosaic pack mirror Upper height)
-> height -> Mosaic pack mirror Upper height
forall a b. (a -> b) -> a -> b
$ Extent Size Big Big height width -> height
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width -> height
Extent.height Extent Size Big Big height width
extent) ((Ptr a -> IO ()) -> Mosaic pack mirror Upper height a)
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper height a
forall a b. (a -> b) -> a -> b
$
      \Ptr a
bPtr ->
         PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
forall mirror a pack.
(Mirror mirror, Floating a) =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
gramianIO PackingSingleton pack
pack (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Order
order ForeignPtr a
a Ptr a
bPtr (((Int, Int), (Char, Char, Int)) -> IO ())
-> ((Int, Int), (Char, Char, Int)) -> IO ()
forall a b. (a -> b) -> a -> b
$
         MirrorSingleton mirror
-> Transposition
-> Order
-> Extent Size Big Big height width
-> ((Int, Int), (Char, Char, Int))
forall meas vert horiz height width mirror.
(Measure meas, C vert, C horiz, C height, C width) =>
MirrorSingleton mirror
-> Transposition
-> Order
-> Extent meas vert horiz height width
-> ((Int, Int), (Char, Char, Int))
gramianParameters (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Transposition
Transposed Order
order Extent Size Big Big height width
extent


scaledAnticommutatorIO ::
   (Mirror mirror, Class.Floating a) =>
   Layout.PackingSingleton pack -> MirrorSingleton mirror -> Order -> a ->
   ForeignPtr a -> ForeignPtr a -> Ptr a ->
   ((Int, Int), (Char, Char, Int)) -> IO ()
scaledAnticommutatorIO :: PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> a
-> ForeignPtr a
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
scaledAnticommutatorIO
   PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order a
alpha ForeignPtr a
a ForeignPtr a
b Ptr a
cpPtr ((Int
n,Int
k), (Char
uplo,Char
trans,Int
lda)) =
      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 CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
uplo
   Ptr CChar
transPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
trans
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr CInt
kPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
k
   Ptr a
alphaPtr <- a -> FortranIO () (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
alpha
   Ptr a
aPtr <- ((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
   Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
lda
   Ptr a
bPtr <- ((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> FortranIO () (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
b
   let ldbPtr :: Ptr CInt
ldbPtr = Ptr CInt
ldaPtr
   Ptr a
cPtr <- PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> Int
-> Ptr a
-> FortranIO () (Ptr a)
forall mirror a pack.
(Mirror mirror, Floating a) =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> Int
-> Ptr a
-> ContT () IO (Ptr a)
temporaryUnpacked PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order Int
n Ptr a
cpPtr
   Ptr CInt
ldcPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
   case (MirrorSingleton mirror
mirror, ForeignPtr a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor ForeignPtr a
a) of
      (MirrorSingleton mirror
ConjugateMirror, ComplexSingleton a
Scalar.Complex) -> do
         Ptr a
betaPtr <- a -> FortranIO () (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
zero
         IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> IO ()
BlasComplex.her2k Ptr CChar
uploPtr Ptr CChar
transPtr Ptr CInt
nPtr Ptr CInt
kPtr Ptr a
Ptr (Complex a)
alphaPtr
               Ptr a
Ptr (Complex a)
aPtr Ptr CInt
ldaPtr Ptr a
Ptr (Complex a)
bPtr Ptr CInt
ldbPtr Ptr a
betaPtr Ptr a
Ptr (Complex a)
cPtr Ptr CInt
ldcPtr
      (MirrorSingleton mirror, ComplexSingleton a)
_ -> do
         Ptr a
betaPtr <- a -> FortranIO () (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
forall a. Floating a => a
zero
         IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
BlasGen.syr2k Ptr CChar
uploPtr Ptr CChar
transPtr Ptr CInt
nPtr Ptr CInt
kPtr Ptr a
alphaPtr
               Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
bPtr Ptr CInt
ldbPtr Ptr a
betaPtr Ptr a
cPtr Ptr CInt
ldcPtr

scaledAnticommutator ::
   (Layout.Packing pack, Mirror mirror,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Eq width, Class.Floating a) =>
   Layout.MirrorSingleton mirror ->
   a ->
   Full meas vert horiz height width a ->
   Full meas vert horiz height width a ->
   Mosaic pack mirror Shape.Upper width a
scaledAnticommutator :: MirrorSingleton mirror
-> a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
-> Mosaic pack mirror Upper width a
scaledAnticommutator MirrorSingleton mirror
mirror
      a
alpha Full meas vert horiz height width a
arr (Array (Layout.Full Order
order Extent meas vert horiz height width
extentB) ForeignPtr a
b) = do
   let (Array (Layout.Full Order
_ Extent meas vert horiz height width
extentA) ForeignPtr a
a) = Order
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Order
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
Basic.forceOrder Order
order Full meas vert horiz height width a
arr
       pack :: PackingSingleton pack
pack = PackingSingleton pack
forall pack. Packing pack => PackingSingleton pack
Layout.autoPacking
   Mosaic pack mirror Upper width
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper width a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> width
-> Mosaic pack mirror Upper width
forall mirror pack size.
Mirror mirror =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> size
-> Mosaic pack mirror Upper size
upperShape PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order (width -> Mosaic pack mirror Upper width)
-> width -> Mosaic pack mirror Upper width
forall a b. (a -> b) -> a -> b
$ Extent meas vert horiz height width -> width
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width -> width
Extent.width Extent meas vert horiz height width
extentB) ((Ptr a -> IO ()) -> Mosaic pack mirror Upper width a)
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper width a
forall a b. (a -> b) -> a -> b
$
         \Ptr a
cPtr -> do
      String -> Bool -> IO ()
Call.assert String
"Symmetric.anticommutator: extents mismatch"
         (Extent meas vert horiz height width
extentAExtent meas vert horiz height width
-> Extent meas vert horiz height width -> Bool
forall a. Eq a => a -> a -> Bool
==Extent meas vert horiz height width
extentB)
      PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> a
-> ForeignPtr a
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
forall mirror a pack.
(Mirror mirror, Floating a) =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> a
-> ForeignPtr a
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
scaledAnticommutatorIO PackingSingleton pack
pack (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Order
order a
alpha ForeignPtr a
a ForeignPtr a
b Ptr a
cPtr (((Int, Int), (Char, Char, Int)) -> IO ())
-> ((Int, Int), (Char, Char, Int)) -> IO ()
forall a b. (a -> b) -> a -> b
$
         MirrorSingleton mirror
-> Transposition
-> Order
-> Extent meas vert horiz height width
-> ((Int, Int), (Char, Char, Int))
forall meas vert horiz height width mirror.
(Measure meas, C vert, C horiz, C height, C width) =>
MirrorSingleton mirror
-> Transposition
-> Order
-> Extent meas vert horiz height width
-> ((Int, Int), (Char, Char, Int))
gramianParameters (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Transposition
NonTransposed Order
order Extent meas vert horiz height width
extentB

scaledAnticommutatorTransposed ::
   (Layout.Packing pack, Mirror mirror,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Eq width, Class.Floating a) =>
   Layout.MirrorSingleton mirror ->
   a ->
   Full meas vert horiz height width a ->
   Full meas vert horiz height width a ->
   Mosaic pack mirror Shape.Upper height a
scaledAnticommutatorTransposed :: MirrorSingleton mirror
-> a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
-> Mosaic pack mirror Upper height a
scaledAnticommutatorTransposed MirrorSingleton mirror
mirror
      a
alpha Full meas vert horiz height width a
arr (Array (Layout.Full Order
order Extent meas vert horiz height width
extentB) ForeignPtr a
b) = do
   let (Array (Layout.Full Order
_ Extent meas vert horiz height width
extentA) ForeignPtr a
a) = Order
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Order
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
Basic.forceOrder Order
order Full meas vert horiz height width a
arr
       pack :: PackingSingleton pack
pack = PackingSingleton pack
forall pack. Packing pack => PackingSingleton pack
Layout.autoPacking
   Mosaic pack mirror Upper height
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper height a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> height
-> Mosaic pack mirror Upper height
forall mirror pack size.
Mirror mirror =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> size
-> Mosaic pack mirror Upper size
upperShape PackingSingleton pack
pack MirrorSingleton mirror
mirror Order
order (height -> Mosaic pack mirror Upper height)
-> height -> Mosaic pack mirror Upper height
forall a b. (a -> b) -> a -> b
$ Extent meas vert horiz height width -> height
forall meas vert horiz height width.
(Measure meas, C vert, C horiz) =>
Extent meas vert horiz height width -> height
Extent.height Extent meas vert horiz height width
extentB) ((Ptr a -> IO ()) -> Mosaic pack mirror Upper height a)
-> (Ptr a -> IO ()) -> Mosaic pack mirror Upper height a
forall a b. (a -> b) -> a -> b
$
         \Ptr a
cPtr -> do
      String -> Bool -> IO ()
Call.assert String
"Symmetric.anticommutatorTransposed: extents mismatch"
         (Extent meas vert horiz height width
extentAExtent meas vert horiz height width
-> Extent meas vert horiz height width -> Bool
forall a. Eq a => a -> a -> Bool
==Extent meas vert horiz height width
extentB)
      PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> a
-> ForeignPtr a
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
forall mirror a pack.
(Mirror mirror, Floating a) =>
PackingSingleton pack
-> MirrorSingleton mirror
-> Order
-> a
-> ForeignPtr a
-> ForeignPtr a
-> Ptr a
-> ((Int, Int), (Char, Char, Int))
-> IO ()
scaledAnticommutatorIO PackingSingleton pack
pack (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Order
order a
alpha ForeignPtr a
a ForeignPtr a
b Ptr a
cPtr (((Int, Int), (Char, Char, Int)) -> IO ())
-> ((Int, Int), (Char, Char, Int)) -> IO ()
forall a b. (a -> b) -> a -> b
$
         MirrorSingleton mirror
-> Transposition
-> Order
-> Extent meas vert horiz height width
-> ((Int, Int), (Char, Char, Int))
forall meas vert horiz height width mirror.
(Measure meas, C vert, C horiz, C height, C width) =>
MirrorSingleton mirror
-> Transposition
-> Order
-> Extent meas vert horiz height width
-> ((Int, Int), (Char, Char, Int))
gramianParameters (MirrorSingleton mirror -> MirrorSingleton mirror
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> MirrorSingleton mirror
narrowMirror MirrorSingleton mirror
mirror) Transposition
Transposed Order
order Extent meas vert horiz height width
extentB


congruenceRealDiagonal ::
   (Layout.Packing pack, Mirror mirror,
    Shape.C height, Eq height, Shape.C width, Class.Floating a) =>
   Vector height (RealOf a) ->
   General height width a ->
   Mosaic pack mirror Shape.Upper width a
congruenceRealDiagonal :: Vector height (RealOf a)
-> General height width a -> Mosaic pack mirror Upper width a
congruenceRealDiagonal Vector height (RealOf a)
d =
   ((width -> Unchecked width)
 -> General height width a
 -> Full Size Big Big height (Unchecked width) a)
-> (Full Size Big Big height (Unchecked width) a
    -> Mosaic pack mirror Upper (Unchecked width) a)
-> General height width a
-> Mosaic pack mirror Upper width a
forall sh matrix0 matrix1 pack mirror uplo a.
((sh -> Unchecked sh) -> matrix0 -> matrix1)
-> (matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> matrix0
-> Mosaic pack mirror uplo sh a
skipCheckCongruence (width -> Unchecked width)
-> General height width a
-> Full Size Big Big height (Unchecked width) a
forall vert horiz widthA widthB height a.
(C vert, C horiz) =>
(widthA -> widthB)
-> Full Size vert horiz height widthA a
-> Full Size vert horiz height widthB a
Basic.mapWidth ((Full Size Big Big height (Unchecked width) a
  -> Mosaic pack mirror Upper (Unchecked width) a)
 -> General height width a -> Mosaic pack mirror Upper width a)
-> (Full Size Big Big height (Unchecked width) a
    -> Mosaic pack mirror Upper (Unchecked width) a)
-> General height width a
-> Mosaic pack mirror Upper width a
forall a b. (a -> b) -> a -> b
$ \Full Size Big Big height (Unchecked width) a
a ->
      MirrorSingleton mirror
-> a
-> Full Size Big Big height (Unchecked width) a
-> Full Size Big Big height (Unchecked width) a
-> Mosaic pack mirror Upper (Unchecked width) a
forall pack mirror meas vert horiz height width a.
(Packing pack, Mirror mirror, Measure meas, C vert, C horiz,
 C height, Eq height, C width, Eq width, Floating a) =>
MirrorSingleton mirror
-> a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
-> Mosaic pack mirror Upper width a
scaledAnticommutator MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
Layout.autoMirror a
0.5 Full Size Big Big height (Unchecked width) a
a (Full Size Big Big height (Unchecked width) a
 -> Mosaic pack mirror Upper (Unchecked width) a)
-> Full Size Big Big height (Unchecked width) a
-> Mosaic pack mirror Upper (Unchecked width) a
forall a b. (a -> b) -> a -> b
$
         Vector height (RealOf a)
-> Full Size Big Big height (Unchecked width) a
-> Full Size Big Big height (Unchecked width) a
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, Eq height, C width,
 Floating a) =>
Vector height (RealOf a)
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
Basic.scaleRowsReal Vector height (RealOf a)
d Full Size Big Big height (Unchecked width) a
a

congruenceRealDiagonalTransposed ::
   (Layout.Packing pack, Mirror mirror,
    Shape.C height, Shape.C width, Eq width, Class.Floating a) =>
   General height width a ->
   Vector width (RealOf a) ->
   Mosaic pack mirror Shape.Upper height a
congruenceRealDiagonalTransposed :: General height width a
-> Vector width (RealOf a) -> Mosaic pack mirror Upper height a
congruenceRealDiagonalTransposed =
   (Vector width (RealOf a)
 -> General height width a -> Mosaic pack mirror Upper height a)
-> General height width a
-> Vector width (RealOf a)
-> Mosaic pack mirror Upper height a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Vector width (RealOf a)
  -> General height width a -> Mosaic pack mirror Upper height a)
 -> General height width a
 -> Vector width (RealOf a)
 -> Mosaic pack mirror Upper height a)
-> (Vector width (RealOf a)
    -> General height width a -> Mosaic pack mirror Upper height a)
-> General height width a
-> Vector width (RealOf a)
-> Mosaic pack mirror Upper height a
forall a b. (a -> b) -> a -> b
$ \Vector width (RealOf a)
d -> ((height -> Unchecked height)
 -> General height width a
 -> Full Size Big Big (Unchecked height) width a)
-> (Full Size Big Big (Unchecked height) width a
    -> Mosaic pack mirror Upper (Unchecked height) a)
-> General height width a
-> Mosaic pack mirror Upper height a
forall sh matrix0 matrix1 pack mirror uplo a.
((sh -> Unchecked sh) -> matrix0 -> matrix1)
-> (matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> matrix0
-> Mosaic pack mirror uplo sh a
skipCheckCongruence (height -> Unchecked height)
-> General height width a
-> Full Size Big Big (Unchecked height) width a
forall vert horiz heightA heightB width a.
(C vert, C horiz) =>
(heightA -> heightB)
-> Full Size vert horiz heightA width a
-> Full Size vert horiz heightB width a
Basic.mapHeight ((Full Size Big Big (Unchecked height) width a
  -> Mosaic pack mirror Upper (Unchecked height) a)
 -> General height width a -> Mosaic pack mirror Upper height a)
-> (Full Size Big Big (Unchecked height) width a
    -> Mosaic pack mirror Upper (Unchecked height) a)
-> General height width a
-> Mosaic pack mirror Upper height a
forall a b. (a -> b) -> a -> b
$ \Full Size Big Big (Unchecked height) width a
a ->
      MirrorSingleton mirror
-> a
-> Full Size Big Big (Unchecked height) width a
-> Full Size Big Big (Unchecked height) width a
-> Mosaic pack mirror Upper (Unchecked height) a
forall pack mirror meas vert horiz height width a.
(Packing pack, Mirror mirror, Measure meas, C vert, C horiz,
 C height, Eq height, C width, Eq width, Floating a) =>
MirrorSingleton mirror
-> a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
-> Mosaic pack mirror Upper height a
scaledAnticommutatorTransposed MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
Layout.autoMirror a
0.5 Full Size Big Big (Unchecked height) width a
a (Full Size Big Big (Unchecked height) width a
 -> Mosaic pack mirror Upper (Unchecked height) a)
-> Full Size Big Big (Unchecked height) width a
-> Mosaic pack mirror Upper (Unchecked height) a
forall a b. (a -> b) -> a -> b
$
         Vector width (RealOf a)
-> Full Size Big Big (Unchecked height) width a
-> Full Size Big Big (Unchecked height) width a
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Eq width,
 Floating a) =>
Vector width (RealOf a)
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
Basic.scaleColumnsReal Vector width (RealOf a)
d Full Size Big Big (Unchecked height) width a
a

congruence ::
   (Layout.Packing pack, Mirror mirror,
    Shape.C height, Eq height, Shape.C width, Class.Floating a) =>
   Unpacked.Mosaic mirror Shape.Upper height a ->
   Matrix.General height width a ->
   Mosaic pack mirror Shape.Upper width a
congruence :: Mosaic mirror Upper height a
-> General height width a -> Mosaic pack mirror Upper width a
congruence Mosaic mirror Upper height a
b =
   ((width -> Unchecked width)
 -> General height width a
 -> Full Size Big Big height (Unchecked width) a)
-> (Full Size Big Big height (Unchecked width) a
    -> Mosaic pack mirror Upper (Unchecked width) a)
-> General height width a
-> Mosaic pack mirror Upper width a
forall sh matrix0 matrix1 pack mirror uplo a.
((sh -> Unchecked sh) -> matrix0 -> matrix1)
-> (matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> matrix0
-> Mosaic pack mirror uplo sh a
skipCheckCongruence (width -> Unchecked width)
-> General height width a
-> Full Size Big Big height (Unchecked width) a
forall vert horiz widthA widthB height a.
(C vert, C horiz) =>
(widthA -> widthB)
-> Full Size vert horiz height widthA a
-> Full Size vert horiz height widthB a
Basic.mapWidth ((Full Size Big Big height (Unchecked width) a
  -> Mosaic pack mirror Upper (Unchecked width) a)
 -> General height width a -> Mosaic pack mirror Upper width a)
-> (Full Size Big Big height (Unchecked width) a
    -> Mosaic pack mirror Upper (Unchecked width) a)
-> General height width a
-> Mosaic pack mirror Upper width a
forall a b. (a -> b) -> a -> b
$ \Full Size Big Big height (Unchecked width) a
a ->
      MirrorSingleton mirror
-> a
-> Full Size Big Big height (Unchecked width) a
-> Full Size Big Big height (Unchecked width) a
-> Mosaic pack mirror Upper (Unchecked width) a
forall pack mirror meas vert horiz height width a.
(Packing pack, Mirror mirror, Measure meas, C vert, C horiz,
 C height, Eq height, C width, Eq width, Floating a) =>
MirrorSingleton mirror
-> a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
-> Mosaic pack mirror Upper width a
scaledAnticommutator
         (Mosaic Unpacked mirror Upper height -> MirrorSingleton mirror
forall pack mirror uplo size.
Mosaic pack mirror uplo size -> MirrorSingleton mirror
Layout.mosaicMirror (Mosaic Unpacked mirror Upper height -> MirrorSingleton mirror)
-> Mosaic Unpacked mirror Upper height -> MirrorSingleton mirror
forall a b. (a -> b) -> a -> b
$ Mosaic mirror Upper height a -> Mosaic Unpacked mirror Upper height
forall sh a. Array sh a -> sh
Array.shape Mosaic mirror Upper height a
b) a
forall a. Floating a => a
one Full Size Big Big height (Unchecked width) a
a (Full Size Big Big height (Unchecked width) a
 -> Mosaic pack mirror Upper (Unchecked width) a)
-> Full Size Big Big height (Unchecked width) a
-> Mosaic pack mirror Upper (Unchecked width) a
forall a b. (a -> b) -> a -> b
$
      DiagSingleton Arbitrary
-> Mosaic NoMirror Upper height a
-> Full Size Big Big height (Unchecked width) a
-> Full Size Big Big height (Unchecked width) a
forall uplo diag meas vert horiz height width a mirror.
(UpLo uplo, TriDiag diag, Measure meas, C vert, C horiz, C height,
 Eq height, C width, Floating a) =>
DiagSingleton diag
-> Mosaic mirror uplo height a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
Unpacked.multiplyFull DiagSingleton Arbitrary
Omni.Arbitrary (Mosaic mirror Upper height a -> Mosaic NoMirror Upper height a
forall sh a mirror.
(C sh, Floating a) =>
Mosaic mirror Upper sh a -> Triangular Upper sh a
takeHalf Mosaic mirror Upper height a
b) Full Size Big Big height (Unchecked width) a
a

congruenceTransposed ::
   (Layout.Packing pack, Mirror mirror,
    Shape.C height, Shape.C width, Eq width, Class.Floating a) =>
   Matrix.General height width a ->
   Unpacked.Mosaic mirror Shape.Upper width a ->
   Mosaic pack mirror Shape.Upper height a
congruenceTransposed :: General height width a
-> Mosaic mirror Upper width a -> Mosaic pack mirror Upper height a
congruenceTransposed =
   (Mosaic mirror Upper width a
 -> General height width a -> Mosaic pack mirror Upper height a)
-> General height width a
-> Mosaic mirror Upper width a
-> Mosaic pack mirror Upper height a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Mosaic mirror Upper width a
  -> General height width a -> Mosaic pack mirror Upper height a)
 -> General height width a
 -> Mosaic mirror Upper width a
 -> Mosaic pack mirror Upper height a)
-> (Mosaic mirror Upper width a
    -> General height width a -> Mosaic pack mirror Upper height a)
-> General height width a
-> Mosaic mirror Upper width a
-> Mosaic pack mirror Upper height a
forall a b. (a -> b) -> a -> b
$ \Mosaic mirror Upper width a
b -> ((height -> Unchecked height)
 -> General height width a
 -> Full Size Big Big (Unchecked height) width a)
-> (Full Size Big Big (Unchecked height) width a
    -> Mosaic pack mirror Upper (Unchecked height) a)
-> General height width a
-> Mosaic pack mirror Upper height a
forall sh matrix0 matrix1 pack mirror uplo a.
((sh -> Unchecked sh) -> matrix0 -> matrix1)
-> (matrix1 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> matrix0
-> Mosaic pack mirror uplo sh a
skipCheckCongruence (height -> Unchecked height)
-> General height width a
-> Full Size Big Big (Unchecked height) width a
forall vert horiz heightA heightB width a.
(C vert, C horiz) =>
(heightA -> heightB)
-> Full Size vert horiz heightA width a
-> Full Size vert horiz heightB width a
Basic.mapHeight ((Full Size Big Big (Unchecked height) width a
  -> Mosaic pack mirror Upper (Unchecked height) a)
 -> General height width a -> Mosaic pack mirror Upper height a)
-> (Full Size Big Big (Unchecked height) width a
    -> Mosaic pack mirror Upper (Unchecked height) a)
-> General height width a
-> Mosaic pack mirror Upper height a
forall a b. (a -> b) -> a -> b
$ \Full Size Big Big (Unchecked height) width a
a ->
      MirrorSingleton mirror
-> a
-> Full Size Big Big (Unchecked height) width a
-> Full Size Big Big (Unchecked height) width a
-> Mosaic pack mirror Upper (Unchecked height) a
forall pack mirror meas vert horiz height width a.
(Packing pack, Mirror mirror, Measure meas, C vert, C horiz,
 C height, Eq height, C width, Eq width, Floating a) =>
MirrorSingleton mirror
-> a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
-> Mosaic pack mirror Upper height a
scaledAnticommutatorTransposed
         (Mosaic Unpacked mirror Upper width -> MirrorSingleton mirror
forall pack mirror uplo size.
Mosaic pack mirror uplo size -> MirrorSingleton mirror
Layout.mosaicMirror (Mosaic Unpacked mirror Upper width -> MirrorSingleton mirror)
-> Mosaic Unpacked mirror Upper width -> MirrorSingleton mirror
forall a b. (a -> b) -> a -> b
$ Mosaic mirror Upper width a -> Mosaic Unpacked mirror Upper width
forall sh a. Array sh a -> sh
Array.shape Mosaic mirror Upper width a
b) a
forall a. Floating a => a
one Full Size Big Big (Unchecked height) width a
a (Full Size Big Big (Unchecked height) width a
 -> Mosaic pack mirror Upper (Unchecked height) a)
-> Full Size Big Big (Unchecked height) width a
-> Mosaic pack mirror Upper (Unchecked height) a
forall a b. (a -> b) -> a -> b
$
      (Mosaic Unpacked NoMirror Upper width a
 -> Full Size Big Big width (Unchecked height) a
 -> Full Size Big Big width (Unchecked height) a)
-> Full Size Big Big (Unchecked height) width a
-> Mosaic Unpacked NoMirror Upper width a
-> Full Size Big Big (Unchecked height) width a
forall measA vertA horizA measB vertB horizB matrix widthA heightA
       a widthB heightB.
(Measure measA, C vertA, C horizA, Measure measB, C vertB,
 C horizB) =>
(matrix
 -> Full measA horizA vertA widthA heightA a
 -> Full measB horizB vertB widthB heightB a)
-> Full measA vertA horizA heightA widthA a
-> matrix
-> Full measB vertB horizB heightB widthB a
Basic.swapMultiply
         (DiagSingleton Arbitrary
-> Mosaic NoMirror Lower width a
-> Full Size Big Big width (Unchecked height) a
-> Full Size Big Big width (Unchecked height) a
forall uplo diag meas vert horiz height width a mirror.
(UpLo uplo, TriDiag diag, Measure meas, C vert, C horiz, C height,
 Eq height, C width, Floating a) =>
DiagSingleton diag
-> Mosaic mirror uplo height a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
Unpacked.multiplyFull DiagSingleton Arbitrary
Omni.Arbitrary (Mosaic NoMirror Lower width a
 -> Full Size Big Big width (Unchecked height) a
 -> Full Size Big Big width (Unchecked height) a)
-> (Mosaic Unpacked NoMirror Upper width a
    -> Mosaic NoMirror Lower width a)
-> Mosaic Unpacked NoMirror Upper width a
-> Full Size Big Big width (Unchecked height) a
-> Full Size Big Big width (Unchecked height) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mosaic Unpacked NoMirror Upper width a
-> Mosaic NoMirror Lower width a
forall uplo pack mirror sh a.
UpLo uplo =>
Mosaic pack mirror uplo sh a
-> Mosaic pack mirror (TriTransposed uplo) sh a
Mosaic.transpose)
         Full Size Big Big (Unchecked height) width a
a (Mosaic mirror Upper width a
-> Mosaic Unpacked NoMirror Upper width a
forall sh a mirror.
(C sh, Floating a) =>
Mosaic mirror Upper sh a -> Triangular Upper sh a
takeHalf Mosaic mirror Upper width a
b)


solve ::
   (Mirror mirror, Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Eq height, Shape.C height, Shape.C width, Class.Floating a) =>
   Mosaic pack mirror Shape.Upper height a ->
   Full meas vert horiz height width a ->
   Full meas vert horiz height width a
solve :: Mosaic pack mirror Upper height a
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
solve (Array shape :: Mosaic pack mirror Upper height
shape@(Layout.Mosaic PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton Upper
_upper Order
order height
sh) ForeignPtr a
a) =
   String
-> height
-> (Int
    -> Ptr CInt -> Ptr CInt -> Ptr a -> Ptr CInt -> ContT () IO ())
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Eq height,
 Floating a) =>
String
-> height
-> (Int
    -> Ptr CInt -> Ptr CInt -> Ptr a -> Ptr CInt -> ContT () IO ())
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
solver (MirrorSingleton mirror -> String
forall a. Show a => a -> String
show MirrorSingleton mirror
mirror) height
sh ((Int
  -> Ptr CInt -> Ptr CInt -> Ptr a -> Ptr CInt -> ContT () IO ())
 -> Full meas vert horiz height width a
 -> Full meas vert horiz height width a)
-> (Int
    -> Ptr CInt -> Ptr CInt -> Ptr a -> Ptr CInt -> ContT () IO ())
-> Full meas vert horiz height width a
-> Full meas vert horiz height width a
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr CInt
nPtr Ptr CInt
nrhsPtr Ptr a
xPtr Ptr CInt
ldxPtr -> do
      Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
order
      let conj :: Conjugation
conj = MirrorSingleton mirror -> Conjugation
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> Conjugation
conjugationFromMirror MirrorSingleton mirror
mirror
      Ptr a
aPtr <- Conjugation -> Order -> Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r.
Floating a =>
Conjugation -> Order -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyTriangleToTemp Conjugation
conj Order
order (Mosaic pack mirror Upper height -> Int
forall sh. C sh => sh -> Int
Shape.size Mosaic pack mirror Upper height
shape) ForeignPtr a
a
      Ptr CInt
ipivPtr <- Int -> FortranIO () (Ptr CInt)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray Int
n
      String
-> PackingSingleton pack
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> ContT () IO ()
forall func pack r.
(func ~ (Ptr CInt -> IO ())) =>
String
-> PackingSingleton pack
-> Labelled2 r String func func
-> ContT r IO ()
withPackingLinear String
diagonalMsg PackingSingleton pack
pack (Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
 -> ContT () IO ())
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ((Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> Ptr CInt -> IO ())
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> Ptr CInt -> IO ()
forall a info.
Floating a =>
(Ptr a -> Ptr CInt -> info -> IO ()) -> info -> IO ()
autoWorkspace (Labelled2
   ()
   String
   (Ptr CInt -> IO ())
   (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
 -> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ()))
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall a b. (a -> b) -> a -> b
$
         (Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
 -> Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> IO ())
 -> Ptr CChar
 -> Ptr CInt
 -> Ptr CInt
 -> TriArg a
 -> Ptr CInt
 -> Ptr a
 -> Ptr CInt
 -> Labelled2
      ()
      String
      (Ptr CInt -> IO ())
      (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()))
-> (Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> IO ()),
    Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> IO ()))
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> TriArg a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Labelled
  ()
  String
  (Ptr CChar
   -> Ptr CInt
   -> Ptr CInt
   -> Ptr a
   -> Ptr CInt
   -> Ptr a
   -> Ptr CInt
   -> Ptr CInt
   -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> TriArg a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair
            (case Conjugation
conj of
               Conjugation
Conjugated ->
                  (String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hpsv" Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.hpsv, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hesv" Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.hesv)
               Conjugation
NonConjugated ->
                  (String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"spsv" Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.spsv, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"sysv" Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.sysv))
            Ptr CChar
uploPtr Ptr CInt
nPtr Ptr CInt
nrhsPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
aPtr Int
n) Ptr CInt
ipivPtr Ptr a
xPtr Ptr CInt
ldxPtr


inverse ::
   (Mirror mirror, Layout.UpLo uplo, Shape.C sh, Class.Floating a) =>
   Mosaic pack mirror uplo sh a ->
   Mosaic pack mirror uplo sh a
inverse :: Mosaic pack mirror uplo sh a -> Mosaic pack mirror uplo sh a
inverse (Array shape :: Mosaic pack mirror uplo sh
shape@(Layout.Mosaic PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order sh
sh) ForeignPtr a
a) =
   Mosaic pack mirror uplo sh
-> (Int -> Ptr a -> IO ()) -> Mosaic pack mirror uplo sh a
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize Mosaic pack mirror uplo sh
shape ((Int -> Ptr a -> IO ()) -> Mosaic pack mirror uplo sh a)
-> (Int -> Ptr a -> IO ()) -> Mosaic pack mirror uplo sh a
forall a b. (a -> b) -> a -> b
$ \Int
triSize Ptr a
bPtr -> 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

   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
   let realOrder :: Order
realOrder = UpLoSingleton uplo -> Order -> Order
forall uplo. UpLoSingleton uplo -> Order -> Order
uploOrder UpLoSingleton uplo
uplo Order
order
   Ptr CChar
uploPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
realOrder
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr a
aPtr <- ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a))
-> ((Ptr a -> IO ()) -> IO ()) -> ContT () IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
   Ptr CInt
ipivPtr <- Int -> FortranIO () (Ptr CInt)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray Int
n
   IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock Int
triSize Ptr a
aPtr Ptr a
bPtr
   let conj :: Conjugation
conj = MirrorSingleton mirror -> Conjugation
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> Conjugation
conjugationFromMirror MirrorSingleton mirror
mirror
   let ((Labelled
   ()
   String
   (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()),
 Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ()))
trf,(Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()),
 Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> IO ()))
tri) =
         case Conjugation
conj of
            Conjugation
Conjugated ->
               ((String
-> (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hptrf" Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
LapackGen.hptrf, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hetrf" Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.hetrf),
                (String
-> (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hptri" Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
LapackGen.hptri, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hetri" Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
LapackGen.hetri))
            Conjugation
NonConjugated ->
               ((String
-> (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"sptrf" Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
LapackGen.sptrf, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"sytrf" Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.sytrf),
                (String
-> (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"sptri" Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()
LapackGen.sptri, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"sytri" Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
LapackGen.sytri))
   String
-> PackingSingleton pack
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> ContT () IO ()
forall func pack r.
(func ~ (Ptr CInt -> IO ())) =>
String
-> PackingSingleton pack
-> Labelled2 r String func func
-> ContT r IO ()
withPackingLinear String
diagonalMsg PackingSingleton pack
pack (Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
 -> ContT () IO ())
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ((Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> Ptr CInt -> IO ())
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> Ptr CInt -> IO ()
forall a info.
Floating a =>
(Ptr a -> Ptr CInt -> info -> IO ()) -> info -> IO ()
autoWorkspace (Labelled2
   ()
   String
   (Ptr CInt -> IO ())
   (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
 -> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ()))
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall a b. (a -> b) -> a -> b
$
      (Labelled
   ()
   String
   (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
 -> Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> IO ())
 -> Ptr CChar
 -> Ptr CInt
 -> TriArg a
 -> Ptr CInt
 -> Labelled2
      ()
      String
      (Ptr CInt -> IO ())
      (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()))
-> (Labelled
      ()
      String
      (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()),
    Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> IO ()))
-> Ptr CChar
-> Ptr CInt
-> TriArg a
-> Ptr CInt
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Labelled
  ()
  String
  (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
-> Ptr CChar
-> Ptr CInt
-> TriArg a
-> Ptr CInt
-> Labelled2
     ()
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair (Labelled
   ()
   String
   (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()),
 Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ()))
trf Ptr CChar
uploPtr Ptr CInt
nPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
bPtr Int
n) Ptr CInt
ipivPtr
   Ptr a
workPtr <- Int -> ContT () IO (Ptr a)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray Int
n
   String
-> PackingSingleton pack
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> ContT () IO ()
forall func pack r.
(func ~ (Ptr CInt -> IO ())) =>
String
-> PackingSingleton pack
-> Labelled2 r String func func
-> ContT r IO ()
withPackingLinear String
diagonalMsg PackingSingleton pack
pack (Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
 -> ContT () IO ())
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
      (Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ())
 -> Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> IO ())
 -> Ptr CChar
 -> Ptr CInt
 -> TriArg a
 -> Ptr CInt
 -> Ptr a
 -> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ()))
-> (Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()),
    Labelled
      ()
      String
      (Ptr CChar
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> Ptr CInt
       -> Ptr a
       -> Ptr CInt
       -> IO ()))
-> Ptr CChar
-> Ptr CInt
-> TriArg a
-> Ptr CInt
-> Ptr a
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Labelled
  ()
  String
  (Ptr CChar
   -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ())
-> Labelled
     ()
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> IO ())
-> Ptr CChar
-> Ptr CInt
-> TriArg a
-> Ptr CInt
-> Ptr a
-> Labelled2 () String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair (Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> IO ()),
 Labelled
   ()
   String
   (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> IO ()))
tri Ptr CChar
uploPtr Ptr CInt
nPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
bPtr Int
n) Ptr CInt
ipivPtr Ptr a
workPtr
   IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ 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
conj Order
realOrder Int
n Ptr a
bPtr


blockDiagonalPointers ::
   (Storable a) =>
   Order -> [(Ptr CInt, Ptr a)] -> LazyIO.T [(Ptr a, Maybe (Ptr a, Ptr a))]
blockDiagonalPointers :: Order -> [(Ptr CInt, Ptr a)] -> T [(Ptr a, Maybe (Ptr a, Ptr a))]
blockDiagonalPointers Order
order =
   let go :: [(Ptr CInt, Ptr a)] -> T [(Ptr a, Maybe (Ptr a, Ptr a))]
go ((Ptr CInt
ipiv0Ptr,Ptr a
a0Ptr):[(Ptr CInt, Ptr a)]
ptrs0) = do
         CInt
ipiv <- IO CInt -> T CInt
forall a. IO a -> T a
LazyIO.interleave (IO CInt -> T CInt) -> IO CInt -> T CInt
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ipiv0Ptr
         (Maybe (Ptr a, Ptr a)
ext,[(Ptr a, Maybe (Ptr a, Ptr a))]
ptrTuples) <-
            if CInt
ipiv CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
0
               then (,) Maybe (Ptr a, Ptr a)
forall a. Maybe a
Nothing ([(Ptr a, Maybe (Ptr a, Ptr a))]
 -> (Maybe (Ptr a, Ptr a), [(Ptr a, Maybe (Ptr a, Ptr a))]))
-> T [(Ptr a, Maybe (Ptr a, Ptr a))]
-> T (Maybe (Ptr a, Ptr a), [(Ptr a, Maybe (Ptr a, Ptr a))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Ptr CInt, Ptr a)] -> T [(Ptr a, Maybe (Ptr a, Ptr a))]
go [(Ptr CInt, Ptr a)]
ptrs0
               else
                  case [(Ptr CInt, Ptr a)]
ptrs0 of
                     [] -> String -> T (Maybe (Ptr a, Ptr a), [(Ptr a, Maybe (Ptr a, Ptr a))])
forall a. HasCallStack => String -> a
error String
"Symmetric.determinant: incomplete 2x2 block"
                     (Ptr CInt
_ipiv1Ptr,Ptr a
a1Ptr):[(Ptr CInt, Ptr a)]
ptrs1 ->
                        let bPtr :: Ptr a
bPtr =
                              case Order
order of
                                 Order
ColumnMajor -> Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
a1Ptr (-Int
1)
                                 Order
RowMajor -> Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
a0Ptr Int
1
                        in (,) ((Ptr a, Ptr a) -> Maybe (Ptr a, Ptr a)
forall a. a -> Maybe a
Just (Ptr a
a1Ptr,Ptr a
bPtr)) ([(Ptr a, Maybe (Ptr a, Ptr a))]
 -> (Maybe (Ptr a, Ptr a), [(Ptr a, Maybe (Ptr a, Ptr a))]))
-> T [(Ptr a, Maybe (Ptr a, Ptr a))]
-> T (Maybe (Ptr a, Ptr a), [(Ptr a, Maybe (Ptr a, Ptr a))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Ptr CInt, Ptr a)] -> T [(Ptr a, Maybe (Ptr a, Ptr a))]
go [(Ptr CInt, Ptr a)]
ptrs1
         [(Ptr a, Maybe (Ptr a, Ptr a))]
-> T [(Ptr a, Maybe (Ptr a, Ptr a))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Ptr a, Maybe (Ptr a, Ptr a))]
 -> T [(Ptr a, Maybe (Ptr a, Ptr a))])
-> [(Ptr a, Maybe (Ptr a, Ptr a))]
-> T [(Ptr a, Maybe (Ptr a, Ptr a))]
forall a b. (a -> b) -> a -> b
$ (Ptr a
a0Ptr,Maybe (Ptr a, Ptr a)
ext) (Ptr a, Maybe (Ptr a, Ptr a))
-> [(Ptr a, Maybe (Ptr a, Ptr a))]
-> [(Ptr a, Maybe (Ptr a, Ptr a))]
forall a. a -> [a] -> [a]
: [(Ptr a, Maybe (Ptr a, Ptr a))]
ptrTuples
       go [] = [(Ptr a, Maybe (Ptr a, Ptr a))]
-> T [(Ptr a, Maybe (Ptr a, Ptr a))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
   in [(Ptr CInt, Ptr a)] -> T [(Ptr a, Maybe (Ptr a, Ptr a))]
go

determinant ::
   (Mirror mirror, Layout.UpLo uplo,
    Shape.C sh, Class.Floating a, Class.Floating ar) =>
   ((Ptr a, Maybe (Ptr a, Ptr a)) -> IO ar) ->
   Mosaic pack mirror uplo sh a -> ar
determinant :: ((Ptr a, Maybe (Ptr a, Ptr a)) -> IO ar)
-> Mosaic pack mirror uplo sh a -> ar
determinant (Ptr a, Maybe (Ptr a, Ptr a)) -> IO ar
peekBlockDeterminant
   (Array shape :: Mosaic pack mirror uplo sh
shape@(Layout.Mosaic PackingSingleton pack
pack MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order sh
sh) ForeignPtr a
a) =
      IO ar -> ar
forall a. IO a -> a
unsafePerformIO (IO ar -> ar) -> IO ar -> ar
forall a b. (a -> b) -> a -> b
$ ContT ar IO ar -> IO ar
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ar IO ar -> IO ar) -> ContT ar IO ar -> IO ar
forall a b. (a -> b) -> a -> b
$ do

   let conj :: Conjugation
conj = MirrorSingleton mirror -> Conjugation
forall mirror (f :: * -> *).
Mirror mirror =>
f mirror -> Conjugation
conjugationFromMirror MirrorSingleton mirror
mirror
   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
   Ptr CChar
uploPtr <- Char -> FortranIO ar (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char (Char -> FortranIO ar (Ptr CChar))
-> Char -> FortranIO ar (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder (Order -> Char) -> Order -> Char
forall a b. (a -> b) -> a -> b
$ UpLoSingleton uplo -> Order -> Order
forall uplo. UpLoSingleton uplo -> Order -> Order
uploOrder UpLoSingleton uplo
uplo Order
order
   Ptr CInt
nPtr <- Int -> FortranIO ar (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr a
aPtr <- Int -> ForeignPtr a -> ContT ar IO (Ptr a)
forall a r. Storable a => Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyToTemp (Mosaic pack mirror uplo sh -> Int
forall sh. C sh => sh -> Int
Shape.size Mosaic pack mirror uplo sh
shape) ForeignPtr a
a
   Ptr CInt
ipivPtr <- Int -> FortranIO ar (Ptr CInt)
forall a r. Storable a => Int -> FortranIO r (Ptr a)
Call.allocaArray Int
n
   let diagPtrs :: [Ptr a]
diagPtrs =
         case PackingSingleton pack
pack of
            PackingSingleton pack
Layout.Packed -> Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order Int
n Ptr a
aPtr
            PackingSingleton pack
Layout.Unpacked -> Int -> [Ptr a] -> [Ptr a]
forall a. Int -> [a] -> [a]
take Int
n ([Ptr a] -> [Ptr a]) -> [Ptr a] -> [Ptr a]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr a -> [Ptr a]
forall a. Storable a => Int -> Ptr a -> [Ptr a]
pointerSeq (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr a
aPtr
   let (Labelled
  ar
  String
  (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
utrf,Labelled
  ar
  String
  (Ptr CChar
   -> Ptr CInt
   -> Ptr a
   -> Ptr CInt
   -> Ptr CInt
   -> Ptr a
   -> Ptr CInt
   -> Ptr CInt
   -> IO ())
ptrf) =
         case Conjugation
conj of
            Conjugation
Conjugated ->
               (String
-> (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled
     ar
     String
     (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hptrf" Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
LapackGen.hptrf, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ar
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"hetrf" Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.hetrf)
            Conjugation
NonConjugated ->
               (String
-> (Ptr CChar
    -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled
     ar
     String
     (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"sptrf" Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
LapackGen.sptrf, String
-> (Ptr CChar
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> Ptr a
    -> Ptr CInt
    -> Ptr CInt
    -> IO ())
-> Labelled
     ar
     String
     (Ptr CChar
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> Ptr a
      -> Ptr CInt
      -> Ptr CInt
      -> IO ())
forall label a r. label -> a -> Labelled r label a
label String
"sytrf" Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackGen.sytrf)
   let Labelled String
name ContT ar IO (Ptr CInt -> IO ())
makeTrf =
         PackingSingleton pack
-> Labelled2 ar String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> Labelled ar String (Ptr CInt -> IO ())
forall pack r label func.
PackingSingleton pack
-> Labelled2 r label func func -> Labelled r label func
runPacking PackingSingleton pack
pack (Labelled2 ar String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
 -> Labelled ar String (Ptr CInt -> IO ()))
-> Labelled2 ar String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> Labelled ar String (Ptr CInt -> IO ())
forall a b. (a -> b) -> a -> b
$ ((Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> Ptr CInt -> IO ())
-> Labelled2
     ar
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled2 ar String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> Ptr CInt -> IO ()
forall a info.
Floating a =>
(Ptr a -> Ptr CInt -> info -> IO ()) -> info -> IO ()
autoWorkspace (Labelled2
   ar
   String
   (Ptr CInt -> IO ())
   (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
 -> Labelled2 ar String (Ptr CInt -> IO ()) (Ptr CInt -> IO ()))
-> Labelled2
     ar
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> Labelled2 ar String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
forall a b. (a -> b) -> a -> b
$
         Labelled
  ar
  String
  (FuncPacked
     (Ptr CChar
      -> Ptr CInt
      -> TriArg a
      -> Ptr CInt
      -> Labelled2
           ar
           String
           (Ptr CInt -> IO ())
           (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())))
-> Labelled
     ar
     String
     (FuncUnpacked
        (Ptr CChar
         -> Ptr CInt
         -> TriArg a
         -> Ptr CInt
         -> Labelled2
              ar
              String
              (Ptr CInt -> IO ())
              (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())))
-> Ptr CChar
-> Ptr CInt
-> TriArg a
-> Ptr CInt
-> Labelled2
     ar
     String
     (Ptr CInt -> IO ())
     (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
forall (m :: * -> *) f.
(m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair Labelled
  ar
  String
  (FuncPacked
     (Ptr CChar
      -> Ptr CInt
      -> TriArg a
      -> Ptr CInt
      -> Labelled2
           ar
           String
           (Ptr CInt -> IO ())
           (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())))
Labelled
  ar
  String
  (Ptr CChar -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
utrf Labelled
  ar
  String
  (FuncUnpacked
     (Ptr CChar
      -> Ptr CInt
      -> TriArg a
      -> Ptr CInt
      -> Labelled2
           ar
           String
           (Ptr CInt -> IO ())
           (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())))
Labelled
  ar
  String
  (Ptr CChar
   -> Ptr CInt
   -> Ptr a
   -> Ptr CInt
   -> Ptr CInt
   -> Ptr a
   -> Ptr CInt
   -> Ptr CInt
   -> IO ())
ptrf Ptr CChar
uploPtr Ptr CInt
nPtr (Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
triArg Ptr a
aPtr Int
n) Ptr CInt
ipivPtr
   Ptr CInt -> IO ()
trf <- ContT ar IO (Ptr CInt -> IO ())
makeTrf
   IO ar -> ContT ar IO ar
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ar -> ContT ar IO ar) -> IO ar -> ContT ar IO ar
forall a b. (a -> b) -> a -> b
$
      String -> (Ptr CInt -> IO ()) -> IO ar -> IO ar
forall a.
Floating a =>
String -> (Ptr CInt -> IO ()) -> IO a -> IO a
withDeterminantInfo String
name Ptr CInt -> IO ()
trf
         ((ar -> IO ar
forall (m :: * -> *) a. Monad m => a -> m a
return (ar -> IO ar) -> ar -> IO ar
forall a b. (a -> b) -> a -> b
$!) (ar -> IO ar) -> IO ar -> IO ar
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          T ar -> IO ar
forall a. T a -> IO a
LazyIO.run
            (([ar] -> ar) -> T [ar] -> T ar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ar] -> ar
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (T [ar] -> T ar) -> T [ar] -> T ar
forall a b. (a -> b) -> a -> b
$
             ((Ptr a, Maybe (Ptr a, Ptr a)) -> T ar)
-> [(Ptr a, Maybe (Ptr a, Ptr a))] -> T [ar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IO ar -> T ar
forall a. IO a -> T a
LazyIO.interleave (IO ar -> T ar)
-> ((Ptr a, Maybe (Ptr a, Ptr a)) -> IO ar)
-> (Ptr a, Maybe (Ptr a, Ptr a))
-> T ar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr a, Maybe (Ptr a, Ptr a)) -> IO ar
peekBlockDeterminant) ([(Ptr a, Maybe (Ptr a, Ptr a))] -> T [ar])
-> T [(Ptr a, Maybe (Ptr a, Ptr a))] -> T [ar]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
             Order -> [(Ptr CInt, Ptr a)] -> T [(Ptr a, Maybe (Ptr a, Ptr a))]
forall a.
Storable a =>
Order -> [(Ptr CInt, Ptr a)] -> T [(Ptr a, Maybe (Ptr a, Ptr a))]
blockDiagonalPointers Order
order ([Ptr CInt] -> [Ptr a] -> [(Ptr CInt, Ptr a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Ptr CInt -> [Ptr CInt]
forall a. Storable a => Int -> Ptr a -> [Ptr a]
pointerSeq Int
1 Ptr CInt
ipivPtr) [Ptr a]
diagPtrs)))

autoWorkspace ::
   (Class.Floating a) => (Ptr a -> Ptr CInt -> info -> IO ()) -> info -> IO ()
autoWorkspace :: (Ptr a -> Ptr CInt -> info -> IO ()) -> info -> IO ()
autoWorkspace Ptr a -> Ptr CInt -> info -> IO ()
trf info
info =
   (Ptr a -> Ptr CInt -> IO ()) -> IO ()
forall a. Floating a => (Ptr a -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspace ((Ptr a -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr a -> Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
work Ptr CInt
lwork -> Ptr a -> Ptr CInt -> info -> IO ()
trf Ptr a
work Ptr CInt
lwork info
info