{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
module Numeric.LAPACK.Matrix.Mosaic.Private where

import qualified Numeric.LAPACK.Matrix.Private as Matrix
import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import Numeric.LAPACK.Matrix.Layout.Private
         (Order(RowMajor,ColumnMajor), flipOrder, uploFromOrder)
import Numeric.LAPACK.Matrix.Modifier (Conjugation(NonConjugated))
import Numeric.LAPACK.Matrix.Private (Full)
import Numeric.LAPACK.Scalar (zero)
import Numeric.LAPACK.Shape.Private (Unchecked(Unchecked))
import Numeric.LAPACK.Private
         (pointerSeq, copyBlock, copyCondConjugateToTemp,
          pokeCInt, fill, withAutoWorkspaceInfo, withInfo, errorCodeMsg)

import qualified Numeric.LAPACK.FFI.Generic as LapackGen
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 Data.Array.Comfort.Shape ((::+)((::+)))

import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (advancePtr)
import Foreign.C.Types (CInt)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable)

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

import Data.Foldable (forM_)


type Mosaic pack mirror uplo sh = Array (Layout.Mosaic pack mirror uplo sh)
type MosaicPacked mirror uplo sh = Mosaic Layout.Packed mirror uplo sh
type MosaicUnpacked mirror uplo sh = Mosaic Layout.Unpacked mirror uplo sh

type MosaicLower mirror sh = MosaicPacked mirror Shape.Lower sh
type MosaicUpper mirror sh = MosaicPacked mirror Shape.Upper sh


diagonalPointers :: (Storable a) => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers :: Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order Int
n Ptr a
aPtr =
   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
