{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.Array.Nested.Ranked.Base where

import Prelude hiding (mappend, mconcat)

import Control.DeepSeq (NFData(..))
import Control.Monad.ST
import Data.Bifunctor (first)
import Data.Coerce (coerce)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy
import Data.Type.Equality
import Foreign.Storable (Storable)
import GHC.Float qualified (expm1, log1mexp, log1p, log1pexp)
import GHC.Generics (Generic)
import GHC.TypeLits

#ifndef OXAR_DEFAULT_SHOW_INSTANCES
import Data.Foldable (toList)
#endif

import Data.Array.Nested.Lemmas
import Data.Array.Nested.Mixed
import Data.Array.Nested.Mixed.Shape
import Data.Array.Nested.Ranked.Shape
import Data.Array.Nested.Types
import Data.Array.Strided.Arith
import Data.Array.XArray (XArray(..))


-- | A rank-typed array: the number of dimensions of the array (its /rank/) is
-- represented on the type level as a 'Nat'.
--
-- Valid elements of a ranked arrays are described by the 'Elt' type class.
-- Because 'Ranked' itself is also an instance of 'Elt', nested arrays are
-- supported (and are represented as a single, flattened, struct-of-arrays
-- array internally).
--
-- 'Ranked' is a newtype around a 'Mixed' of 'Nothing's.
type Ranked :: Nat -> Type -> Type
newtype Ranked n a = Ranked (Mixed (Replicate n Nothing) a)
#ifdef OXAR_DEFAULT_SHOW_INSTANCES
deriving instance Show (Mixed (Replicate n Nothing) a) => Show (Ranked n a)
#endif
deriving instance Eq (Mixed (Replicate n Nothing) a) => Eq (Ranked n a)
deriving instance Ord (Mixed (Replicate n Nothing) a) => Ord (Ranked n a)

#ifndef OXAR_DEFAULT_SHOW_INSTANCES
instance (Show a, Elt a) => Show (Ranked n a) where
  showsPrec :: Int -> Ranked n a -> ShowS
showsPrec Int
d arr :: Ranked n a
arr@(Ranked Mixed (Replicate n 'Nothing) a
marr) =
    let sh :: String
sh = [Int] -> String
forall a. Show a => a -> String
show (ShR n Int -> [Int]
forall a. ShR n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Ranked n a -> ShR n Int
forall a (n :: Natural). Elt a => Ranked n a -> IShR n
rshape Ranked n a
arr))
    in String -> String -> Int -> Mixed (Replicate n 'Nothing) a -> ShowS
forall a (sh :: [Maybe Natural]).
(Show a, Elt a) =>
String -> String -> Int -> Mixed sh a -> ShowS
showsMixedArray (String
"rfromListLinear " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sh) (String
"rreplicate " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sh) Int
d Mixed (Replicate n 'Nothing) a
marr
#endif

instance Elt a => NFData (Ranked n a) where
  rnf :: Ranked n a -> ()
rnf (Ranked Mixed (Replicate n 'Nothing) a
arr) = Mixed (Replicate n 'Nothing) a -> ()
forall a. NFData a => a -> ()
rnf Mixed (Replicate n 'Nothing) a
arr

-- just unwrap the newtype and defer to the general instance for nested arrays
newtype instance Mixed sh (Ranked n a) = M_Ranked (Mixed sh (Mixed (Replicate n Nothing) a))
  deriving ((forall x. Mixed sh (Ranked n a) -> Rep (Mixed sh (Ranked n a)) x)
-> (forall x.
    Rep (Mixed sh (Ranked n a)) x -> Mixed sh (Ranked n a))
-> Generic (Mixed sh (Ranked n a))
forall (sh :: [Maybe Natural]) (n :: Natural) a x.
Rep (Mixed sh (Ranked n a)) x -> Mixed sh (Ranked n a)
forall (sh :: [Maybe Natural]) (n :: Natural) a x.
Mixed sh (Ranked n a) -> Rep (Mixed sh (Ranked n a)) x
forall x. Rep (Mixed sh (Ranked n a)) x -> Mixed sh (Ranked n a)
forall x. Mixed sh (Ranked n a) -> Rep (Mixed sh (Ranked n a)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (sh :: [Maybe Natural]) (n :: Natural) a x.
Mixed sh (Ranked n a) -> Rep (Mixed sh (Ranked n a)) x
from :: forall x. Mixed sh (Ranked n a) -> Rep (Mixed sh (Ranked n a)) x
$cto :: forall (sh :: [Maybe Natural]) (n :: Natural) a x.
Rep (Mixed sh (Ranked n a)) x -> Mixed sh (Ranked n a)
to :: forall x. Rep (Mixed sh (Ranked n a)) x -> Mixed sh (Ranked n a)
Generic)
#ifdef OXAR_DEFAULT_SHOW_INSTANCES
deriving instance Show (Mixed sh (Mixed (Replicate n Nothing) a)) => Show (Mixed sh (Ranked n a))
#endif

deriving instance Eq (Mixed sh (Mixed (Replicate n Nothing) a)) => Eq (Mixed sh (Ranked n a))

newtype instance MixedVecs s sh (Ranked n a) = MV_Ranked (MixedVecs s sh (Mixed (Replicate n Nothing) a))

-- 'Ranked' and 'Shaped' can already be used at the top level of an array nest;
-- these instances allow them to also be used as elements of arrays, thus
-- making them first-class in the API.
instance Elt a => Elt (Ranked n a) where
  mshape :: forall (sh :: [Maybe Natural]). Mixed sh (Ranked n a) -> IShX sh
mshape (M_Ranked Mixed sh (Mixed (Replicate n 'Nothing) a)
arr) = Mixed sh (Mixed (Replicate n 'Nothing) a) -> IShX sh
forall (sh :: [Maybe Natural]).
Mixed sh (Mixed (Replicate n 'Nothing) a) -> IShX sh
forall a (sh :: [Maybe Natural]). Elt a => Mixed sh a -> IShX sh
mshape Mixed sh (Mixed (Replicate n 'Nothing) a)
arr
  mindex :: forall (sh :: [Maybe Natural]).
Mixed sh (Ranked n a) -> IIxX sh -> Ranked n a
mindex (M_Ranked Mixed sh (Mixed (Replicate n 'Nothing) a)
arr) IIxX sh
i = Mixed (Replicate n 'Nothing) a -> Ranked n a
forall (n :: Natural) a.
Mixed (Replicate n 'Nothing) a -> Ranked n a
Ranked (Mixed sh (Mixed (Replicate n 'Nothing) a)
-> IIxX sh -> Mixed (Replicate n 'Nothing) a
forall (sh :: [Maybe Natural]).
Mixed sh (Mixed (Replicate n 'Nothing) a)
-> IIxX sh -> Mixed (Replicate n 'Nothing) a
forall a (sh :: [Maybe Natural]).
Elt a =>
Mixed sh a -> IIxX sh -> a
mindex Mixed sh (Mixed (Replicate n 'Nothing) a)
arr IIxX sh
i)

  mindexPartial :: forall sh sh'. Mixed (sh ++ sh') (Ranked n a) -> IIxX sh -> Mixed sh' (Ranked n a)
  mindexPartial :: forall (sh :: [Maybe Natural]) (sh' :: [Maybe Natural]).
Mixed (sh ++ sh') (Ranked n a) -> IIxX sh -> Mixed sh' (Ranked n a)
mindexPartial (M_Ranked Mixed (sh ++ sh') (Mixed (Replicate n 'Nothing) a)
arr) IIxX sh
i =
    forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Mixed sh' (Mixed (Replicate n Nothing) a)) @(Mixed sh' (Ranked n a)) (Mixed sh' (Mixed (Replicate n 'Nothing) a)
 -> Mixed sh' (Ranked n a))
-> Mixed sh' (Mixed (Replicate n 'Nothing) a)
-> Mixed sh' (Ranked n a)
forall a b. (a -> b) -> a -> b
$
        Mixed (sh ++ sh') (Mixed (Replicate n 'Nothing) a)
-> IIxX sh -> Mixed sh' (Mixed (Replicate n 'Nothing) a)
forall (sh :: [Maybe Natural]) (sh' :: [Maybe Natural]).
Mixed (sh ++ sh') (Mixed (Replicate n 'Nothing) a)
-> IIxX sh -> Mixed sh' (Mixed (Replicate n 'Nothing) a)
forall a (sh :: [Maybe Natural]) (sh' :: [Maybe Natural]).
Elt a =>
Mixed (sh ++ sh') a -> IIxX sh -> Mixed sh' a
mindexPartial Mixed (sh ++ sh') (Mixed (Replicate n 'Nothing) a)
arr IIxX sh
i

  mscalar :: Ranked n a -> Mixed '[] (Ranked n a)
mscalar (Ranked Mixed (Replicate n 'Nothing) a
x) = Mixed '[] (Mixed (Replicate n 'Nothing) a)
-> Mixed '[] (Ranked n a)
forall (sh :: [Maybe Natural]) (n :: Natural) a.
Mixed sh (Mixed (Replicate n 'Nothing) a) -> Mixed sh (Ranked n a)
M_Ranked (IShX '[]
-> Mixed ('[] ++ Replicate n 'Nothing) a
-> Mixed '[] (Mixed (Replicate n 'Nothing) a)
forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural]) a.
IShX sh1 -> Mixed (sh1 ++ sh2) a -> Mixed sh1 (Mixed sh2 a)
M_Nest IShX '[]
forall (sh :: [Maybe Natural]) i. (sh ~ '[]) => ShX sh i
ZSX Mixed (Replicate n 'Nothing) a
Mixed ('[] ++ Replicate n 'Nothing) a
x)

  mfromListOuter :: forall sh. NonEmpty (Mixed sh (Ranked n a)) -> Mixed (Nothing : sh) (Ranked n a)
  mfromListOuter :: forall (sh :: [Maybe Natural]).
NonEmpty (Mixed sh (Ranked n a))
-> Mixed ('Nothing : sh) (Ranked n a)
mfromListOuter NonEmpty (Mixed sh (Ranked n a))
l = Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a)
-> Mixed ('Nothing : sh) (Ranked n a)
forall (sh :: [Maybe Natural]) (n :: Natural) a.
Mixed sh (Mixed (Replicate n 'Nothing) a) -> Mixed sh (Ranked n a)
M_Ranked (NonEmpty (Mixed sh (Mixed (Replicate n 'Nothing) a))
-> Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a)
forall (sh :: [Maybe Natural]).
NonEmpty (Mixed sh (Mixed (Replicate n 'Nothing) a))
-> Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a)
forall a (sh :: [Maybe Natural]).
Elt a =>
NonEmpty (Mixed sh a) -> Mixed ('Nothing : sh) a
mfromListOuter (NonEmpty (Mixed sh (Ranked n a))
-> NonEmpty (Mixed sh (Mixed (Replicate n 'Nothing) a))
forall a b. Coercible a b => a -> b
coerce NonEmpty (Mixed sh (Ranked n a))
l))

  mtoListOuter :: forall m sh. Mixed (m : sh) (Ranked n a) -> [Mixed sh (Ranked n a)]
  mtoListOuter :: forall (n :: Maybe Natural) (sh :: [Maybe Natural]).
Mixed (n : sh) (Ranked n a) -> [Mixed sh (Ranked n a)]
mtoListOuter (M_Ranked Mixed (m : sh) (Mixed (Replicate n 'Nothing) a)
arr) =
    forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @[Mixed sh (Mixed (Replicate n 'Nothing) a)] @[Mixed sh (Ranked n a)] (Mixed (m : sh) (Mixed (Replicate n 'Nothing) a)
-> [Mixed sh (Mixed (Replicate n 'Nothing) a)]
forall (n :: Maybe Natural) (sh :: [Maybe Natural]).
Mixed (n : sh) (Mixed (Replicate n 'Nothing) a)
-> [Mixed sh (Mixed (Replicate n 'Nothing) a)]
forall a (n :: Maybe Natural) (sh :: [Maybe Natural]).
Elt a =>
Mixed (n : sh) a -> [Mixed sh a]
mtoListOuter Mixed (m : sh) (Mixed (Replicate n 'Nothing) a)
arr)

  mlift :: forall sh1 sh2.
           StaticShX sh2
        -> (forall sh' b. Storable b => StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b)
        -> Mixed sh1 (Ranked n a) -> Mixed sh2 (Ranked n a)
  mlift :: forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural]).
StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b)
-> Mixed sh1 (Ranked n a)
-> Mixed sh2 (Ranked n a)
mlift StaticShX sh2
ssh2 forall (sh' :: [Maybe Natural]) b.
Storable b =>
StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b
f (M_Ranked Mixed sh1 (Mixed (Replicate n 'Nothing) a)
arr) =
    forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Mixed sh2 (Mixed (Replicate n Nothing) a)) @(Mixed sh2 (Ranked n a)) (Mixed sh2 (Mixed (Replicate n 'Nothing) a)
 -> Mixed sh2 (Ranked n a))
-> Mixed sh2 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh2 (Ranked n a)
forall a b. (a -> b) -> a -> b
$
      StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b)
-> Mixed sh1 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh2 (Mixed (Replicate n 'Nothing) a)
forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural]).
StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b)
-> Mixed sh1 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh2 (Mixed (Replicate n 'Nothing) a)
forall a (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural]).
Elt a =>
StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b)
-> Mixed sh1 a
-> Mixed sh2 a
mlift StaticShX sh2
ssh2 StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b
forall (sh' :: [Maybe Natural]) b.
Storable b =>
StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b
f Mixed sh1 (Mixed (Replicate n 'Nothing) a)
arr

  mlift2 :: forall sh1 sh2 sh3.
            StaticShX sh3
         -> (forall sh' b. Storable b => StaticShX sh' -> XArray (sh1 ++ sh') b -> XArray (sh2 ++ sh') b -> XArray (sh3 ++ sh') b)
         -> Mixed sh1 (Ranked n a) -> Mixed sh2 (Ranked n a) -> Mixed sh3 (Ranked n a)
  mlift2 :: forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural])
       (sh3 :: [Maybe Natural]).
StaticShX sh3
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> XArray (sh1 ++ sh') b
    -> XArray (sh2 ++ sh') b
    -> XArray (sh3 ++ sh') b)
-> Mixed sh1 (Ranked n a)
-> Mixed sh2 (Ranked n a)
-> Mixed sh3 (Ranked n a)
mlift2 StaticShX sh3
ssh3 forall (sh' :: [Maybe Natural]) b.
Storable b =>
StaticShX sh'
-> XArray (sh1 ++ sh') b
-> XArray (sh2 ++ sh') b
-> XArray (sh3 ++ sh') b
f (M_Ranked Mixed sh1 (Mixed (Replicate n 'Nothing) a)
arr1) (M_Ranked Mixed sh2 (Mixed (Replicate n 'Nothing) a)
arr2) =
    forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Mixed sh3 (Mixed (Replicate n Nothing) a)) @(Mixed sh3 (Ranked n a)) (Mixed sh3 (Mixed (Replicate n 'Nothing) a)
 -> Mixed sh3 (Ranked n a))
-> Mixed sh3 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh3 (Ranked n a)
forall a b. (a -> b) -> a -> b
$
      StaticShX sh3
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> XArray (sh1 ++ sh') b
    -> XArray (sh2 ++ sh') b
    -> XArray (sh3 ++ sh') b)
-> Mixed sh1 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh2 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh3 (Mixed (Replicate n 'Nothing) a)
forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural])
       (sh3 :: [Maybe Natural]).
StaticShX sh3
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> XArray (sh1 ++ sh') b
    -> XArray (sh2 ++ sh') b
    -> XArray (sh3 ++ sh') b)
-> Mixed sh1 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh2 (Mixed (Replicate n 'Nothing) a)
-> Mixed sh3 (Mixed (Replicate n 'Nothing) a)
forall a (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural])
       (sh3 :: [Maybe Natural]).
Elt a =>
StaticShX sh3
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> XArray (sh1 ++ sh') b
    -> XArray (sh2 ++ sh') b
    -> XArray (sh3 ++ sh') b)
-> Mixed sh1 a
-> Mixed sh2 a
-> Mixed sh3 a
mlift2 StaticShX sh3
ssh3 StaticShX sh'
-> XArray (sh1 ++ sh') b
-> XArray (sh2 ++ sh') b
-> XArray (sh3 ++ sh') b
forall (sh' :: [Maybe Natural]) b.
Storable b =>
StaticShX sh'
-> XArray (sh1 ++ sh') b
-> XArray (sh2 ++ sh') b
-> XArray (sh3 ++ sh') b
f Mixed sh1 (Mixed (Replicate n 'Nothing) a)
arr1 Mixed sh2 (Mixed (Replicate n 'Nothing) a)
arr2

  mliftL :: forall sh1 sh2.
            StaticShX sh2
         -> (forall sh' b. Storable b => StaticShX sh' -> NonEmpty (XArray (sh1 ++ sh') b) -> NonEmpty (XArray (sh2 ++ sh') b))
         -> NonEmpty (Mixed sh1 (Ranked n a)) -> NonEmpty (Mixed sh2 (Ranked n a))
  mliftL :: forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural]).
StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> NonEmpty (XArray (sh1 ++ sh') b)
    -> NonEmpty (XArray (sh2 ++ sh') b))
-> NonEmpty (Mixed sh1 (Ranked n a))
-> NonEmpty (Mixed sh2 (Ranked n a))
mliftL StaticShX sh2
ssh2 forall (sh' :: [Maybe Natural]) b.
Storable b =>
StaticShX sh'
-> NonEmpty (XArray (sh1 ++ sh') b)
-> NonEmpty (XArray (sh2 ++ sh') b)
f NonEmpty (Mixed sh1 (Ranked n a))
l =
    forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(NonEmpty (Mixed sh2 (Mixed (Replicate n Nothing) a)))
           @(NonEmpty (Mixed sh2 (Ranked n a))) (NonEmpty (Mixed sh2 (Mixed (Replicate n 'Nothing) a))
 -> NonEmpty (Mixed sh2 (Ranked n a)))
-> NonEmpty (Mixed sh2 (Mixed (Replicate n 'Nothing) a))
-> NonEmpty (Mixed sh2 (Ranked n a))
forall a b. (a -> b) -> a -> b
$
      StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> NonEmpty (XArray (sh1 ++ sh') b)
    -> NonEmpty (XArray (sh2 ++ sh') b))
-> NonEmpty (Mixed sh1 (Mixed (Replicate n 'Nothing) a))
-> NonEmpty (Mixed sh2 (Mixed (Replicate n 'Nothing) a))
forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural]).
StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> NonEmpty (XArray (sh1 ++ sh') b)
    -> NonEmpty (XArray (sh2 ++ sh') b))
-> NonEmpty (Mixed sh1 (Mixed (Replicate n 'Nothing) a))
-> NonEmpty (Mixed sh2 (Mixed (Replicate n 'Nothing) a))
forall a (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural]).
Elt a =>
StaticShX sh2
-> (forall (sh' :: [Maybe Natural]) b.
    Storable b =>
    StaticShX sh'
    -> NonEmpty (XArray (sh1 ++ sh') b)
    -> NonEmpty (XArray (sh2 ++ sh') b))
-> NonEmpty (Mixed sh1 a)
-> NonEmpty (Mixed sh2 a)
mliftL StaticShX sh2
ssh2 StaticShX sh'
-> NonEmpty (XArray (sh1 ++ sh') b)
-> NonEmpty (XArray (sh2 ++ sh') b)
forall (sh' :: [Maybe Natural]) b.
Storable b =>
StaticShX sh'
-> NonEmpty (XArray (sh1 ++ sh') b)
-> NonEmpty (XArray (sh2 ++ sh') b)
f (NonEmpty (Mixed sh1 (Ranked n a))
-> NonEmpty (Mixed sh1 (Mixed (Replicate n 'Nothing) a))
forall a b. Coercible a b => a -> b
coerce NonEmpty (Mixed sh1 (Ranked n a))
l)

  mcastPartial :: forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural])
       (sh' :: [Maybe Natural]).
(Rank sh1 ~ Rank sh2) =>
StaticShX sh1
-> StaticShX sh2
-> Proxy sh'
-> Mixed (sh1 ++ sh') (Ranked n a)
-> Mixed (sh2 ++ sh') (Ranked n a)
mcastPartial StaticShX sh1
ssh1 StaticShX sh2
ssh2 Proxy sh'
psh' (M_Ranked Mixed (sh1 ++ sh') (Mixed (Replicate n 'Nothing) a)
arr) = Mixed (sh2 ++ sh') (Mixed (Replicate n 'Nothing) a)
-> Mixed (sh2 ++ sh') (Ranked n a)
forall (sh :: [Maybe Natural]) (n :: Natural) a.
Mixed sh (Mixed (Replicate n 'Nothing) a) -> Mixed sh (Ranked n a)
M_Ranked (StaticShX sh1
-> StaticShX sh2
-> Proxy sh'
-> Mixed (sh1 ++ sh') (Mixed (Replicate n 'Nothing) a)
-> Mixed (sh2 ++ sh') (Mixed (Replicate n 'Nothing) a)
forall (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural])
       (sh' :: [Maybe Natural]).
(Rank sh1 ~ Rank sh2) =>
StaticShX sh1
-> StaticShX sh2
-> Proxy sh'
-> Mixed (sh1 ++ sh') (Mixed (Replicate n 'Nothing) a)
-> Mixed (sh2 ++ sh') (Mixed (Replicate n 'Nothing) a)
forall a (sh1 :: [Maybe Natural]) (sh2 :: [Maybe Natural])
       (sh' :: [Maybe Natural]).
(Elt a, Rank sh1 ~ Rank sh2) =>
StaticShX sh1
-> StaticShX sh2
-> Proxy sh'
-> Mixed (sh1 ++ sh') a
-> Mixed (sh2 ++ sh') a
mcastPartial StaticShX sh1
ssh1 StaticShX sh2
ssh2 Proxy sh'
psh' Mixed (sh1 ++ sh') (Mixed (Replicate n 'Nothing) a)
arr)

  mtranspose :: forall (is :: [Natural]) (sh :: [Maybe Natural]).
(IsPermutation is, Rank is <= Rank sh) =>
Perm is
-> Mixed sh (Ranked n a)
-> Mixed (PermutePrefix is sh) (Ranked n a)
mtranspose Perm is
perm (M_Ranked Mixed sh (Mixed (Replicate n 'Nothing) a)
arr) = Mixed
  (Permute is (TakeLen is sh) ++ DropLen is sh)
  (Mixed (Replicate n 'Nothing) a)
-> Mixed (Permute is (TakeLen is sh) ++ DropLen is sh) (Ranked n a)
forall (sh :: [Maybe Natural]) (n :: Natural) a.
Mixed sh (Mixed (Replicate n 'Nothing) a) -> Mixed sh (Ranked n a)
M_Ranked (Perm is
-> Mixed sh (Mixed (Replicate n 'Nothing) a)
-> Mixed
     (Permute is (TakeLen is sh) ++ DropLen is sh)
     (Mixed (Replicate n 'Nothing) a)
forall (is :: [Natural]) (sh :: [Maybe Natural]).
(IsPermutation is, Rank is <= Rank sh) =>
Perm is
-> Mixed sh (Mixed (Replicate n 'Nothing) a)
-> Mixed (PermutePrefix is sh) (Mixed (Replicate n 'Nothing) a)
forall a (is :: [Natural]) (sh :: [Maybe Natural]).
(Elt a, IsPermutation is, Rank is <= Rank sh) =>
Perm is -> Mixed sh a -> Mixed (PermutePrefix is sh) a
mtranspose Perm is
perm Mixed sh (Mixed (Replicate n 'Nothing) a)
arr)

  mconcat :: forall (sh :: [Maybe Natural]).
NonEmpty (Mixed ('Nothing : sh) (Ranked n a))
-> Mixed ('Nothing : sh) (Ranked n a)
mconcat NonEmpty (Mixed ('Nothing : sh) (Ranked n a))
l = Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a)
-> Mixed ('Nothing : sh) (Ranked n a)
forall (sh :: [Maybe Natural]) (n :: Natural) a.
Mixed sh (Mixed (Replicate n 'Nothing) a) -> Mixed sh (Ranked n a)
M_Ranked (NonEmpty (Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a))
-> Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a)
forall (sh :: [Maybe Natural]).
NonEmpty (Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a))
-> Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a)
forall a (sh :: [Maybe Natural]).
Elt a =>
NonEmpty (Mixed ('Nothing : sh) a) -> Mixed ('Nothing : sh) a
mconcat (NonEmpty (Mixed ('Nothing : sh) (Ranked n a))
-> NonEmpty
     (Mixed ('Nothing : sh) (Mixed (Replicate n 'Nothing) a))
forall a b. Coercible a b => a -> b
coerce NonEmpty (Mixed ('Nothing : sh) (Ranked n a))
l))

  mrnf :: forall (sh :: [Maybe Natural]). Mixed sh (Ranked n a) -> ()
mrnf (M_Ranked Mixed sh (Mixed (Replicate n 'Nothing) a)
arr) = Mixed sh (Mixed (Replicate n 'Nothing) a) -> ()
forall (sh :: [Maybe Natural]).
Mixed sh (Mixed (Replicate n 'Nothing) a) -> ()
forall a (sh :: [Maybe Natural]). Elt a => Mixed sh a -> ()
mrnf Mixed sh (Mixed (Replicate n 'Nothing) a)
arr

  type ShapeTree (Ranked n a) = (IShR n, ShapeTree a)

  mshapeTree :: Ranked n a -> ShapeTree (Ranked n a)
mshapeTree (Ranked Mixed (Replicate n 'Nothing) a
arr) = (IShX (Replicate n 'Nothing) -> IShR n)
-> (IShX (Replicate n 'Nothing), ShapeTree a)
-> (IShR n, ShapeTree a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IShX (Replicate n 'Nothing) -> IShR n
forall (n :: Natural). IShX (Replicate n 'Nothing) -> IShR n
shrFromShX2 (Mixed (Replicate n 'Nothing) a
-> ShapeTree (Mixed (Replicate n 'Nothing) a)
forall a. Elt a => a -> ShapeTree a
mshapeTree Mixed (Replicate n 'Nothing) a
arr)

  mshapeTreeEq :: Proxy (Ranked n a)
-> ShapeTree (Ranked n a) -> ShapeTree (Ranked n a) -> Bool
mshapeTreeEq Proxy (Ranked n a)
_ (IShR n
sh1, ShapeTree a
t1) (IShR n
sh2, ShapeTree a
t2) = IShR n
sh1 IShR n -> IShR n -> Bool
forall a. Eq a => a -> a -> Bool
== IShR n
sh2 Bool -> Bool -> Bool
&& Proxy a -> ShapeTree a -> ShapeTree a -> Bool
forall a. Elt a => Proxy a -> ShapeTree a -> ShapeTree a -> Bool
mshapeTreeEq (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) ShapeTree a
t1 ShapeTree a
t2

  mshapeTreeEmpty :: Proxy (Ranked n a) -> ShapeTree (Ranked n a) -> Bool
mshapeTreeEmpty Proxy (Ranked n a)
_ (IShR n
sh, ShapeTree a
t) = IShR n -> Int
forall (n :: Natural). IShR n -> Int
shrSize IShR n
sh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Proxy a -> ShapeTree a -> Bool
forall a. Elt a => Proxy a -> ShapeTree a -> Bool
mshapeTreeEmpty (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) ShapeTree a
t

  mshowShapeTree :: Proxy (Ranked n a) -> ShapeTree (Ranked n a) -> String
mshowShapeTree Proxy (Ranked n a)
_ (IShR n
sh, ShapeTree a
t) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IShR n -> String
forall a. Show a => a -> String
show IShR n
sh String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy a -> ShapeTree a -> String
forall a. Elt a => Proxy a -> ShapeTree a -> String
mshowShapeTree (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) ShapeTree a
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

  marrayStrides :: forall (sh :: [Maybe Natural]). Mixed sh (Ranked n a) -> Bag [Int]
marrayStrides (M_Ranked Mixed sh (Mixed (Replicate n 'Nothing) a)
arr) = Mixed sh (Mixed (Replicate n 'Nothing) a) -> Bag [Int]
forall (sh :: [Maybe Natural]).
Mixed sh (Mixed (Replicate n 'Nothing) a) -> Bag [Int]
forall a (sh :: [Maybe Natural]). Elt a => Mixed sh a -> Bag [Int]
marrayStrides Mixed sh (Mixed (Replicate n 'Nothing) a)
arr

  mvecsWrite :: forall sh s. IShX sh -> IIxX sh -> Ranked n a -> MixedVecs s sh (Ranked n a) -> ST s ()
  mvecsWrite :: forall (sh :: [Maybe Natural]) s.
IShX sh
-> IIxX sh -> Ranked n a -> MixedVecs s sh (Ranked n a) -> ST s ()
mvecsWrite IShX sh
sh IIxX sh
idx (Ranked Mixed (Replicate n 'Nothing) a
arr) MixedVecs s sh (Ranked n a)
vecs =
    IShX sh
-> IIxX sh
-> Mixed (Replicate n 'Nothing) a
-> MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> ST s ()
forall (sh :: [Maybe Natural]) s.
IShX sh
-> IIxX sh
-> Mixed (Replicate n 'Nothing) a
-> MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> ST s ()
forall a (sh :: [Maybe Natural]) s.
Elt a =>
IShX sh -> IIxX sh -> a -> MixedVecs s sh a -> ST s ()
mvecsWrite IShX sh
sh IIxX sh
idx Mixed (Replicate n 'Nothing) a
arr
      (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(MixedVecs s sh (Ranked n a)) @(MixedVecs s sh (Mixed (Replicate n Nothing) a))
         MixedVecs s sh (Ranked n a)
vecs)

  mvecsWritePartial :: forall sh sh' s.
                       IShX (sh ++ sh') -> IIxX sh -> Mixed sh' (Ranked n a)
                    -> MixedVecs s (sh ++ sh') (Ranked n a)
                    -> ST s ()
  mvecsWritePartial :: forall (sh :: [Maybe Natural]) (sh' :: [Maybe Natural]) s.
IShX (sh ++ sh')
-> IIxX sh
-> Mixed sh' (Ranked n a)
-> MixedVecs s (sh ++ sh') (Ranked n a)
-> ST s ()
mvecsWritePartial IShX (sh ++ sh')
sh IIxX sh
idx Mixed sh' (Ranked n a)
arr MixedVecs s (sh ++ sh') (Ranked n a)
vecs =
    IShX (sh ++ sh')
-> IIxX sh
-> Mixed sh' (Mixed (Replicate n 'Nothing) a)
-> MixedVecs s (sh ++ sh') (Mixed (Replicate n 'Nothing) a)
-> ST s ()
forall (sh :: [Maybe Natural]) (sh' :: [Maybe Natural]) s.
IShX (sh ++ sh')
-> IIxX sh
-> Mixed sh' (Mixed (Replicate n 'Nothing) a)
-> MixedVecs s (sh ++ sh') (Mixed (Replicate n 'Nothing) a)
-> ST s ()
forall a (sh :: [Maybe Natural]) (sh' :: [Maybe Natural]) s.
Elt a =>
IShX (sh ++ sh')
-> IIxX sh -> Mixed sh' a -> MixedVecs s (sh ++ sh') a -> ST s ()
mvecsWritePartial IShX (sh ++ sh')
sh IIxX sh
idx
      (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Mixed sh' (Ranked n a))
              @(Mixed sh' (Mixed (Replicate n Nothing) a))
         Mixed sh' (Ranked n a)
arr)
      (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(MixedVecs s (sh ++ sh') (Ranked n a))
              @(MixedVecs s (sh ++ sh') (Mixed (Replicate n Nothing) a))
         MixedVecs s (sh ++ sh') (Ranked n a)
vecs)

  mvecsFreeze :: forall sh s. IShX sh -> MixedVecs s sh (Ranked n a) -> ST s (Mixed sh (Ranked n a))
  mvecsFreeze :: forall (sh :: [Maybe Natural]) s.
IShX sh
-> MixedVecs s sh (Ranked n a) -> ST s (Mixed sh (Ranked n a))
mvecsFreeze IShX sh
sh MixedVecs s sh (Ranked n a)
vecs =
    forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Mixed sh (Mixed (Replicate n Nothing) a))
           @(Mixed sh (Ranked n a))
      (Mixed sh (Mixed (Replicate n 'Nothing) a)
 -> Mixed sh (Ranked n a))
-> ST s (Mixed sh (Mixed (Replicate n 'Nothing) a))
-> ST s (Mixed sh (Ranked n a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IShX sh
-> MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> ST s (Mixed sh (Mixed (Replicate n 'Nothing) a))
forall (sh :: [Maybe Natural]) s.
IShX sh
-> MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> ST s (Mixed sh (Mixed (Replicate n 'Nothing) a))
forall a (sh :: [Maybe Natural]) s.
Elt a =>
IShX sh -> MixedVecs s sh a -> ST s (Mixed sh a)
mvecsFreeze IShX sh
sh
            (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(MixedVecs s sh (Ranked n a))
                    @(MixedVecs s sh (Mixed (Replicate n Nothing) a))
                    MixedVecs s sh (Ranked n a)
vecs)

instance (KnownNat n, KnownElt a) => KnownElt (Ranked n a) where
  memptyArrayUnsafe :: forall sh. IShX sh -> Mixed sh (Ranked n a)
  memptyArrayUnsafe :: forall (sh :: [Maybe Natural]). IShX sh -> Mixed sh (Ranked n a)
memptyArrayUnsafe IShX sh
i
    | Dict KnownShX (Replicate n 'Nothing)
Dict <- SNat n -> Dict KnownShX (Replicate n 'Nothing)
forall (n :: Natural).
SNat n -> Dict KnownShX (Replicate n 'Nothing)
lemKnownReplicate (forall (n :: Natural). KnownNat n => SNat n
SNat @n)
    = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Mixed sh (Mixed (Replicate n Nothing) a)) @(Mixed sh (Ranked n a)) (Mixed sh (Mixed (Replicate n 'Nothing) a)
 -> Mixed sh (Ranked n a))
-> Mixed sh (Mixed (Replicate n 'Nothing) a)
-> Mixed sh (Ranked n a)
forall a b. (a -> b) -> a -> b
$
        IShX sh -> Mixed sh (Mixed (Replicate n 'Nothing) a)
forall (sh :: [Maybe Natural]).
IShX sh -> Mixed sh (Mixed (Replicate n 'Nothing) a)
forall a (sh :: [Maybe Natural]).
KnownElt a =>
IShX sh -> Mixed sh a
memptyArrayUnsafe IShX sh
i

  mvecsUnsafeNew :: forall (sh :: [Maybe Natural]) s.
IShX sh -> Ranked n a -> ST s (MixedVecs s sh (Ranked n a))
mvecsUnsafeNew IShX sh
idx (Ranked Mixed (Replicate n 'Nothing) a
arr)
    | Dict KnownShX (Replicate n 'Nothing)
Dict <- SNat n -> Dict KnownShX (Replicate n 'Nothing)
forall (n :: Natural).
SNat n -> Dict KnownShX (Replicate n 'Nothing)
lemKnownReplicate (forall (n :: Natural). KnownNat n => SNat n
SNat @n)
    = MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> MixedVecs s sh (Ranked n a)
forall s (sh :: [Maybe Natural]) (n :: Natural) a.
MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> MixedVecs s sh (Ranked n a)
MV_Ranked (MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
 -> MixedVecs s sh (Ranked n a))
-> ST s (MixedVecs s sh (Mixed (Replicate n 'Nothing) a))
-> ST s (MixedVecs s sh (Ranked n a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IShX sh
-> Mixed (Replicate n 'Nothing) a
-> ST s (MixedVecs s sh (Mixed (Replicate n 'Nothing) a))
forall (sh :: [Maybe Natural]) s.
IShX sh
-> Mixed (Replicate n 'Nothing) a
-> ST s (MixedVecs s sh (Mixed (Replicate n 'Nothing) a))
forall a (sh :: [Maybe Natural]) s.
KnownElt a =>
IShX sh -> a -> ST s (MixedVecs s sh a)
mvecsUnsafeNew IShX sh
idx Mixed (Replicate n 'Nothing) a
arr

  mvecsNewEmpty :: forall s (sh :: [Maybe Natural]).
Proxy (Ranked n a) -> ST s (MixedVecs s sh (Ranked n a))
mvecsNewEmpty Proxy (Ranked n a)
_
    | Dict KnownShX (Replicate n 'Nothing)
Dict <- SNat n -> Dict KnownShX (Replicate n 'Nothing)
forall (n :: Natural).
SNat n -> Dict KnownShX (Replicate n 'Nothing)
lemKnownReplicate (forall (n :: Natural). KnownNat n => SNat n
SNat @n)
    = MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> MixedVecs s sh (Ranked n a)
forall s (sh :: [Maybe Natural]) (n :: Natural) a.
MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
-> MixedVecs s sh (Ranked n a)
MV_Ranked (MixedVecs s sh (Mixed (Replicate n 'Nothing) a)
 -> MixedVecs s sh (Ranked n a))
-> ST s (MixedVecs s sh (Mixed (Replicate n 'Nothing) a))
-> ST s (MixedVecs s sh (Ranked n a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Mixed (Replicate n 'Nothing) a)
-> ST s (MixedVecs s sh (Mixed (Replicate n 'Nothing) a))
forall a s (sh :: [Maybe Natural]).
KnownElt a =>
Proxy a -> ST s (MixedVecs s sh a)
forall s (sh :: [Maybe Natural]).
Proxy (Mixed (Replicate n 'Nothing) a)
-> ST s (MixedVecs s sh (Mixed (Replicate n 'Nothing) a))
mvecsNewEmpty (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Mixed (Replicate n Nothing) a))


liftRanked1 :: forall n a b.
               (Mixed (Replicate n Nothing) a -> Mixed (Replicate n Nothing) b)
            -> Ranked n a -> Ranked n b
liftRanked1 :: forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
forall a b. Coercible a b => a -> b
coerce

liftRanked2 :: forall n a b c.
               (Mixed (Replicate n Nothing) a -> Mixed (Replicate n Nothing) b -> Mixed (Replicate n Nothing) c)
            -> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 :: forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
forall a b. Coercible a b => a -> b
coerce

instance (NumElt a, PrimElt a) => Num (Ranked n a) where
  + :: Ranked n a -> Ranked n a -> Ranked n a
(+) = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Num a => a -> a -> a
(+)
  (-) = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 (-)
  * :: Ranked n a -> Ranked n a -> Ranked n a
(*) = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Num a => a -> a -> a
(*)
  negate :: Ranked n a -> Ranked n a
negate = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Num a => a -> a
negate
  abs :: Ranked n a -> Ranked n a
abs = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Num a => a -> a
abs
  signum :: Ranked n a -> Ranked n a
signum = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Ranked n a
fromInteger = String -> Integer -> Ranked n a
forall a. HasCallStack => String -> a
error String
"Data.Array.Nested(Ranked).fromInteger: No singletons available, use explicit rreplicateScal"

instance (FloatElt a, PrimElt a) => Fractional (Ranked n a) where
  fromRational :: Rational -> Ranked n a
fromRational Rational
_ = String -> Ranked n a
forall a. HasCallStack => String -> a
error String
"Data.Array.Nested(Ranked).fromRational: No singletons available, use explicit rreplicateScal"
  recip :: Ranked n a -> Ranked n a
recip = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Fractional a => a -> a
recip
  / :: Ranked n a -> Ranked n a -> Ranked n a
(/) = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Fractional a => a -> a -> a
(/)

instance (FloatElt a, PrimElt a) => Floating (Ranked n a) where
  pi :: Ranked n a
pi = String -> Ranked n a
forall a. HasCallStack => String -> a
error String
"Data.Array.Nested(Ranked).pi: No singletons available, use explicit rreplicateScal"
  exp :: Ranked n a -> Ranked n a
exp = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
exp
  log :: Ranked n a -> Ranked n a
log = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
log
  sqrt :: Ranked n a -> Ranked n a
sqrt = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
sqrt
  ** :: Ranked n a -> Ranked n a -> Ranked n a
(**) = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a -> a
(**)
  logBase :: Ranked n a -> Ranked n a -> Ranked n a
logBase = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a -> a
logBase
  sin :: Ranked n a -> Ranked n a
sin = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
sin
  cos :: Ranked n a -> Ranked n a
cos = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
cos
  tan :: Ranked n a -> Ranked n a
tan = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
tan
  asin :: Ranked n a -> Ranked n a
asin = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
asin
  acos :: Ranked n a -> Ranked n a
acos = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
acos
  atan :: Ranked n a -> Ranked n a
atan = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
atan
  sinh :: Ranked n a -> Ranked n a
sinh = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
sinh
  cosh :: Ranked n a -> Ranked n a
cosh = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
cosh
  tanh :: Ranked n a -> Ranked n a
tanh = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
tanh
  asinh :: Ranked n a -> Ranked n a
asinh = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
asinh
  acosh :: Ranked n a -> Ranked n a
acosh = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
acosh
  atanh :: Ranked n a -> Ranked n a
atanh = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
atanh
  log1p :: Ranked n a -> Ranked n a
log1p = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
GHC.Float.log1p
  expm1 :: Ranked n a -> Ranked n a
expm1 = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
GHC.Float.expm1
  log1pexp :: Ranked n a -> Ranked n a
log1pexp = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
GHC.Float.log1pexp
  log1mexp :: Ranked n a -> Ranked n a
log1mexp = (Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a
forall (n :: Natural) a b.
(Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) b)
-> Ranked n a -> Ranked n b
liftRanked1 Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a. Floating a => a -> a
GHC.Float.log1mexp

rquotArray, rremArray :: (IntElt a, PrimElt a) => Ranked n a -> Ranked n a -> Ranked n a
rquotArray :: forall a (n :: Natural).
(IntElt a, PrimElt a) =>
Ranked n a -> Ranked n a -> Ranked n a
rquotArray = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a (sh :: [Maybe Natural]).
(IntElt a, PrimElt a) =>
Mixed sh a -> Mixed sh a -> Mixed sh a
mquotArray
rremArray :: forall a (n :: Natural).
(IntElt a, PrimElt a) =>
Ranked n a -> Ranked n a -> Ranked n a
rremArray = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a (sh :: [Maybe Natural]).
(IntElt a, PrimElt a) =>
Mixed sh a -> Mixed sh a -> Mixed sh a
mremArray

ratan2Array :: (FloatElt a, PrimElt a) => Ranked n a -> Ranked n a -> Ranked n a
ratan2Array :: forall a (n :: Natural).
(FloatElt a, PrimElt a) =>
Ranked n a -> Ranked n a -> Ranked n a
ratan2Array = (Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) a)
-> Ranked n a -> Ranked n a -> Ranked n a
forall (n :: Natural) a b c.
(Mixed (Replicate n 'Nothing) a
 -> Mixed (Replicate n 'Nothing) b
 -> Mixed (Replicate n 'Nothing) c)
-> Ranked n a -> Ranked n b -> Ranked n c
liftRanked2 Mixed (Replicate n 'Nothing) a
-> Mixed (Replicate n 'Nothing) a -> Mixed (Replicate n 'Nothing) a
forall a (sh :: [Maybe Natural]).
(FloatElt a, PrimElt a) =>
Mixed sh a -> Mixed sh a -> Mixed sh a
matan2Array


rshape :: Elt a => Ranked n a -> IShR n
rshape :: forall a (n :: Natural). Elt a => Ranked n a -> IShR n
rshape (Ranked Mixed (Replicate n 'Nothing) a
arr) = IShX (Replicate n 'Nothing) -> IShR n
forall (n :: Natural). IShX (Replicate n 'Nothing) -> IShR n
shrFromShX2 (Mixed (Replicate n 'Nothing) a -> IShX (Replicate n 'Nothing)
forall (sh :: [Maybe Natural]). Mixed sh a -> IShX sh
forall a (sh :: [Maybe Natural]). Elt a => Mixed sh a -> IShX sh
mshape Mixed (Replicate n 'Nothing) a
arr)

rrank :: Elt a => Ranked n a -> SNat n
rrank :: forall a (n :: Natural). Elt a => Ranked n a -> SNat n
rrank = ShR n Int -> SNat n
forall (n :: Natural) i. ShR n i -> SNat n
shrRank (ShR n Int -> SNat n)
-> (Ranked n a -> ShR n Int) -> Ranked n a -> SNat n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ranked n a -> ShR n Int
forall a (n :: Natural). Elt a => Ranked n a -> IShR n
rshape

-- Needed already here, but re-exported in Data.Array.Nested.Convert.
shrFromShX :: forall sh. IShX sh -> IShR (Rank sh)
shrFromShX :: forall (sh :: [Maybe Natural]). IShX sh -> IShR (Rank sh)
shrFromShX ShX sh Int
ZSX = ShR 0 Int
ShR (Rank sh) Int
forall (n :: Natural) i. (n ~ 0) => ShR n i
ZSR
shrFromShX (SMayNat Int SNat n
n :$% ShX sh Int
idx) = SMayNat Int SNat n -> Int
forall (n :: Maybe Natural). SMayNat Int SNat n -> Int
fromSMayNat' SMayNat Int SNat n
n Int -> ShR (Rank sh) Int -> ShR (Rank sh + 1) Int
forall {n1 :: Natural} {i} (n :: Natural).
((n + 1) ~ n1) =>
i -> ShR n i -> ShR n1 i
:$: ShX sh Int -> ShR (Rank sh) Int
forall (sh :: [Maybe Natural]). IShX sh -> IShR (Rank sh)
shrFromShX ShX sh Int
idx

-- Needed already here, but re-exported in Data.Array.Nested.Convert.
-- | Convenience wrapper around 'shrFromShX' that applies 'lemRankReplicate'.
shrFromShX2 :: forall n. IShX (Replicate n Nothing) -> IShR n
shrFromShX2 :: forall (n :: Natural). IShX (Replicate n 'Nothing) -> IShR n
shrFromShX2 IShX (Replicate n 'Nothing)
sh
  | Rank (Replicate n 'Nothing) :~: n
Refl <- Proxy n -> Rank (Replicate n 'Nothing) :~: n
forall (proxy :: Natural -> *) (n :: Natural).
proxy n -> Rank (Replicate n 'Nothing) :~: n
lemRankReplicate (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)
  = IShX (Replicate n 'Nothing) -> IShR (Rank (Replicate n 'Nothing))
forall (sh :: [Maybe Natural]). IShX sh -> IShR (Rank sh)
shrFromShX IShX (Replicate n 'Nothing)
sh