$ (Ptr a -> Int -> Ptr a) -> Ptr a -> [Int] -> [Ptr a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
aPtr ([Int] -> [Ptr a]) -> [Int] -> [Ptr a]
forall a b. (a -> b) -> a -> b
$
   case Order
order of
      Order
RowMajor -> (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
pred Int
n
      Order
ColumnMajor -> (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
succ Int
2

diagonalPointerPairs ::
   (Storable a, Storable b) =>
   Order -> Int -> Ptr a -> Ptr b -> [(Ptr a, Ptr b)]
diagonalPointerPairs :: Order -> Int -> Ptr a -> Ptr b -> [(Ptr a, Ptr b)]
diagonalPointerPairs Order
order Int
n Ptr a
aPtr Ptr b
bPtr =
   [Ptr a] -> [Ptr b] -> [(Ptr a, Ptr b)]
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) ([Ptr b] -> [(Ptr a, Ptr b)]) -> [Ptr b] -> [(Ptr a, Ptr b)]
forall a b. (a -> b) -> a -> b
$ Order -> Int -> Ptr b -> [Ptr b]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order Int
n Ptr b
bPtr


columnMajorPointers ::
   (Storable a) => Int -> Ptr a -> Ptr a -> [(Int, ((Ptr a, Ptr a), Ptr a))]
columnMajorPointers :: Int -> Ptr a -> Ptr a -> [(Int, ((Ptr a, Ptr a), Ptr a))]
columnMajorPointers Int
n Ptr a
fullPtr Ptr a
packedPtr =
   let ds :: [Int]
ds = (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
succ Int
1
   in  Int
-> [(Int, ((Ptr a, Ptr a), Ptr a))]
-> [(Int, ((Ptr a, Ptr a), Ptr a))]
forall a. Int -> [a] -> [a]
take Int
n ([(Int, ((Ptr a, Ptr a), Ptr a))]
 -> [(Int, ((Ptr a, Ptr a), Ptr a))])
-> [(Int, ((Ptr a, Ptr a), Ptr a))]
-> [(Int, ((Ptr a, Ptr a), Ptr a))]
forall a b. (a -> b) -> a -> b
$ [Int]
-> [((Ptr a, Ptr a), Ptr a)] -> [(Int, ((Ptr a, Ptr a), Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ds ([((Ptr a, Ptr a), Ptr a)] -> [(Int, ((Ptr a, Ptr a), Ptr a))])
-> [((Ptr a, Ptr a), Ptr a)] -> [(Int, ((Ptr a, Ptr a), Ptr a))]
forall a b. (a -> b) -> a -> b
$
       [(Ptr a, Ptr a)] -> [Ptr a] -> [((Ptr a, Ptr a), Ptr a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
         ([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
fullPtr) (Int -> Ptr a -> [Ptr a]
forall a. Storable a => Int -> Ptr a -> [Ptr a]
pointerSeq Int
n Ptr a
fullPtr))
         ((Ptr a -> Int -> Ptr a) -> Ptr a -> [Int] -> [Ptr a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
packedPtr [Int]
ds)

rowMajorPointers ::
   (Storable a) => Int -> Ptr a -> Ptr a -> [(Int, (Ptr a, Ptr a))]
rowMajorPointers :: Int -> Ptr a -> Ptr a -> [(Int, (Ptr a, Ptr a))]
rowMajorPointers Int
n Ptr a
fullPtr Ptr a
packedPtr =
   let ds :: [Int]
ds = (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
pred Int
n
   in  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))])
-> [(Int, (Ptr a, Ptr a))] -> [(Int, (Ptr a, Ptr a))]
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ds ([(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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr a
fullPtr) ((Ptr a -> Int -> Ptr a) -> Ptr a -> [Int] -> [Ptr a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
packedPtr [Int]
ds)


forPointers :: [(Int, a)] -> (Ptr CInt -> a -> IO ()) -> IO ()
forPointers :: [(Int, a)] -> (Ptr CInt -> a -> IO ()) -> IO ()
forPointers [(Int, a)]
xs Ptr CInt -> a -> IO ()
act =
   (Ptr CInt -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
nPtr ->
   [(Int, a)] -> ((Int, a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, a)]
xs (((Int, a) -> IO ()) -> IO ()) -> ((Int, a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
d,a
ptrs) -> do
      Ptr CInt -> Int -> IO ()
pokeCInt Ptr CInt
nPtr Int
d
      Ptr CInt -> a -> IO ()
act Ptr CInt
nPtr a
ptrs


copyTriangleToTemp ::
   Class.Floating a =>
   Conjugation -> Order -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyTriangleToTemp :: Conjugation -> Order -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyTriangleToTemp Conjugation
conj Order
order =
   Conjugation -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
forall a r.
Floating a =>
Conjugation -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyCondConjugateToTemp (Conjugation -> Int -> ForeignPtr a -> ContT r IO (Ptr a))
-> Conjugation -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
forall a b. (a -> b) -> a -> b
$
   case Order
order of
      Order
RowMajor -> Conjugation
conj
      Order
ColumnMajor -> Conjugation
NonConjugated


unpackToTemp ::
   Storable a =>
   (Int -> Ptr a -> Ptr a -> IO ()) ->
   Int -> ForeignPtr a -> ContT r IO (Ptr a)
unpackToTemp :: (Int -> Ptr a -> Ptr a -> IO ())
-> Int -> ForeignPtr a -> ContT r IO (Ptr a)
unpackToTemp Int -> Ptr a -> Ptr a -> IO ()
f Int
n ForeignPtr a
a = do
   Ptr a
apPtr <- ((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a))
-> ((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO r) -> IO r
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
a
   Ptr a
aPtr <- Int -> ContT r 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 r IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ()) -> IO () -> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Ptr a -> Ptr a -> IO ()
f Int
n Ptr a
apPtr Ptr a
aPtr
   Ptr a -> ContT r IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
aPtr


unpack :: Class.Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
unpack :: Order -> Int -> Ptr a -> Ptr a -> IO ()
unpack Order
order Int
n Ptr a
packedPtr Ptr a
fullPtr =
   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 -> FortranIO () (Ptr CChar))
-> Char -> FortranIO () (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Order -> Char
uploFromOrder Order
order
      Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
      Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim 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
$ String -> String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
errorCodeMsg String
"tpttr" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr CInt -> IO ()
LapackGen.tpttr Ptr CChar
uploPtr Ptr CInt
nPtr Ptr a
packedPtr Ptr a
fullPtr Ptr CInt
ldaPtr

pack :: Class.Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
pack :: Order -> Int -> Ptr a -> Ptr a -> IO ()
pack Order
order Int
n = Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
packRect Order
order Int
n Int
n

packRect :: Class.Floating a => Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
packRect :: Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
packRect Order
order Int
n Int
ld Ptr a
fullPtr Ptr a
packedPtr =
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr 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
      Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
      Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
ld
      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
$ String -> String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
errorCodeMsg String
"trttp" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
         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.trttp Ptr CChar
uploPtr Ptr CInt
nPtr Ptr a
fullPtr Ptr CInt
ldaPtr Ptr a
packedPtr


unpackZero, _unpackZero ::
   Class.Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
_unpackZero :: Order -> Int -> Ptr a -> Ptr a -> IO ()
_unpackZero Order
order Int
n Ptr a
packedPtr Ptr a
fullPtr = do
   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
fullPtr
   Order -> Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
unpack Order
order Int
n Ptr a
packedPtr Ptr a
fullPtr

unpackZero :: Order -> Int -> Ptr a -> Ptr a -> IO ()
unpackZero Order
order Int
n Ptr a
packedPtr Ptr a
fullPtr = do
   a -> Order -> Int -> Ptr a -> IO ()
forall a. Floating a => a -> Order -> Int -> Ptr a -> IO ()
fillTriangle a
forall a. Floating a => a
zero (Order -> Order
flipOrder Order
order) Int
n Ptr a
fullPtr
   Order -> Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Order -> Int -> Ptr a -> Ptr a -> IO ()
unpack Order
order Int
n Ptr a
packedPtr Ptr a
fullPtr

fillTriangle :: Class.Floating a => a -> Order -> Int -> Ptr a -> IO ()
fillTriangle :: a -> Order -> Int -> Ptr a -> IO ()
fillTriangle a
z Order
order Int
n Ptr a
aPtr = ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   Ptr 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
   Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
   Ptr a
zPtr <- a -> FortranIO () (Ptr a)
forall a r. Floating a => a -> FortranIO r (Ptr a)
Call.number a
z
   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 CInt
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Floating a =>
Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr a
-> Ptr CInt
-> IO ()
LapackGen.laset Ptr CChar
uploPtr Ptr CInt
nPtr Ptr CInt
nPtr Ptr a
zPtr Ptr a
zPtr Ptr a
aPtr Ptr CInt
nPtr



uncheck ::
   Mosaic pack mirror uplo sh a -> Mosaic pack mirror uplo (Unchecked sh) a
uncheck :: Mosaic pack mirror uplo sh a
-> Mosaic pack mirror uplo (Unchecked sh) a
uncheck =
   (Mosaic pack mirror uplo sh
 -> Mosaic pack mirror uplo (Unchecked sh))
-> Mosaic pack mirror uplo sh a
-> Mosaic pack mirror uplo (Unchecked sh) a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape ((Mosaic pack mirror uplo sh
  -> Mosaic pack mirror uplo (Unchecked sh))
 -> Mosaic pack mirror uplo sh a
 -> Mosaic pack mirror uplo (Unchecked sh) a)
-> (Mosaic pack mirror uplo sh
    -> Mosaic pack mirror uplo (Unchecked sh))
-> Mosaic pack mirror uplo sh a
-> Mosaic pack mirror uplo (Unchecked sh) a
forall a b. (a -> b) -> a -> b
$
      \(Layout.Mosaic PackingSingleton pack
packing MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order sh
sh) ->
         PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> Unchecked sh
-> Mosaic pack mirror uplo (Unchecked sh)
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton pack
packing MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order (sh -> Unchecked sh
forall sh. sh -> Unchecked sh
Unchecked sh
sh)

recheck ::
   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
recheck =
   (Mosaic pack mirror uplo (Unchecked sh)
 -> Mosaic pack mirror uplo sh)
-> Mosaic pack mirror uplo (Unchecked sh) a
-> Mosaic pack mirror uplo sh a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape ((Mosaic pack mirror uplo (Unchecked sh)
  -> Mosaic pack mirror uplo sh)
 -> Mosaic pack mirror uplo (Unchecked sh) a
 -> Mosaic pack mirror uplo sh a)
-> (Mosaic pack mirror uplo (Unchecked sh)
    -> Mosaic pack mirror uplo sh)
-> Mosaic pack mirror uplo (Unchecked sh) a
-> Mosaic pack mirror uplo sh a
forall a b. (a -> b) -> a -> b
$
      \(Layout.Mosaic PackingSingleton pack
packing MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order (Unchecked sh
sh)) ->
         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
packing MirrorSingleton mirror
mirror UpLoSingleton uplo
uplo Order
order sh
sh


stack ::
   (Shape.C height, Eq height, Shape.C width, Eq width, Class.Floating a) =>
   MosaicUpper mirror height a ->
   Matrix.General height width a ->
   MosaicUpper mirror width a ->
   MosaicUpper mirror (height::+width) a
stack :: MosaicUpper mirror height a
-> General height width a
-> MosaicUpper mirror width a
-> MosaicUpper mirror (height ::+ width) a
stack (Array Mosaic Packed mirror Upper height
sha ForeignPtr a
a) (Array (Layout.Full Order
order Extent Size Big Big height width
extent) ForeignPtr a
b) (Array Mosaic Packed mirror Upper width
shc ForeignPtr a
c) =
   let name :: String
name = MirrorSingleton mirror -> String
forall a. Show a => a -> String
show (MirrorSingleton mirror -> String)
-> MirrorSingleton mirror -> String
forall a b. (a -> b) -> a -> b
$ Mosaic Packed mirror Upper height -> MirrorSingleton mirror
forall pack mirror uplo size.
Mosaic pack mirror uplo size -> MirrorSingleton mirror
Layout.mosaicMirror Mosaic Packed mirror Upper height
sha
       (height
height,width
width) = Extent Size Big Big 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 Size Big Big height width
extent
   in Mosaic Packed mirror Upper (height ::+ width)
-> (Ptr a -> IO ()) -> MosaicUpper mirror (height ::+ width) a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate
         (PackingSingleton Packed
-> MirrorSingleton mirror
-> UpLoSingleton Upper
-> Order
-> (height ::+ width)
-> Mosaic Packed mirror Upper (height ::+ width)
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton Packed
Layout.Packed
            (Mosaic Packed mirror Upper height -> MirrorSingleton mirror
forall pack mirror uplo size.
Mosaic pack mirror uplo size -> MirrorSingleton mirror
Layout.mosaicMirror Mosaic Packed mirror Upper height
sha)
            UpLoSingleton Upper
Layout.Upper Order
order (height
height height -> width -> height ::+ width
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ width
width)) ((Ptr a -> IO ()) -> MosaicUpper mirror (height ::+ width) a)
-> (Ptr a -> IO ()) -> MosaicUpper mirror (height ::+ width) a
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr -> do
      String -> Bool -> IO ()
Call.assert (String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
".stack: height shapes mismatch") (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
         height
height height -> height -> Bool
forall a. Eq a => a -> a -> Bool
== Mosaic Packed mirror Upper height -> height
forall pack mirror uplo size. Mosaic pack mirror uplo size -> size
Layout.mosaicSize Mosaic Packed mirror Upper height
sha
      String -> Bool -> IO ()
Call.assert (String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
".stack: width shapes mismatch") (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
         width
width width -> width -> Bool
forall a. Eq a => a -> a -> Bool
== Mosaic Packed mirror Upper width -> width
forall pack mirror uplo size. Mosaic pack mirror uplo size -> size
Layout.mosaicSize Mosaic Packed mirror Upper width
shc
      let m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
      let n :: Int
n = width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
      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 -> (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
(Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleA Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock Order
order Int
m Int
n Ptr a
aPtr Ptr a
xPtr
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
b ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
bPtr -> (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
(Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyRectangle Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock Order
order Int
m Int
n Ptr a
bPtr Ptr a
xPtr
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
c ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
cPtr -> (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
(Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleC Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock Order
order Int
m Int
n Ptr a
cPtr Ptr a
xPtr

takeTopRight ::
   (Shape.C height, Shape.C width, Class.Floating a) =>
   MosaicUpper mirror (height::+width) a -> Matrix.General height width a
takeTopRight :: MosaicUpper mirror (height ::+ width) a -> General height width a
takeTopRight
   (Array
      (Layout.Mosaic PackingSingleton Packed
_packed MirrorSingleton mirror
_mirror UpLoSingleton Upper
_upper Order
order (height
height::+width
width)) ForeignPtr a
x) =
   General height width -> (Ptr a -> IO ()) -> General height width a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (Order -> height -> width -> General height width
forall height width.
Order -> height -> width -> General height width
Layout.general Order
order height
height width
width) ((Ptr a -> IO ()) -> General height width a)
-> (Ptr a -> IO ()) -> General height width a
forall a b. (a -> b) -> a -> b
$ \Ptr a
bPtr -> do
      let m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
      let n :: Int
n = width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
(Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyRectangle ((Ptr a -> Ptr a -> IO ()) -> Ptr a -> Ptr a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Ptr a -> Ptr a -> IO ()) -> Ptr a -> Ptr a -> IO ())
-> (Int -> Ptr a -> Ptr a -> IO ())
-> Int
-> Ptr a
-> Ptr a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock) Order
order Int
m Int
n Ptr a
bPtr

takeTopLeft ::
   (Shape.C height, Shape.C width, Class.Floating a) =>
   MosaicUpper mirror (height::+width) a ->
   MosaicUpper mirror height a
takeTopLeft :: MosaicUpper mirror (height ::+ width) a
-> MosaicUpper mirror height a
takeTopLeft
   (Array (Layout.Mosaic PackingSingleton Packed
packing MirrorSingleton mirror
mirror UpLoSingleton Upper
upper Order
order (height
height::+width
width)) ForeignPtr a
x) =
   Mosaic Packed mirror Upper height
-> (Ptr a -> IO ()) -> MosaicUpper mirror height a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (PackingSingleton Packed
-> MirrorSingleton mirror
-> UpLoSingleton Upper
-> Order
-> height
-> Mosaic Packed mirror Upper height
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton Packed
packing MirrorSingleton mirror
mirror UpLoSingleton Upper
upper Order
order height
height) ((Ptr a -> IO ()) -> MosaicUpper mirror height a)
-> (Ptr a -> IO ()) -> MosaicUpper mirror height a
forall a b. (a -> b) -> a -> b
$
         \Ptr a
aPtr -> do
      let m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
      let n :: Int
n = width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
(Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleA ((Ptr a -> Ptr a -> IO ()) -> Ptr a -> Ptr a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Ptr a -> Ptr a -> IO ()) -> Ptr a -> Ptr a -> IO ())
-> (Int -> Ptr a -> Ptr a -> IO ())
-> Int
-> Ptr a
-> Ptr a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock) Order
order Int
m Int
n Ptr a
aPtr

takeBottomRight ::
   (Shape.C height, Shape.C width, Class.Floating a) =>
   MosaicUpper mirror (height::+width) a ->
   MosaicUpper mirror width a
takeBottomRight :: MosaicUpper mirror (height ::+ width) a
-> MosaicUpper mirror width a
takeBottomRight
   (Array (Layout.Mosaic PackingSingleton Packed
packing MirrorSingleton mirror
mirror UpLoSingleton Upper
upper Order
order (height
height::+width
width)) ForeignPtr a
x) =
   Mosaic Packed mirror Upper width
-> (Ptr a -> IO ()) -> MosaicUpper mirror width a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (PackingSingleton Packed
-> MirrorSingleton mirror
-> UpLoSingleton Upper
-> Order
-> width
-> Mosaic Packed mirror Upper width
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton Packed
packing MirrorSingleton mirror
mirror UpLoSingleton Upper
upper Order
order width
width) ((Ptr a -> IO ()) -> MosaicUpper mirror width a)
-> (Ptr a -> IO ()) -> MosaicUpper mirror width a
forall a b. (a -> b) -> a -> b
$
         \Ptr a
cPtr -> do
      let m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
      let n :: Int
n = width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
(Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleC ((Ptr a -> Ptr a -> IO ()) -> Ptr a -> Ptr a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Ptr a -> Ptr a -> IO ()) -> Ptr a -> Ptr a -> IO ())
-> (Int -> Ptr a -> Ptr a -> IO ())
-> Int
-> Ptr a
-> Ptr a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock) Order
order Int
m Int
n Ptr a
cPtr

{-# INLINE copyTriangleA #-}
copyTriangleA ::
   (Class.Floating a) =>
   (Int -> Ptr a -> Ptr a -> IO ()) ->
   Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleA :: (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleA Int -> Ptr a -> Ptr a -> IO ()
copy Order
order Int
m Int
n Ptr a
aPtr Ptr a
xPtr =
   case Order
order of
      Order
ColumnMajor -> Int -> Ptr a -> Ptr a -> IO ()
copy (Int -> Int
Shape.triangleSize Int
m) Ptr a
aPtr Ptr a
xPtr
      Order
RowMajor ->
         [(Int, (Ptr a, Ptr a))]
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
pred Int
m) ([(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 (Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order Int
m Ptr a
aPtr)
                    (Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Ptr a
xPtr)) (((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ())
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            \(Int
k,(Ptr a
aiPtr,Ptr a
xiPtr)) -> Int -> Ptr a -> Ptr a -> IO ()
copy Int
k Ptr a
aiPtr Ptr a
xiPtr

{-# INLINE copyTriangleC #-}
copyTriangleC ::
   (Class.Floating a) =>
   (Int -> Ptr a -> Ptr a -> IO ()) ->
   Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleC :: (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyTriangleC Int -> Ptr a -> Ptr a -> IO ()
copy Order
order Int
m Int
n Ptr a
cPtr Ptr a
xPtr =
   case Order
order of
      Order
RowMajor ->
         let triSize :: Int
triSize = Int -> Int
Shape.triangleSize Int
n
         in Int -> Ptr a -> Ptr a -> IO ()
copy Int
triSize Ptr a
cPtr
               (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
xPtr (Int -> Ptr a) -> Int -> Ptr a
forall a b. (a -> b) -> a -> b
$ Int -> Int
Shape.triangleSize (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
triSize)
      Order
ColumnMajor ->
         [(Int, (Ptr a, Ptr a))]
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
succ Int
0) ([(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 (Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order Int
n Ptr a
cPtr)
                    (Int -> [Ptr a] -> [Ptr a]
forall a. Int -> [a] -> [a]
drop Int
m ([Ptr a] -> [Ptr a]) -> [Ptr a] -> [Ptr a]
forall a b. (a -> b) -> a -> b
$ Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Ptr a
xPtr)) (((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ())
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            \(Int
k,(Ptr a
aiPtr,Ptr a
xiPtr)) ->
               Int -> Ptr a -> Ptr a -> IO ()
copy (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
aiPtr (-Int
k)) (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
xiPtr (-Int
k))

{-# INLINE copyRectangle #-}
copyRectangle ::
   (Class.Floating a) =>
   (Int -> Ptr a -> Ptr a -> IO ()) ->
   Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyRectangle :: (Int -> Ptr a -> Ptr a -> IO ())
-> Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
copyRectangle Int -> Ptr a -> Ptr a -> IO ()
copy Order
order Int
m Int
n Ptr a
bPtr Ptr a
xPtr =
   case Order
order of
      Order
RowMajor ->
         [(Int, (Ptr a, Ptr a))]
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [(Int, (Ptr a, Ptr a))] -> [(Int, (Ptr a, Ptr a))]
forall a. Int -> [a] -> [a]
take Int
m ([(Int, (Ptr a, Ptr a))] -> [(Int, (Ptr a, Ptr a))])
-> [(Int, (Ptr a, Ptr a))] -> [(Int, (Ptr a, Ptr a))]
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
pred Int
m) ([(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
bPtr) (Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Ptr a
xPtr)) (((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ())
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            \(Int
k,(Ptr a
biPtr,Ptr a
xiPtr)) -> Int -> Ptr a -> Ptr a -> IO ()
copy Int
n Ptr a
biPtr (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
xiPtr Int
k)
      Order
ColumnMajor ->
         [(Int, (Ptr a, Ptr a))]
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (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))])
-> [(Int, (Ptr a, Ptr a))] -> [(Int, (Ptr a, Ptr a))]
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
forall a. Enum a => a -> a
succ Int
m) ([(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
m Ptr a
bPtr)
                    (Int -> [Ptr a] -> [Ptr a]
forall a. Int -> [a] -> [a]
drop Int
m ([Ptr a] -> [Ptr a]) -> [Ptr a] -> [Ptr a]
forall a b. (a -> b) -> a -> b
$ Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Ptr a
xPtr)) (((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ())
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            \(Int
k,(Ptr a
biPtr,Ptr a
xiPtr)) -> Int -> Ptr a -> Ptr a -> IO ()
copy Int
m Ptr a
biPtr (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
xiPtr (-Int
k))



type Triangular uplo sh = Array (Layout.Triangular uplo sh)
type Lower sh = Triangular Shape.Lower sh
type Upper sh = Triangular Shape.Upper sh


newtype MultiplyRight sh a b uplo =
   MultiplyRight {MultiplyRight sh a b uplo -> Triangular uplo sh a -> b
getMultiplyRight :: Triangular uplo sh a -> b}

newtype Map pack mirror sh0 sh1 a uplo =
   Map {
      Map pack mirror sh0 sh1 a uplo
-> Mosaic pack mirror uplo sh0 a -> Mosaic pack mirror uplo sh1 a
getMap :: Mosaic pack mirror uplo sh0 a -> Mosaic pack mirror uplo sh1 a
   }


fromBanded ::
   (Class.Floating a) =>
   Int -> Order -> Int -> ForeignPtr a -> Int -> Ptr a -> IO ()
fromBanded :: Int -> Order -> Int -> ForeignPtr a -> Int -> Ptr a -> IO ()
fromBanded Int
k Order
order Int
n ForeignPtr a
a Int
bSize 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 -> do
      a -> Int -> Ptr a -> IO ()
forall a. Floating a => a -> Int -> Ptr a -> IO ()
fill a
forall a. Floating a => a
zero Int
bSize Ptr a
bPtr
      let lda :: Int
lda = Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
      let pointers :: [(Int, (Ptr a, Ptr a))]
pointers =
            [Int] -> [(Ptr a, Ptr a)] -> [(Int, (Ptr a, Ptr a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(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
lda Ptr a
aPtr) ([Ptr a] -> [(Ptr a, Ptr a)]) -> [Ptr a] -> [(Ptr a, Ptr a)]
forall a b. (a -> b) -> a -> b
$
            Order -> Int -> Ptr a -> [Ptr a]
forall a. Storable a => Order -> Int -> Ptr a -> [Ptr a]
diagonalPointers Order
order Int
n Ptr a
bPtr
      case Order
order of
         Order
ColumnMajor ->
            [(Int, (Ptr a, Ptr a))]
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, (Ptr a, Ptr a))]
pointers (((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ())
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,(Ptr a
xPtr,Ptr a
yPtr)) ->
               let j :: Int
j = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
k
               in Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
xPtr (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j)) (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
yPtr (-Int
j))
         Order
RowMajor ->
            [(Int, (Ptr a, Ptr a))]
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, (Ptr a, Ptr a))]
pointers (((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ())
-> ((Int, (Ptr a, Ptr a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,(Ptr a
xPtr,Ptr a
yPtr)) ->
               Int -> Ptr a -> Ptr a -> IO ()
forall a. Floating a => Int -> Ptr a -> Ptr a -> IO ()
copyBlock (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lda (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) Ptr a
xPtr Ptr a
yPtr


{-
Naming is inconsistent to Triangular.takeUpper,
because here Hermitian is the input
and in Triangular.takeUpper, Triangular is the output.
-}
takeUpper :: MosaicUpper mirror sh a -> Upper sh a
takeUpper :: MosaicUpper mirror sh a -> Upper sh a
takeUpper =
   (Mosaic Packed mirror Upper sh -> Mosaic Packed NoMirror Upper sh)
-> MosaicUpper mirror sh a -> Upper sh a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape
      (\(Layout.Mosaic PackingSingleton Packed
packing MirrorSingleton mirror
_mirror UpLoSingleton Upper
upper Order
order sh
sh) ->
         PackingSingleton Packed
-> MirrorSingleton NoMirror
-> UpLoSingleton Upper
-> Order
-> sh
-> Mosaic Packed NoMirror Upper sh
forall pack mirror uplo size.
PackingSingleton pack
-> MirrorSingleton mirror
-> UpLoSingleton uplo
-> Order
-> size
-> Mosaic pack mirror uplo size
Layout.Mosaic PackingSingleton Packed
packing MirrorSingleton NoMirror
Layout.NoMirror UpLoSingleton Upper
upper Order
order sh
sh)

fromUpper ::
   (Layout.Mirror mirror) => Upper sh a -> MosaicUpper mirror sh a
fromUpper :: Upper sh a -> MosaicUpper mirror sh a
fromUpper =
   (Mosaic Packed NoMirror Upper sh -> Mosaic Packed mirror Upper sh)
-> Upper sh a -> MosaicUpper mirror sh a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape
      (\(Layout.Mosaic PackingSingleton Packed
packing MirrorSingleton NoMirror
Layout.NoMirror UpLoSingleton Upper
upper Order
order sh
sh) ->
         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
packing MirrorSingleton mirror
forall mirror. Mirror mirror => MirrorSingleton mirror
Layout.autoMirror UpLoSingleton Upper
upper Order
order sh
sh)



fromLowerPart ::
   (Extent.Measure meas, Extent.C horiz,
    Shape.C height, Shape.C width, Class.Floating a) =>
   (Order -> Int -> Ptr a -> IO ()) ->
   Layout.MirrorSingleton mirror ->
   Full meas Extent.Small horiz height width a -> MosaicLower mirror height a
fromLowerPart :: (Order -> Int -> Ptr a -> IO ())
-> MirrorSingleton mirror
-> Full meas Small horiz height width a
-> MosaicLower mirror height a
fromLowerPart Order -> Int -> Ptr a -> IO ()
fillDiag MirrorSingleton mirror
mirror (Array (Layout.Full Order
order Extent meas Small horiz height width
extent) ForeignPtr a
a) =
   let (height
height,width
width) = Extent meas Small 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 Small horiz height width
extent
       m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
       n :: Int
n = width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width
       k :: Int
k = case Order
order of Order
RowMajor -> Int
n; Order
ColumnMajor -> Int
m
   in Mosaic Packed mirror Lower height
-> (Ptr a -> IO ()) -> MosaicLower mirror height a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate
         (PackingSingleton Packed
-> MirrorSingleton mirror
-> UpLoSingleton Lower
-> Order
-> height
-> Mosaic Packed mirror Lower height
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 Lower
Layout.Lower Order
order height
height) ((Ptr a -> IO ()) -> MosaicLower mirror height a)
-> (Ptr a -> IO ()) -> MosaicLower mirror height a
forall a b. (a -> b) -> a -> b
$ \Ptr a
lPtr ->
      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 -> do
         let dstOrder :: Order
dstOrder = Order -> Order
flipOrder Order
order
         Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
forall a.
Floating a =>
Order -> Int -> Int -> Ptr a -> Ptr a -> IO ()
packRect Order
dstOrder Int
m Int
k Ptr a
aPtr Ptr a
lPtr
         Order -> Int -> Ptr a -> IO ()
fillDiag Order
dstOrder Int
m Ptr a
lPtr

leaveDiagonal :: Order -> Int -> Ptr a -> IO ()
leaveDiagonal :: Order -> Int -> Ptr a -> IO ()
leaveDiagonal Order
_order Int
_m Ptr a
_ptr = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()



data Labelled r label a = Labelled label (ContT r IO a)

label :: label -> a -> Labelled r label a
label :: label -> a -> Labelled r label a
label label
lab a
a = label -> ContT r IO a -> Labelled r label a
forall r label a. label -> ContT r IO a -> Labelled r label a
Labelled label
lab (a -> ContT r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)

noLabel :: a -> Labelled r () a
noLabel :: a -> Labelled r () a
noLabel a
a = () -> ContT r IO a -> Labelled r () a
forall r label a. label -> ContT r IO a -> Labelled r label a
Labelled () (a -> ContT r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)

instance Functor (Labelled r label) where
   fmap :: (a -> b) -> Labelled r label a -> Labelled r label b
fmap a -> b
f (Labelled label
lab ContT r IO a
a) = label -> ContT r IO b -> Labelled r label b
forall r label a. label -> ContT r IO a -> Labelled r label a
Labelled label
lab (ContT r IO b -> Labelled r label b)
-> ContT r IO b -> Labelled r label b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> ContT r IO a -> ContT r IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ContT r IO a
a

runUnlabelled :: Labelled r () (IO ()) -> ContT r IO ()
runUnlabelled :: Labelled r () (IO ()) -> ContT r IO ()
runUnlabelled (Labelled () ContT r IO (IO ())
m)  =  IO () -> ContT r IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ()) -> ContT r IO (IO ()) -> ContT r IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContT r IO (IO ())
m

runLabelledLinear ::
   String -> Labelled r String (Ptr CInt -> IO ()) -> ContT r IO ()
runLabelledLinear :: String -> Labelled r String (Ptr CInt -> IO ()) -> ContT r IO ()
runLabelledLinear String
msg (Labelled String
name ContT r IO (Ptr CInt -> IO ())
m)  =  IO () -> ContT r IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ())
-> ((Ptr CInt -> IO ()) -> IO ())
-> (Ptr CInt -> IO ())
-> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
msg String
name ((Ptr CInt -> IO ()) -> ContT r IO ())
-> ContT r IO (Ptr CInt -> IO ()) -> ContT r IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContT r IO (Ptr CInt -> IO ())
m

runLabelledWorkspace ::
   (Class.Floating a) =>
   String ->
   Labelled r String (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) ->
   ContT r IO ()
runLabelledWorkspace :: String
-> Labelled r String (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT r IO ()
runLabelledWorkspace String
msg (Labelled String
name ContT r IO (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
m) =
   IO () -> ContT r IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ())
-> ((Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> String -> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
forall a.
Floating a =>
String
-> String -> (Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspaceInfo String
msg String
name ((Ptr a -> Ptr CInt -> Ptr CInt -> IO ()) -> ContT r IO ())
-> ContT r IO (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
-> ContT r IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContT r IO (Ptr a -> Ptr CInt -> Ptr CInt -> IO ())
m


data Labelled2 r label a b = Labelled2 (Labelled r label a) (Labelled r label b)

instance Functor (Labelled2 r label a) where
   fmap :: (a -> b) -> Labelled2 r label a a -> Labelled2 r label a b
fmap a -> b
f (Labelled2 Labelled r label a
a Labelled r label a
b) = Labelled r label a -> Labelled r label b -> Labelled2 r label a b
forall r label a b.
Labelled r label a -> Labelled r label b -> Labelled2 r label a b
Labelled2 Labelled r label a
a ((a -> b) -> Labelled r label a -> Labelled r label b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Labelled r label a
b)


infixl 9 $*, $**

($*) :: Labelled2 r label (a -> f) (a -> g) -> a -> Labelled2 r label f g
Labelled2 Labelled r label (a -> f)
f Labelled r label (a -> g)
g $* :: Labelled2 r label (a -> f) (a -> g) -> a -> Labelled2 r label f g
$* a
a = Labelled r label f -> Labelled r label g -> Labelled2 r label f g
forall r label a b.
Labelled r label a -> Labelled r label b -> Labelled2 r label a b
Labelled2 (((a -> f) -> f) -> Labelled r label (a -> f) -> Labelled r label f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> f) -> a -> f
forall a b. (a -> b) -> a -> b
$a
a) Labelled r label (a -> f)
f) (((a -> g) -> g) -> Labelled r label (a -> g) -> Labelled r label g
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> g) -> a -> g
forall a b. (a -> b) -> a -> b
$a
a) Labelled r label (a -> g)
g)

($**) ::
   Labelled2 r label (a -> f) (a -> Ptr CInt -> g) ->
   (a,Int) -> Labelled2 r label f g
Labelled2 Labelled r label (a -> f)
f (Labelled label
lab ContT r IO (a -> Ptr CInt -> g)
g) $** :: Labelled2 r label (a -> f) (a -> Ptr CInt -> g)
-> (a, Int) -> Labelled2 r label f g
$** (a
a,Int
n) =
   Labelled r label f -> Labelled r label g -> Labelled2 r label f g
forall r label a b.
Labelled r label a -> Labelled r label b -> Labelled2 r label a b
Labelled2 (((a -> f) -> f) -> Labelled r label (a -> f) -> Labelled r label f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> f) -> a -> f
forall a b. (a -> b) -> a -> b
$a
a) Labelled r label (a -> f)
f) (label -> ContT r IO g -> Labelled r label g
forall r label a. label -> ContT r IO a -> Labelled r label a
Labelled label
lab (ContT r IO g -> Labelled r label g)
-> ContT r IO g -> Labelled r label g
forall a b. (a -> b) -> a -> b
$ ((a -> Ptr CInt -> g) -> Ptr CInt -> g)
-> ContT r IO (a -> Ptr CInt -> g) -> ContT r IO (Ptr CInt -> g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Ptr CInt -> g) -> a -> Ptr CInt -> g
forall a b. (a -> b) -> a -> b
$a
a) ContT r IO (a -> Ptr CInt -> g)
g ContT r IO (Ptr CInt -> g) -> ContT r IO (Ptr CInt) -> ContT r IO g
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ContT r IO (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n)


runPacking ::
   Layout.PackingSingleton pack ->
   Labelled2 r label func func -> Labelled r label func
runPacking :: PackingSingleton pack
-> Labelled2 r label func func -> Labelled r label func
runPacking PackingSingleton pack
pck (Labelled2 Labelled r label func
lp Labelled r label func
lu) =
   case PackingSingleton pack
pck of
      PackingSingleton pack
Layout.Packed -> Labelled r label func
lp
      PackingSingleton pack
Layout.Unpacked -> Labelled r label func
lu

withPacking ::
   Layout.PackingSingleton pack ->
   Labelled2 r () (IO ()) (IO ()) -> ContT r IO ()
withPacking :: PackingSingleton pack
-> Labelled2 r () (IO ()) (IO ()) -> ContT r IO ()
withPacking PackingSingleton pack
pck = Labelled r () (IO ()) -> ContT r IO ()
forall r. Labelled r () (IO ()) -> ContT r IO ()
runUnlabelled (Labelled r () (IO ()) -> ContT r IO ())
-> (Labelled2 r () (IO ()) (IO ()) -> Labelled r () (IO ()))
-> Labelled2 r () (IO ()) (IO ())
-> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackingSingleton pack
-> Labelled2 r () (IO ()) (IO ()) -> Labelled r () (IO ())
forall pack r label func.
PackingSingleton pack
-> Labelled2 r label func func -> Labelled r label func
runPacking PackingSingleton pack
pck

withPackingLinear ::
   (func ~ (Ptr CInt -> IO ())) =>
   String -> Layout.PackingSingleton pack ->
   Labelled2 r String func func -> ContT r IO ()
withPackingLinear :: String
-> PackingSingleton pack
-> Labelled2 r String func func
-> ContT r IO ()
withPackingLinear String
msg PackingSingleton pack
pck = String -> Labelled r String (Ptr CInt -> IO ()) -> ContT r IO ()
forall r.
String -> Labelled r String (Ptr CInt -> IO ()) -> ContT r IO ()
runLabelledLinear String
msg (Labelled r String (Ptr CInt -> IO ()) -> ContT r IO ())
-> (Labelled2 r String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
    -> Labelled r String (Ptr CInt -> IO ()))
-> Labelled2 r String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> ContT r IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackingSingleton pack
-> Labelled2 r String (Ptr CInt -> IO ()) (Ptr CInt -> IO ())
-> Labelled r String (Ptr CInt -> IO ())
forall pack r label func.
PackingSingleton pack
-> Labelled2 r label func func -> Labelled r label func
runPacking PackingSingleton pack
pck


data TriArg a = TriArg (Ptr a) Int

triArg :: Ptr a -> Int -> TriArg a
triArg :: Ptr a -> Int -> TriArg a
triArg = Ptr a -> Int -> TriArg a
forall a. Ptr a -> Int -> TriArg a
TriArg

applyFuncPair ::
   (m ~ Labelled (FuncCont f) (FuncLabel f), FunctionPair f) =>
   m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair :: m (FuncPacked f) -> m (FuncUnpacked f) -> f
applyFuncPair m (FuncPacked f)
f m (FuncUnpacked f)
g = Labelled2
  (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
-> f
forall f.
FunctionPair f =>
Labelled2
  (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
-> f
apply (Labelled (FuncCont f) (FuncLabel f) (FuncPacked f)
-> Labelled (FuncCont f) (FuncLabel f) (FuncUnpacked f)
-> Labelled2
     (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
forall r label a b.
Labelled r label a -> Labelled r label b -> Labelled2 r label a b
Labelled2 m (FuncPacked f)
Labelled (FuncCont f) (FuncLabel f) (FuncPacked f)
f m (FuncUnpacked f)
Labelled (FuncCont f) (FuncLabel f) (FuncUnpacked f)
g)

class FunctionPair f where
   type FuncCont f
   type FuncLabel f
   type FuncPacked f
   type FuncUnpacked f
   apply ::
      Labelled2 (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f) -> f

type family LabelResult a
type instance LabelResult (Labelled r label a) = a

instance FunctionPair (Labelled2 r label a b) where
   type FuncCont (Labelled2 r label a b) = r
   type FuncLabel (Labelled2 r label a b) = label
   type FuncPacked (Labelled2 r label a b) = a
   type FuncUnpacked (Labelled2 r label a b) = b
   apply :: Labelled2
  (FuncCont (Labelled2 r label a b))
  (FuncLabel (Labelled2 r label a b))
  (FuncPacked (Labelled2 r label a b))
  (FuncUnpacked (Labelled2 r label a b))
-> Labelled2 r label a b
apply = Labelled2
  (FuncCont (Labelled2 r label a b))
  (FuncLabel (Labelled2 r label a b))
  (FuncPacked (Labelled2 r label a b))
  (FuncUnpacked (Labelled2 r label a b))
-> Labelled2 r label a b
forall a. a -> a
id

instance (FunctionArg a, FunctionPair f) => FunctionPair (a -> f) where
   type FuncCont (a -> f) = FuncCont f
   type FuncLabel (a -> f) = FuncLabel f
   type FuncPacked (a -> f) = FuncArgPacked a f
   type FuncUnpacked (a -> f) = FuncArgUnpacked a f
   apply :: Labelled2
  (FuncCont (a -> f))
  (FuncLabel (a -> f))
  (FuncPacked (a -> f))
  (FuncUnpacked (a -> f))
-> a -> f
apply = Labelled2
  (FuncCont (a -> f))
  (FuncLabel (a -> f))
  (FuncPacked (a -> f))
  (FuncUnpacked (a -> f))
-> a -> f
forall a f.
(FunctionArg a, FunctionPair f) =>
Labelled2
  (FuncCont f)
  (FuncLabel f)
  (FuncArgPacked a f)
  (FuncArgUnpacked a f)
-> a -> f
applyArg


class FunctionArg a where
   type FuncArgPacked a f
   type FuncArgUnpacked a f
   applyArg ::
      (FunctionPair f) =>
      Labelled2 (FuncCont f)
         (FuncLabel f) (FuncArgPacked a f) (FuncArgUnpacked a f) ->
      a -> f

instance FunctionArg (Ptr a) where
   type FuncArgPacked (Ptr a) f = Ptr a -> FuncPacked f
   type FuncArgUnpacked (Ptr a) f = Ptr a -> FuncUnpacked f
   applyArg :: Labelled2
  (FuncCont f)
  (FuncLabel f)
  (FuncArgPacked (Ptr a) f)
  (FuncArgUnpacked (Ptr a) f)
-> Ptr a -> f
applyArg Labelled2
  (FuncCont f)
  (FuncLabel f)
  (FuncArgPacked (Ptr a) f)
  (FuncArgUnpacked (Ptr a) f)
fg Ptr a
a = Labelled2
  (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
-> f
forall f.
FunctionPair f =>
Labelled2
  (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
-> f
apply (Labelled2
  (FuncCont f)
  (FuncLabel f)
  (FuncArgPacked (Ptr a) f)
  (FuncArgUnpacked (Ptr a) f)
Labelled2
  (FuncCont f)
  (FuncLabel f)
  (Ptr a -> FuncPacked f)
  (Ptr a -> FuncUnpacked f)
fgLabelled2
  (FuncCont f)
  (FuncLabel f)
  (Ptr a -> FuncPacked f)
  (Ptr a -> FuncUnpacked f)
-> Ptr a
-> Labelled2
     (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
forall r label a f g.
Labelled2 r label (a -> f) (a -> g) -> a -> Labelled2 r label f g
$*Ptr a
a)

instance FunctionArg (TriArg a) where
   type FuncArgPacked (TriArg a) f = Ptr a -> FuncPacked f
   type FuncArgUnpacked (TriArg a) f = Ptr a -> Ptr CInt -> FuncUnpacked f
   applyArg :: Labelled2
  (FuncCont f)
  (FuncLabel f)
  (FuncArgPacked (TriArg a) f)
  (FuncArgUnpacked (TriArg a) f)
-> TriArg a -> f
applyArg Labelled2
  (FuncCont f)
  (FuncLabel f)
  (FuncArgPacked (TriArg a) f)
  (FuncArgUnpacked (TriArg a) f)
fg (TriArg Ptr a
a Int
n) = Labelled2
  (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
-> f
forall f.
FunctionPair f =>
Labelled2
  (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
-> f
apply (Labelled2
  (FuncCont f)
  (FuncLabel f)
  (FuncArgPacked (TriArg a) f)
  (FuncArgUnpacked (TriArg a) f)
Labelled2
  (FuncCont f)
  (FuncLabel f)
  (Ptr a -> FuncPacked f)
  (Ptr a -> Ptr CInt -> FuncUnpacked f)
fgLabelled2
  (FuncCont f)
  (FuncLabel f)
  (Ptr a -> FuncPacked f)
  (Ptr a -> Ptr CInt -> FuncUnpacked f)
-> (Ptr a, Int)
-> Labelled2
     (FuncCont f) (FuncLabel f) (FuncPacked f) (FuncUnpacked f)
forall r label a f g.
Labelled2 r label (a -> f) (a -> Ptr CInt -> g)
-> (a, Int) -> Labelled2 r label f g
$**(Ptr a
a,Int
n))