{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE GADTs #-}
module Data.Array.Comfort.Shape (
   C(..),
   Indexed(..),
   InvIndexed(..), messageIndexFromOffset, assertIndexFromOffset,
   Static(..),

   requireCheck,
   CheckSingleton(..),
   Checking(..),
   Result(..),
   runChecked,
   runUnchecked,
   assert,
   throwOrError,

   Zero(Zero),
   ZeroBased(..), zeroBasedSplit,
   OneBased(..),

   Range(..),
   Shifted(..),
   Enumeration(..),
   Deferred(..), DeferredIndex(..), deferIndex, revealIndex,

   (::+)(..),

   Square(..),
   Cube(..),

   Triangular(..), Lower(Lower), Upper(Upper),
   LowerTriangular, UpperTriangular,
   lowerTriangular, upperTriangular,
   triangleSize, triangleRoot,

   Simplex(..),
   SimplexAscending, simplexAscending,
   SimplexDescending, simplexDescending,
   Ascending,
   Descending,
   SimplexOrder(..),
   SimplexOrderC,
   AllDistinct(..),
   SomeRepetitive(..),
   Collision(..),
   CollisionC,

   Cyclic(..),
   ) where

import qualified Data.Array.Comfort.Shape.Set as ShapeSet
import Data.Array.Comfort.Shape.Utility (messageIndexFromOffset, isRight)

import qualified Foreign.Storable.Newtype as Store
import Foreign.Storable
         (Storable, sizeOf, alignment, poke, peek, pokeElemOff, peekElemOff)
import Foreign.Ptr (Ptr, castPtr)

import qualified GHC.Arr as Ix

import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.HT as Monad
import qualified Control.Applicative.HT as AppHT
import qualified Control.Applicative.Backwards as Back
import Control.DeepSeq (NFData, rnf)
import Control.Monad (liftM)
import Control.Applicative (Applicative, pure, liftA2, liftA3, (<*>), (<$>))
import Control.Applicative (Const(Const, getConst))
import Control.Functor.HT (void)

import qualified Data.Functor.Classes as FunctorC
import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.NonEmpty as NonEmpty
import qualified Data.List.Match as Match
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Traversable (Traversable)
import Data.Foldable (Foldable)
import Data.Functor.Identity (Identity(Identity), runIdentity)
import Data.Function.HT (compose2)
import Data.Tagged (Tagged(Tagged, unTagged))
import Data.Map (Map)
import Data.Set (Set)
import Data.List.HT (tails)
import Data.Tuple.HT (mapFst, mapSnd, swap, fst3, snd3, thd3)
import Data.Eq.HT (equating)


{- $setup
>>> import qualified Data.Array.Comfort.Shape as Shape
>>> import qualified Data.Map as Map
>>> import qualified Data.Set as Set
>>> import Data.Array.Comfort.Shape ((::+)((::+)))
-}


data Checked
data Unchecked

class Checking check where
   data Result check a
   switchCheck :: f Checked -> f Unchecked -> f check

data CheckSingleton check where
   Checked :: CheckSingleton Checked
   Unchecked :: CheckSingleton Unchecked

autoCheck :: (Checking check) => CheckSingleton check
autoCheck :: CheckSingleton check
autoCheck = CheckSingleton Checked
-> CheckSingleton Unchecked -> CheckSingleton check
forall check (f :: * -> *).
Checking check =>
f Checked -> f Unchecked -> f check
switchCheck CheckSingleton Checked
Checked CheckSingleton Unchecked
Unchecked

checkFromResult :: (Checking check) => Result check a -> CheckSingleton check
checkFromResult :: Result check a -> CheckSingleton check
checkFromResult Result check a
_ = CheckSingleton check
forall check. Checking check => CheckSingleton check
autoCheck

withCheck ::
   (Checking check) =>
   (CheckSingleton check -> Result check a) -> Result check a
withCheck :: (CheckSingleton check -> Result check a) -> Result check a
withCheck CheckSingleton check -> Result check a
f = CheckSingleton check -> Result check a
f CheckSingleton check
forall check. Checking check => CheckSingleton check
autoCheck

requireCheck :: CheckSingleton check -> Result check a -> Result check a
requireCheck :: CheckSingleton check -> Result check a -> Result check a
requireCheck CheckSingleton check
_ = Result check a -> Result check a
forall a. a -> a
id


instance Checking Checked where
   newtype Result Checked a = CheckedResult {Result Checked a -> Either String a
getChecked :: Either String a}
   switchCheck :: f Checked -> f Unchecked -> f Checked
switchCheck f Checked
f f Unchecked
_ = f Checked
f

runChecked :: String -> Result Checked a -> a
runChecked :: String -> Result Checked a -> a
runChecked String
name (CheckedResult m) =
   (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (String -> String) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
"Shape." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ") String -> String -> String
forall a. [a] -> [a] -> [a]
++)) a -> a
forall a. a -> a
id Either String a
m

instance Checking Unchecked where
   newtype Result Unchecked a = UncheckedResult {Result Unchecked a -> a
getUnchecked :: a}
   switchCheck :: f Checked -> f Unchecked -> f Unchecked
switchCheck f Checked
_ f Unchecked
f = f Unchecked
f

runUnchecked :: Result Unchecked a -> a
runUnchecked :: Result Unchecked a -> a
runUnchecked = Result Unchecked a -> a
forall a. Result Unchecked a -> a
getUnchecked


throw :: String -> Result Checked a
throw :: String -> Result Checked a
throw = Either String a -> Result Checked a
forall a. Either String a -> Result Checked a
CheckedResult (Either String a -> Result Checked a)
-> (String -> Either String a) -> String -> Result Checked a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left

throwOrError :: (Checking check) => String -> Result check a
throwOrError :: String -> Result check a
throwOrError String
msg = (CheckSingleton check -> Result check a) -> Result check a
forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck ((CheckSingleton check -> Result check a) -> Result check a)
-> (CheckSingleton check -> Result check a) -> Result check a
forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
   case CheckSingleton check
check of
      CheckSingleton check
Checked -> String -> Result Checked a
forall a. String -> Result Checked a
throw String
msg
      CheckSingleton check
Unchecked -> String -> Result check a
forall a. HasCallStack => String -> a
error String
msg

assert :: (Checking check) => String -> Bool -> Result check ()
assert :: String -> Bool -> Result check ()
assert String
msg Bool
cond = (CheckSingleton check -> Result check ()) -> Result check ()
forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck ((CheckSingleton check -> Result check ()) -> Result check ())
-> (CheckSingleton check -> Result check ()) -> Result check ()
forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
   case CheckSingleton check
check of
      CheckSingleton check
Unchecked -> () -> Result Unchecked ()
forall a. a -> Result Unchecked a
UncheckedResult ()
      CheckSingleton check
Checked -> if Bool
cond then () -> Result check ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else String -> Result Checked ()
forall a. String -> Result Checked a
throw String
msg


instance (Checking check, Eq a) => Eq (Result check a) where
   Result check a
a0 == :: Result check a -> Result check a -> Bool
== Result check a
b0 =
      case (Result check a -> CheckSingleton check
forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a0, Result check a
a0, Result check a
b0) of
         (CheckSingleton check
Checked, CheckedResult a, CheckedResult b)  ->  Either String a
aEither String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
==Either String a
b
         (CheckSingleton check
Unchecked, UncheckedResult a, UncheckedResult b)  ->  a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b

instance (Checking check) => Functor (Result check) where
   fmap :: (a -> b) -> Result check a -> Result check b
fmap a -> b
f Result check a
m =
      case (Result check a -> CheckSingleton check
forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
m, Result check a
m) of
         (CheckSingleton check
Checked, CheckedResult e) -> Either String b -> Result Checked b
forall a. Either String a -> Result Checked a
CheckedResult (Either String b -> Result Checked b)
-> Either String b -> Result Checked b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either String a
e
         (CheckSingleton check
Unchecked, UncheckedResult a) -> b -> Result Unchecked b
forall a. a -> Result Unchecked a
UncheckedResult (b -> Result Unchecked b) -> b -> Result Unchecked b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

instance (Checking check) => Applicative (Result check) where
   pure :: a -> Result check a
pure a
a = (CheckSingleton check -> Result check a) -> Result check a
forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck ((CheckSingleton check -> Result check a) -> Result check a)
-> (CheckSingleton check -> Result check a) -> Result check a
forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
      case CheckSingleton check
check of
         CheckSingleton check
Checked -> Either String a -> Result Checked a
forall a. Either String a -> Result Checked a
CheckedResult (Either String a -> Result Checked a)
-> Either String a -> Result Checked a
forall a b. (a -> b) -> a -> b
$ a -> Either String a
forall a b. b -> Either a b
Right a
a
         CheckSingleton check
Unchecked -> a -> Result Unchecked a
forall a. a -> Result Unchecked a
UncheckedResult a
a
   Result check (a -> b)
f<*> :: Result check (a -> b) -> Result check a -> Result check b
<*>Result check a
a =
      case (Result check a -> CheckSingleton check
forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a, Result check (a -> b)
f, Result check a
a) of
         (CheckSingleton check
Checked, CheckedResult ff, CheckedResult fa) ->
            Either String b -> Result Checked b
forall a. Either String a -> Result Checked a
CheckedResult (Either String b -> Result Checked b)
-> Either String b -> Result Checked b
forall a b. (a -> b) -> a -> b
$ Either String (a -> b)
ffEither String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>Either String a
fa
         (CheckSingleton check
Unchecked, UncheckedResult xf, UncheckedResult xa) ->
            b -> Result Unchecked b
forall a. a -> Result Unchecked a
UncheckedResult (b -> Result Unchecked b) -> b -> Result Unchecked b
forall a b. (a -> b) -> a -> b
$ a -> b
xf a
xa

instance (Checking check) => Monad (Result check) where
   return :: a -> Result check a
return = a -> Result check a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Result check a
a >>= :: Result check a -> (a -> Result check b) -> Result check b
>>= a -> Result check b
b =
      case (Result check a -> CheckSingleton check
forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a, Result check a
a) of
         (CheckSingleton check
Checked, CheckedResult e) -> Either String b -> Result Checked b
forall a. Either String a -> Result Checked a
CheckedResult (Either String b -> Result Checked b)
-> Either String b -> Result Checked b
forall a b. (a -> b) -> a -> b
$ Result Checked b -> Either String b
forall a. Result Checked a -> Either String a
getChecked (Result Checked b -> Either String b)
-> (a -> Result Checked b) -> a -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result check b
a -> Result Checked b
b (a -> Either String b) -> Either String a -> Either String b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String a
e
         (CheckSingleton check
Unchecked, UncheckedResult x) -> a -> Result check b
b a
x


class C sh where
   {-
   This is the counterpart to 'Ix.rangeSize'.
   We do not support a counterpart to 'Ix.unsafeRangeSize' anymore.
   First, there is hardly any speed advantage
   of using 'Ix.unsafeRangeSize' instead of 'Ix.rangeSize'.
   Second, I do not know of an 'Ix' instance
   where 'Ix.rangeSize' and 'Ix.unsafeRangeSize' differ.
   -}
   size :: sh -> Int

class C sh => Indexed sh where
   {-# MINIMAL indices, (unifiedOffset|unifiedSizeOffset) #-}
   type Index sh
   -- Ix.range
   indices :: sh -> [Index sh]
   -- Ix.index
   offset :: sh -> Index sh -> Int
   offset sh
sh = String -> Result Checked Int -> Int
forall a. String -> Result Checked a -> a
runChecked String
"offset" (Result Checked Int -> Int)
-> (Index sh -> Result Checked Int) -> Index sh -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Index sh -> Result Checked Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh
   -- Ix.unsafeIndex
   uncheckedOffset :: sh -> Index sh -> Int
   uncheckedOffset sh
sh = Result Unchecked Int -> Int
forall a. Result Unchecked a -> a
getUnchecked (Result Unchecked Int -> Int)
-> (Index sh -> Result Unchecked Int) -> Index sh -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Index sh -> Result Unchecked Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh
   unifiedOffset :: (Checking check) => sh -> Index sh -> Result check Int
   unifiedOffset sh
sh = (Int, Index sh -> Result check Int) -> Index sh -> Result check Int
forall a b. (a, b) -> b
snd ((Int, Index sh -> Result check Int)
 -> Index sh -> Result check Int)
-> (Int, Index sh -> Result check Int)
-> Index sh
-> Result check Int
forall a b. (a -> b) -> a -> b
$ sh -> (Int, Index sh -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
   -- Ix.inRange
   inBounds :: sh -> Index sh -> Bool
   inBounds sh
sh = Either String Int -> Bool
forall a b. Either a b -> Bool
isRight (Either String Int -> Bool)
-> (Index sh -> Either String Int) -> Index sh -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Checked Int -> Either String Int
forall a. Result Checked a -> Either String a
getChecked (Result Checked Int -> Either String Int)
-> (Index sh -> Result Checked Int)
-> Index sh
-> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Index sh -> Result Checked Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh

   sizeOffset :: sh -> (Int, Index sh -> Int)
   sizeOffset sh
sh = (sh -> Int
forall sh. C sh => sh -> Int
size sh
sh, sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
offset sh
sh)
   uncheckedSizeOffset :: sh -> (Int, Index sh -> Int)
   uncheckedSizeOffset sh
sh = (sh -> Int
forall sh. C sh => sh -> Int
size sh
sh, sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
uncheckedOffset sh
sh)
   unifiedSizeOffset ::
      (Checking check) => sh -> (Int, Index sh -> Result check Int)
   unifiedSizeOffset sh
sh = (sh -> Int
forall sh. C sh => sh -> Int
size sh
sh, sh -> Index sh -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh)

class Indexed sh => InvIndexed sh where
   {-# MINIMAL unifiedIndexFromOffset #-}
   {- |
   It should hold @indexFromOffset sh k == indices sh !! k@,
   but 'indexFromOffset' should generally be faster.
   -}
   indexFromOffset :: sh -> Int -> Index sh
   indexFromOffset sh
sh = String -> Result Checked (Index sh) -> Index sh
forall a. String -> Result Checked a -> a
runChecked String
"indexFromOffset" (Result Checked (Index sh) -> Index sh)
-> (Int -> Result Checked (Index sh)) -> Int -> Index sh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Int -> Result Checked (Index sh)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh
   uncheckedIndexFromOffset :: sh -> Int -> Index sh
   uncheckedIndexFromOffset sh
sh = Result Unchecked (Index sh) -> Index sh
forall a. Result Unchecked a -> a
getUnchecked (Result Unchecked (Index sh) -> Index sh)
-> (Int -> Result Unchecked (Index sh)) -> Int -> Index sh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Int -> Result Unchecked (Index sh)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh
   unifiedIndexFromOffset ::
      (Checking check) => sh -> Int -> Result check (Index sh)

assertIndexFromOffset ::
   (Checking check) => String -> Int -> Bool -> Result check ()
assertIndexFromOffset :: String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
name Int
k Bool
cond = String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert (String -> Int -> String
messageIndexFromOffset String
name Int
k) Bool
cond

class (C sh, Eq sh) => Static sh where
   static :: sh


data Zero = Zero
   deriving (Zero -> Zero -> Bool
(Zero -> Zero -> Bool) -> (Zero -> Zero -> Bool) -> Eq Zero
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Zero -> Zero -> Bool
$c/= :: Zero -> Zero -> Bool
== :: Zero -> Zero -> Bool
$c== :: Zero -> Zero -> Bool
Eq, Eq Zero
Eq Zero
-> (Zero -> Zero -> Ordering)
-> (Zero -> Zero -> Bool)
-> (Zero -> Zero -> Bool)
-> (Zero -> Zero -> Bool)
-> (Zero -> Zero -> Bool)
-> (Zero -> Zero -> Zero)
-> (Zero -> Zero -> Zero)
-> Ord Zero
Zero -> Zero -> Bool
Zero -> Zero -> Ordering
Zero -> Zero -> Zero
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Zero -> Zero -> Zero
$cmin :: Zero -> Zero -> Zero
max :: Zero -> Zero -> Zero
$cmax :: Zero -> Zero -> Zero
>= :: Zero -> Zero -> Bool
$c>= :: Zero -> Zero -> Bool
> :: Zero -> Zero -> Bool
$c> :: Zero -> Zero -> Bool
<= :: Zero -> Zero -> Bool
$c<= :: Zero -> Zero -> Bool
< :: Zero -> Zero -> Bool
$c< :: Zero -> Zero -> Bool
compare :: Zero -> Zero -> Ordering
$ccompare :: Zero -> Zero -> Ordering
$cp1Ord :: Eq Zero
Ord, Int -> Zero -> String -> String
[Zero] -> String -> String
Zero -> String
(Int -> Zero -> String -> String)
-> (Zero -> String) -> ([Zero] -> String -> String) -> Show Zero
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Zero] -> String -> String
$cshowList :: [Zero] -> String -> String
show :: Zero -> String
$cshow :: Zero -> String
showsPrec :: Int -> Zero -> String -> String
$cshowsPrec :: Int -> Zero -> String -> String
Show)

instance C Zero where
   size :: Zero -> Int
size Zero
Zero = Int
0

instance Static Zero where
   static :: Zero
static = Zero
Zero


instance C () where
   size :: () -> Int
size () = Int
1

{- |
>>> Shape.indices ()
[()]
-}
instance Indexed () where
   type Index () = ()
   indices :: () -> [Index ()]
indices () = [()]
   unifiedOffset :: () -> Index () -> Result check Int
unifiedOffset () () = Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
   inBounds :: () -> Index () -> Bool
inBounds () () = Bool
True

instance InvIndexed () where
   unifiedIndexFromOffset :: () -> Int -> Result check (Index ())
unifiedIndexFromOffset () Int
k = String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"()" Int
k (Int
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)

instance Static () where
   static :: ()
static = ()


{- |
'ZeroBased' denotes a range starting at zero and has a certain length.

>>> Shape.indices (Shape.ZeroBased (7::Int))
[0,1,2,3,4,5,6]
-}
newtype ZeroBased n = ZeroBased {ZeroBased n -> n
zeroBasedSize :: n}
   deriving (ZeroBased n -> ZeroBased n -> Bool
(ZeroBased n -> ZeroBased n -> Bool)
-> (ZeroBased n -> ZeroBased n -> Bool) -> Eq (ZeroBased n)
forall n. Eq n => ZeroBased n -> ZeroBased n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZeroBased n -> ZeroBased n -> Bool
$c/= :: forall n. Eq n => ZeroBased n -> ZeroBased n -> Bool
== :: ZeroBased n -> ZeroBased n -> Bool
$c== :: forall n. Eq n => ZeroBased n -> ZeroBased n -> Bool
Eq, Int -> ZeroBased n -> String -> String
[ZeroBased n] -> String -> String
ZeroBased n -> String
(Int -> ZeroBased n -> String -> String)
-> (ZeroBased n -> String)
-> ([ZeroBased n] -> String -> String)
-> Show (ZeroBased n)
forall n. Show n => Int -> ZeroBased n -> String -> String
forall n. Show n => [ZeroBased n] -> String -> String
forall n. Show n => ZeroBased n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ZeroBased n] -> String -> String
$cshowList :: forall n. Show n => [ZeroBased n] -> String -> String
show :: ZeroBased n -> String
$cshow :: forall n. Show n => ZeroBased n -> String
showsPrec :: Int -> ZeroBased n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> ZeroBased n -> String -> String
Show)

instance Functor ZeroBased where
   fmap :: (a -> b) -> ZeroBased a -> ZeroBased b
fmap a -> b
f (ZeroBased a
n) = b -> ZeroBased b
forall n. n -> ZeroBased n
ZeroBased (b -> ZeroBased b) -> b -> ZeroBased b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance Applicative ZeroBased where
   pure :: a -> ZeroBased a
pure = a -> ZeroBased a
forall n. n -> ZeroBased n
ZeroBased
   ZeroBased a -> b
f <*> :: ZeroBased (a -> b) -> ZeroBased a -> ZeroBased b
<*> ZeroBased a
n = b -> ZeroBased b
forall n. n -> ZeroBased n
ZeroBased (b -> ZeroBased b) -> b -> ZeroBased b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance (NFData n) => NFData (ZeroBased n) where
   rnf :: ZeroBased n -> ()
rnf (ZeroBased n
n) = n -> ()
forall a. NFData a => a -> ()
rnf n
n

instance (Storable n) => Storable (ZeroBased n) where
   sizeOf :: ZeroBased n -> Int
sizeOf = (ZeroBased n -> n) -> ZeroBased n -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf ZeroBased n -> n
forall n. ZeroBased n -> n
zeroBasedSize
   alignment :: ZeroBased n -> Int
alignment = (ZeroBased n -> n) -> ZeroBased n -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment ZeroBased n -> n
forall n. ZeroBased n -> n
zeroBasedSize
   peek :: Ptr (ZeroBased n) -> IO (ZeroBased n)
peek = (n -> ZeroBased n) -> Ptr (ZeroBased n) -> IO (ZeroBased n)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased
   poke :: Ptr (ZeroBased n) -> ZeroBased n -> IO ()
poke = (ZeroBased n -> n) -> Ptr (ZeroBased n) -> ZeroBased n -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke ZeroBased n -> n
forall n. ZeroBased n -> n
zeroBasedSize

instance (Integral n) => C (ZeroBased n) where
   size :: ZeroBased n -> Int
size (ZeroBased n
len) = n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len

instance (Integral n) => Indexed (ZeroBased n) where
   type Index (ZeroBased n) = n
   indices :: ZeroBased n -> [Index (ZeroBased n)]
indices (ZeroBased n
len) = (n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len) ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ (n -> n) -> n -> [n]
forall a. (a -> a) -> a -> [a]
iterate (n -> n -> n
forall a. Num a => a -> a -> a
+n
1) n
0
   unifiedOffset :: ZeroBased n -> Index (ZeroBased n) -> Result check Int
unifiedOffset (ZeroBased n
len) = Shifted n -> Index (Shifted n) -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset (Shifted n -> Index (Shifted n) -> Result check Int)
-> Shifted n -> Index (Shifted n) -> Result check Int
forall a b. (a -> b) -> a -> b
$ n -> n -> Shifted n
forall n. n -> n -> Shifted n
Shifted n
0 n
len
   inBounds :: ZeroBased n -> Index (ZeroBased n) -> Bool
inBounds (ZeroBased n
len) Index (ZeroBased n)
ix = n
0n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
Index (ZeroBased n)
ix Bool -> Bool -> Bool
&& n
Index (ZeroBased n)
ixn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len

instance (Integral n) => InvIndexed (ZeroBased n) where
   unifiedIndexFromOffset :: ZeroBased n -> Int -> Result check (Index (ZeroBased n))
unifiedIndexFromOffset (ZeroBased n
len) Int
k0 = do
      let k :: n
k = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"ZeroBased" Int
k0 (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ n
0n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len
      n -> Result check n
forall (f :: * -> *) a. Applicative f => a -> f a
pure n
k

zeroBasedSplit :: (Real n) => n -> ZeroBased n -> ZeroBased n ::+ ZeroBased n
zeroBasedSplit :: n -> ZeroBased n -> ZeroBased n ::+ ZeroBased n
zeroBasedSplit n
n (ZeroBased n
m) =
   if n
nn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
0
      then String -> ZeroBased n ::+ ZeroBased n
forall a. HasCallStack => String -> a
error String
"Shape.zeroBasedSplit: negative number of elements"
      else let k :: n
k = n -> n -> n
forall a. Ord a => a -> a -> a
min n
n n
m in n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased n
k ZeroBased n -> ZeroBased n -> ZeroBased n ::+ ZeroBased n
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased (n
mn -> n -> n
forall a. Num a => a -> a -> a
-n
k)


{- |
'OneBased' denotes a range starting at one and has a certain length.

>>> Shape.indices (Shape.OneBased (7::Int))
[1,2,3,4,5,6,7]
-}
newtype OneBased n = OneBased {OneBased n -> n
oneBasedSize :: n}
   deriving (OneBased n -> OneBased n -> Bool
(OneBased n -> OneBased n -> Bool)
-> (OneBased n -> OneBased n -> Bool) -> Eq (OneBased n)
forall n. Eq n => OneBased n -> OneBased n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OneBased n -> OneBased n -> Bool
$c/= :: forall n. Eq n => OneBased n -> OneBased n -> Bool
== :: OneBased n -> OneBased n -> Bool
$c== :: forall n. Eq n => OneBased n -> OneBased n -> Bool
Eq, Int -> OneBased n -> String -> String
[OneBased n] -> String -> String
OneBased n -> String
(Int -> OneBased n -> String -> String)
-> (OneBased n -> String)
-> ([OneBased n] -> String -> String)
-> Show (OneBased n)
forall n. Show n => Int -> OneBased n -> String -> String
forall n. Show n => [OneBased n] -> String -> String
forall n. Show n => OneBased n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OneBased n] -> String -> String
$cshowList :: forall n. Show n => [OneBased n] -> String -> String
show :: OneBased n -> String
$cshow :: forall n. Show n => OneBased n -> String
showsPrec :: Int -> OneBased n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> OneBased n -> String -> String
Show)

instance Functor OneBased where
   fmap :: (a -> b) -> OneBased a -> OneBased b
fmap a -> b
f (OneBased a
n) = b -> OneBased b
forall n. n -> OneBased n
OneBased (b -> OneBased b) -> b -> OneBased b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance Applicative OneBased where
   pure :: a -> OneBased a
pure = a -> OneBased a
forall n. n -> OneBased n
OneBased
   OneBased a -> b
f <*> :: OneBased (a -> b) -> OneBased a -> OneBased b
<*> OneBased a
n = b -> OneBased b
forall n. n -> OneBased n
OneBased (b -> OneBased b) -> b -> OneBased b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance (NFData n) => NFData (OneBased n) where
   rnf :: OneBased n -> ()
rnf (OneBased n
n) = n -> ()
forall a. NFData a => a -> ()
rnf n
n

instance (Storable n) => Storable (OneBased n) where
   sizeOf :: OneBased n -> Int
sizeOf = (OneBased n -> n) -> OneBased n -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf OneBased n -> n
forall n. OneBased n -> n
oneBasedSize
   alignment :: OneBased n -> Int
alignment = (OneBased n -> n) -> OneBased n -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment OneBased n -> n
forall n. OneBased n -> n
oneBasedSize
   peek :: Ptr (OneBased n) -> IO (OneBased n)
peek = (n -> OneBased n) -> Ptr (OneBased n) -> IO (OneBased n)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek n -> OneBased n
forall n. n -> OneBased n
OneBased
   poke :: Ptr (OneBased n) -> OneBased n -> IO ()
poke = (OneBased n -> n) -> Ptr (OneBased n) -> OneBased n -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke OneBased n -> n
forall n. OneBased n -> n
oneBasedSize

instance (Integral n) => C (OneBased n) where
   size :: OneBased n -> Int
size (OneBased n
len) = n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len

instance (Integral n) => Indexed (OneBased n) where
   type Index (OneBased n) = n
   indices :: OneBased n -> [Index (OneBased n)]
indices (OneBased n
len) = (n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
len) ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ (n -> n) -> n -> [n]
forall a. (a -> a) -> a -> [a]
iterate (n -> n -> n
forall a. Num a => a -> a -> a
+n
1) n
1
   unifiedOffset :: OneBased n -> Index (OneBased n) -> Result check Int
unifiedOffset (OneBased n
len) = Shifted n -> Index (Shifted n) -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset (Shifted n -> Index (Shifted n) -> Result check Int)
-> Shifted n -> Index (Shifted n) -> Result check Int
forall a b. (a -> b) -> a -> b
$ n -> n -> Shifted n
forall n. n -> n -> Shifted n
Shifted n
1 n
len
   inBounds :: OneBased n -> Index (OneBased n) -> Bool
inBounds (OneBased n
len) Index (OneBased n)
ix = n
0n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
Index (OneBased n)
ix Bool -> Bool -> Bool
&& n
Index (OneBased n)
ixn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
len

instance (Integral n) => InvIndexed (OneBased n) where
   unifiedIndexFromOffset :: OneBased n -> Int -> Result check (Index (OneBased n))
unifiedIndexFromOffset (OneBased n
len) Int
k0 = do
      let k :: n
k = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"OneBased" Int
k0 (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ n
0n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len
      n -> Result check n
forall (f :: * -> *) a. Applicative f => a -> f a
pure (n -> Result check n) -> n -> Result check n
forall a b. (a -> b) -> a -> b
$ n
1n -> n -> n
forall a. Num a => a -> a -> a
+n
k


{- |
'Range' denotes an inclusive range like
those of the Haskell 98 standard @Array@ type from the @array@ package.
E.g. the shape type @(Range Int32, Range Int64)@
is equivalent to the ix type @(Int32, Int64)@ for @Array@s.

>>> Shape.indices (Shape.Range (-5) (5::Int))
[-5,-4,-3,-2,-1,0,1,2,3,4,5]
>>> Shape.indices (Shape.Range (-1,-1) (1::Int,1::Int))
[(-1,-1),(-1,0),(-1,1),(0,-1),(0,0),(0,1),(1,-1),(1,0),(1,1)]
-}
data Range n = Range {Range n -> n
rangeFrom, Range n -> n
rangeTo :: n}
   deriving (Range n -> Range n -> Bool
(Range n -> Range n -> Bool)
-> (Range n -> Range n -> Bool) -> Eq (Range n)
forall n. Eq n => Range n -> Range n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range n -> Range n -> Bool
$c/= :: forall n. Eq n => Range n -> Range n -> Bool
== :: Range n -> Range n -> Bool
$c== :: forall n. Eq n => Range n -> Range n -> Bool
Eq, Int -> Range n -> String -> String
[Range n] -> String -> String
Range n -> String
(Int -> Range n -> String -> String)
-> (Range n -> String)
-> ([Range n] -> String -> String)
-> Show (Range n)
forall n. Show n => Int -> Range n -> String -> String
forall n. Show n => [Range n] -> String -> String
forall n. Show n => Range n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Range n] -> String -> String
$cshowList :: forall n. Show n => [Range n] -> String -> String
show :: Range n -> String
$cshow :: forall n. Show n => Range n -> String
showsPrec :: Int -> Range n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> Range n -> String -> String
Show)

instance Functor Range where
   fmap :: (a -> b) -> Range a -> Range b
fmap a -> b
f (Range a
from a
to) = b -> b -> Range b
forall n. n -> n -> Range n
Range (a -> b
f a
from) (a -> b
f a
to)

instance (NFData n) => NFData (Range n) where
   rnf :: Range n -> ()
rnf (Range n
from n
to) = (n, n) -> ()
forall a. NFData a => a -> ()
rnf (n
from,n
to)

instance (Ix.Ix n) => C (Range n) where
   size :: Range n -> Int
size (Range n
from n
to) = (n, n) -> Int
forall a. Ix a => (a, a) -> Int
Ix.rangeSize (n
from,n
to)

instance (Ix.Ix n) => Indexed (Range n) where
   type Index (Range n) = n
   indices :: Range n -> [Index (Range n)]
indices (Range n
from n
to) = (n, n) -> [n]
forall a. Ix a => (a, a) -> [a]
Ix.range (n
from,n
to)
   offset :: Range n -> Index (Range n) -> Int
offset (Range n
from n
to) Index (Range n)
ix = (n, n) -> n -> Int
forall a. Ix a => (a, a) -> a -> Int
Ix.index (n
from,n
to) n
Index (Range n)
ix
   uncheckedOffset :: Range n -> Index (Range n) -> Int
uncheckedOffset (Range n
from n
to) Index (Range n)
ix = (n, n) -> n -> Int
forall a. Ix a => (a, a) -> a -> Int
Ix.unsafeIndex (n
from,n
to) n
Index (Range n)
ix
   unifiedOffset :: Range n -> Index (Range n) -> Result check Int
unifiedOffset (Range n
from n
to) Index (Range n)
ix = do
      String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Range: index out of range" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ (n, n) -> n -> Bool
forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (n
from,n
to) n
Index (Range n)
ix
      Int -> Result check Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ (n, n) -> n -> Int
forall a. Ix a => (a, a) -> a -> Int
Ix.unsafeIndex (n
from,n
to) n
Index (Range n)
ix
   inBounds :: Range n -> Index (Range n) -> Bool
inBounds (Range n
from n
to) Index (Range n)
ix = (n, n) -> n -> Bool
forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (n
from,n
to) n
Index (Range n)
ix

-- pretty inefficient when we rely solely on Ix
instance (Ix.Ix n) => InvIndexed (Range n) where
   unifiedIndexFromOffset :: Range n -> Int -> Result check (Index (Range n))
unifiedIndexFromOffset (Range n
from n
to) Int
k = do
      String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Range" Int
k (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (n, n) -> Int
forall a. Ix a => (a, a) -> Int
Ix.rangeSize (n
from,n
to)
      n -> Result check n
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Result check n) -> n -> Result check n
forall a b. (a -> b) -> a -> b
$ (n, n) -> [n]
forall a. Ix a => (a, a) -> [a]
Ix.range (n
from,n
to) [n] -> Int -> n
forall a. [a] -> Int -> a
!! Int
k

-- cf. sample-frame:Stereo
instance Storable n => Storable (Range n) where
   {-# INLINE sizeOf #-}
   {-# INLINE alignment #-}
   {-# INLINE peek #-}
   {-# INLINE poke #-}
   sizeOf :: Range n -> Int
sizeOf ~(Range n
l n
r) = n -> Int
forall a. Storable a => a -> Int
sizeOf n
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (- n -> Int
forall a. Storable a => a -> Int
sizeOf n
l) (n -> Int
forall a. Storable a => a -> Int
alignment n
r) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ n -> Int
forall a. Storable a => a -> Int
sizeOf n
r
   alignment :: Range n -> Int
alignment ~(Range n
l n
_) = n -> Int
forall a. Storable a => a -> Int
alignment n
l
   poke :: Ptr (Range n) -> Range n -> IO ()
poke Ptr (Range n)
p (Range n
l n
r) =
      let q :: Ptr n
q = Ptr (Range n) -> Ptr n
forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Range n)
p
      in  Ptr n -> n -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr n
q n
l IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr n -> Int -> n -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr n
q Int
1 n
r
   peek :: Ptr (Range n) -> IO (Range n)
peek Ptr (Range n)
p =
      let q :: Ptr n
q = Ptr (Range n) -> Ptr n
forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Range n)
p
      in  (n -> n -> Range n) -> IO n -> IO n -> IO (Range n)
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 n -> n -> Range n
forall n. n -> n -> Range n
Range (Ptr n -> IO n
forall a. Storable a => Ptr a -> IO a
peek Ptr n
q) (Ptr n -> Int -> IO n
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr n
q Int
1)


{- |
'Shifted' denotes a range defined by the start index and the length.

>>> Shape.indices (Shape.Shifted (-4) (8::Int))
[-4,-3,-2,-1,0,1,2,3]
-}
data Shifted n = Shifted {Shifted n -> n
shiftedOffset, Shifted n -> n
shiftedSize :: n}
   deriving (Shifted n -> Shifted n -> Bool
(Shifted n -> Shifted n -> Bool)
-> (Shifted n -> Shifted n -> Bool) -> Eq (Shifted n)
forall n. Eq n => Shifted n -> Shifted n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shifted n -> Shifted n -> Bool
$c/= :: forall n. Eq n => Shifted n -> Shifted n -> Bool
== :: Shifted n -> Shifted n -> Bool
$c== :: forall n. Eq n => Shifted n -> Shifted n -> Bool
Eq, Int -> Shifted n -> String -> String
[Shifted n] -> String -> String
Shifted n -> String
(Int -> Shifted n -> String -> String)
-> (Shifted n -> String)
-> ([Shifted n] -> String -> String)
-> Show (Shifted n)
forall n. Show n => Int -> Shifted n -> String -> String
forall n. Show n => [Shifted n] -> String -> String
forall n. Show n => Shifted n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Shifted n] -> String -> String
$cshowList :: forall n. Show n => [Shifted n] -> String -> String
show :: Shifted n -> String
$cshow :: forall n. Show n => Shifted n -> String
showsPrec :: Int -> Shifted n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> Shifted n -> String -> String
Show)

instance Functor Shifted where
   fmap :: (a -> b) -> Shifted a -> Shifted b
fmap a -> b
f (Shifted a
from a
to) = b -> b -> Shifted b
forall n. n -> n -> Shifted n
Shifted (a -> b
f a
from) (a -> b
f a
to)

instance (NFData n) => NFData (Shifted n) where
   rnf :: Shifted n -> ()
rnf (Shifted n
from n
to) = (n, n) -> ()
forall a. NFData a => a -> ()
rnf (n
from,n
to)

instance (Integral n) => C (Shifted n) where
   size :: Shifted n -> Int
size (Shifted n
_offs n
len) = n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len

instance (Integral n) => Indexed (Shifted n) where
   type Index (Shifted n) = n
   indices :: Shifted n -> [Index (Shifted n)]
indices (Shifted n
offs n
len) =
      ((n, n) -> n) -> [(n, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> n
forall a b. (a, b) -> b
snd ([(n, n)] -> [n]) -> [(n, n)] -> [n]
forall a b. (a -> b) -> a -> b
$
      ((n, n) -> Bool) -> [(n, n)] -> [(n, n)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>n
0) (n -> Bool) -> ((n, n) -> n) -> (n, n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, n) -> n
forall a b. (a, b) -> a
fst) ([(n, n)] -> [(n, n)]) -> [(n, n)] -> [(n, n)]
forall a b. (a -> b) -> a -> b
$
      [n] -> [n] -> [(n, n)]
forall a b. [a] -> [b] -> [(a, b)]
zip
         ((n -> n) -> n -> [n]
forall a. (a -> a) -> a -> [a]
iterate (n -> n -> n
forall a. Num a => a -> a -> a
subtract n
1) n
len)
         ((n -> n) -> n -> [n]
forall a. (a -> a) -> a -> [a]
iterate (n
1n -> n -> n
forall a. Num a => a -> a -> a
+) n
offs)
   unifiedOffset :: Shifted n -> Index (Shifted n) -> Result check Int
unifiedOffset (Shifted n
offs n
len) Index (Shifted n)
ix = do
      String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Shifted: array index too small" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ n
Index (Shifted n)
ixn -> n -> Bool
forall a. Ord a => a -> a -> Bool
>=n
offs
      let k :: n
k = n
Index (Shifted n)
ixn -> n -> n
forall a. Num a => a -> a -> a
-n
offs
      String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Shifted: array index too big" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ n
kn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len
      Int -> Result check Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
k
   inBounds :: Shifted n -> Index (Shifted n) -> Bool
inBounds (Shifted n
offs n
len) Index (Shifted n)
ix = n
offs n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
Index (Shifted n)
ix Bool -> Bool -> Bool
&& n
Index (Shifted n)
ix n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
offsn -> n -> n
forall a. Num a => a -> a -> a
+n
len

instance (Integral n) => InvIndexed (Shifted n) where
   unifiedIndexFromOffset :: Shifted n -> Int -> Result check (Index (Shifted n))
unifiedIndexFromOffset (Shifted n
offs n
len) Int
k0 = do
      let k :: n
k = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Shifted" Int
k0 (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ n
0n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len
      n -> Result check n
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Result check n) -> n -> Result check n
forall a b. (a -> b) -> a -> b
$ n
offsn -> n -> n
forall a. Num a => a -> a -> a
+n
k

-- cf. sample-frame:Stereo
instance Storable n => Storable (Shifted n) where
   {-# INLINE sizeOf #-}
   {-# INLINE alignment #-}
   {-# INLINE peek #-}
   {-# INLINE poke #-}
   sizeOf :: Shifted n -> Int
sizeOf ~(Shifted n
l n
n) = n -> Int
forall a. Storable a => a -> Int
sizeOf n
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (- n -> Int
forall a. Storable a => a -> Int
sizeOf n
l) (n -> Int
forall a. Storable a => a -> Int
alignment n
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ n -> Int
forall a. Storable a => a -> Int
sizeOf n
n
   alignment :: Shifted n -> Int
alignment ~(Shifted n
l n
_) = n -> Int
forall a. Storable a => a -> Int
alignment n
l
   poke :: Ptr (Shifted n) -> Shifted n -> IO ()
poke Ptr (Shifted n)
p (Shifted n
l n
n) =
      let q :: Ptr n
q = Ptr (Shifted n) -> Ptr n
forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Shifted n)
p
      in  Ptr n -> n -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr n
q n
l IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr n -> Int -> n -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr n
q Int
1 n
n
   peek :: Ptr (Shifted n) -> IO (Shifted n)
peek Ptr (Shifted n)
p =
      let q :: Ptr n
q = Ptr (Shifted n) -> Ptr n
forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Shifted n)
p
      in  (n -> n -> Shifted n) -> IO n -> IO n -> IO (Shifted n)
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 n -> n -> Shifted n
forall n. n -> n -> Shifted n
Shifted (Ptr n -> IO n
forall a. Storable a => Ptr a -> IO a
peek Ptr n
q) (Ptr n -> Int -> IO n
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr n
q Int
1)


{-# INLINE castToElemPtr #-}
castToElemPtr :: Ptr (f a) -> Ptr a
castToElemPtr :: Ptr (f a) -> Ptr a
castToElemPtr = Ptr (f a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr



{- |
'Enumeration' denotes a shape of fixed size
that is defined by 'Enum' and 'Bounded' methods.
For correctness it is necessary that the 'Enum' and 'Bounded' instances
are properly implemented.
Automatically derived instances are fine.

>>> Shape.indices (Shape.Enumeration :: Shape.Enumeration Ordering)
[LT,EQ,GT]
-}
data Enumeration n = Enumeration
   deriving (Enumeration n -> Enumeration n -> Bool
(Enumeration n -> Enumeration n -> Bool)
-> (Enumeration n -> Enumeration n -> Bool) -> Eq (Enumeration n)
forall n. Enumeration n -> Enumeration n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Enumeration n -> Enumeration n -> Bool
$c/= :: forall n. Enumeration n -> Enumeration n -> Bool
== :: Enumeration n -> Enumeration n -> Bool
$c== :: forall n. Enumeration n -> Enumeration n -> Bool
Eq, Int -> Enumeration n -> String -> String
[Enumeration n] -> String -> String
Enumeration n -> String
(Int -> Enumeration n -> String -> String)
-> (Enumeration n -> String)
-> ([Enumeration n] -> String -> String)
-> Show (Enumeration n)
forall n. Int -> Enumeration n -> String -> String
forall n. [Enumeration n] -> String -> String
forall n. Enumeration n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Enumeration n] -> String -> String
$cshowList :: forall n. [Enumeration n] -> String -> String
show :: Enumeration n -> String
$cshow :: forall n. Enumeration n -> String
showsPrec :: Int -> Enumeration n -> String -> String
$cshowsPrec :: forall n. Int -> Enumeration n -> String -> String
Show)

instance NFData (Enumeration n) where
   rnf :: Enumeration n -> ()
rnf Enumeration n
Enumeration = ()

instance (Enum n, Bounded n) => C (Enumeration n) where
   size :: Enumeration n -> Int
size Enumeration n
sh = Enumeration n -> n -> Int
forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh n
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Enumeration n -> n -> Int
forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh n
forall a. Bounded a => a
minBound Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

instance (Enum n, Bounded n) => Indexed (Enumeration n) where
   type Index (Enumeration n) = n
   indices :: Enumeration n -> [Index (Enumeration n)]
indices Enumeration n
sh = [Enumeration n -> n -> n
forall n. Enumeration n -> n -> n
asEnumType Enumeration n
sh n
forall a. Bounded a => a
minBound .. Enumeration n -> n -> n
forall n. Enumeration n -> n -> n
asEnumType Enumeration n
sh n
forall a. Bounded a => a
maxBound]
   unifiedOffset :: Enumeration n -> Index (Enumeration n) -> Result check Int
unifiedOffset Enumeration n
sh Index (Enumeration n)
ix = Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ n -> Int
forall a. Enum a => a -> Int
fromEnum n
Index (Enumeration n)
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Enumeration n -> n -> Int
forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh n
forall a. Bounded a => a
minBound
   inBounds :: Enumeration n -> Index (Enumeration n) -> Bool
inBounds Enumeration n
_sh Index (Enumeration n)
_ix = Bool
True

instance (Enum n, Bounded n) => InvIndexed (Enumeration n) where
   unifiedIndexFromOffset :: Enumeration n -> Int -> Result check (Index (Enumeration n))
unifiedIndexFromOffset Enumeration n
sh Int
k = do
      let minBnd :: Int
minBnd = Enumeration n -> n -> Int
forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh n
forall a. Bounded a => a
minBound
      String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Enumeration" Int
k (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$
         Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Enumeration n -> n -> Int
forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh n
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minBnd
      n -> Result check n
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Result check n) -> n -> Result check n
forall a b. (a -> b) -> a -> b
$ Int -> n
forall a. Enum a => Int -> a
toEnum (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ Int
minBnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k

asEnumType :: Enumeration n -> n -> n
asEnumType :: Enumeration n -> n -> n
asEnumType Enumeration n
Enumeration = n -> n
forall a. a -> a
id

intFromEnum :: (Enum n) => Enumeration n -> n -> Int
intFromEnum :: Enumeration n -> n -> Int
intFromEnum Enumeration n
Enumeration = n -> Int
forall a. Enum a => a -> Int
fromEnum

instance (Enum n, Bounded n) => Static (Enumeration n) where
   static :: Enumeration n
static = Enumeration n
forall n. Enumeration n
Enumeration

instance Storable (Enumeration n) where
   {-# INLINE sizeOf #-}
   {-# INLINE alignment #-}
   {-# INLINE peek #-}
   {-# INLINE poke #-}
   sizeOf :: Enumeration n -> Int
sizeOf ~Enumeration n
Enumeration = Int
0
   alignment :: Enumeration n -> Int
alignment ~Enumeration n
Enumeration = Int
1
   poke :: Ptr (Enumeration n) -> Enumeration n -> IO ()
poke Ptr (Enumeration n)
_p Enumeration n
Enumeration = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   peek :: Ptr (Enumeration n) -> IO (Enumeration n)
peek Ptr (Enumeration n)
_p = Enumeration n -> IO (Enumeration n)
forall (m :: * -> *) a. Monad m => a -> m a
return Enumeration n
forall n. Enumeration n
Enumeration


instance (Ord n) => C (Set n) where
   size :: Set n -> Int
size = Set n -> Int
forall a. Set a -> Int
Set.size

{- |
You can use an arbitrary 'Set' of indices as shape.
The array elements are ordered according to the index order in the 'Set'.

Disadvantage is that combinators of different Set indexed arrays
have to compare whole sets.
However, the Set implementation may have low-level optimizations
for pointer equality.

>>> Shape.indices (Set.fromList "comfort")
"cfmort"
-}
instance (Ord n) => Indexed (Set n) where
   type Index (Set n) = n
   indices :: Set n -> [Index (Set n)]
indices = Set n -> [Index (Set n)]
forall a. Set a -> [a]
Set.toAscList
   unifiedOffset :: Set n -> Index (Set n) -> Result check Int
unifiedOffset Set n
sh Index (Set n)
ix = (CheckSingleton check -> Result check Int) -> Result check Int
forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck ((CheckSingleton check -> Result check Int) -> Result check Int)
-> (CheckSingleton check -> Result check Int) -> Result check Int
forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
      case CheckSingleton check
check of
         CheckSingleton check
Unchecked -> Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ Set n -> n -> Int
forall a. Ord a => Set a -> a -> Int
ShapeSet.uncheckedOffset Set n
sh n
Index (Set n)
ix
         CheckSingleton check
Checked ->
            case Set n -> n -> Maybe Int
forall a. Ord a => Set a -> a -> Maybe Int
ShapeSet.offset Set n
sh n
Index (Set n)
ix of
               Just Int
k -> Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
k
               Maybe Int
Nothing ->
                  String -> Result Checked Int
forall a. String -> Result Checked a
throw String
"Shape.Set: array index not member of the index set"
   inBounds :: Set n -> Index (Set n) -> Bool
inBounds = (n -> Set n -> Bool) -> Set n -> n -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip n -> Set n -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member

instance (Ord n) => InvIndexed (Set n) where
   unifiedIndexFromOffset :: Set n -> Int -> Result check (Index (Set n))
unifiedIndexFromOffset Set n
sh Int
k = (CheckSingleton check -> Result check n) -> Result check n
forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck ((CheckSingleton check -> Result check n) -> Result check n)
-> (CheckSingleton check -> Result check n) -> Result check n
forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
      case CheckSingleton check
check of
         CheckSingleton check
Unchecked -> n -> Result check n
forall (f :: * -> *) a. Applicative f => a -> f a
pure (n -> Result check n) -> n -> Result check n
forall a b. (a -> b) -> a -> b
$ Set n -> Int -> n
forall a. Set a -> Int -> a
ShapeSet.uncheckedIndexFromOffset Set n
sh Int
k
         CheckSingleton check
Checked ->
            case Set n -> Int -> Maybe n
forall a. Set a -> Int -> Maybe a
ShapeSet.indexFromOffset Set n
sh Int
k of
               Just n
ix -> n -> Result check n
forall (f :: * -> *) a. Applicative f => a -> f a
pure n
ix
               Maybe n
Nothing -> String -> Result Checked n
forall a. String -> Result Checked a
throw (String -> Result Checked n) -> String -> Result Checked n
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Set" Int
k


{- |
Concatenate many arrays according to the shapes stored in a 'Map'.
-}
instance (Ord k, C shape) => C (Map k shape) where
   size :: Map k shape -> Int
size = Map k Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum (Map k Int -> Int)
-> (Map k shape -> Map k Int) -> Map k shape -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (shape -> Int) -> Map k shape -> Map k Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map shape -> Int
forall sh. C sh => sh -> Int
size

{- |
The implementations of 'offset' et.al.
are optimized for frequent calls with respect to the same shape.

>>> Shape.indices $ fmap Shape.ZeroBased $ Map.fromList [('b', (0::Int)), ('a', 5), ('c', 2)]
[('a',0),('a',1),('a',2),('a',3),('a',4),('c',0),('c',1)]
-}
instance (Ord k, Indexed shape) => Indexed (Map k shape) where
   type Index (Map k shape) = (k, Index shape)
   indices :: Map k shape -> [Index (Map k shape)]
indices =
      Map k [(k, Index shape)] -> [(k, Index shape)]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Fold.fold (Map k [(k, Index shape)] -> [(k, Index shape)])
-> (Map k shape -> Map k [(k, Index shape)])
-> Map k shape
-> [(k, Index shape)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> shape -> [(k, Index shape)])
-> Map k shape -> Map k [(k, Index shape)]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\k
k shape
shape -> (Index shape -> (k, Index shape))
-> [Index shape] -> [(k, Index shape)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) k
k) ([Index shape] -> [(k, Index shape)])
-> [Index shape] -> [(k, Index shape)]
forall a b. (a -> b) -> a -> b
$ shape -> [Index shape]
forall sh. Indexed sh => sh -> [Index sh]
indices shape
shape)
   unifiedOffset :: Map k shape -> Index (Map k shape) -> Result check Int
unifiedOffset Map k shape
m =
      let ms :: Map k (Int, Index shape -> Result check Int)
ms = (shape -> (Int, Index shape -> Result check Int))
-> Map k shape -> Map k (Int, Index shape -> Result check Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap shape -> (Int, Index shape -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset Map k shape
m
          mu :: Map k (Int, Index shape -> Result check Int)
mu = (Int, Map k (Int, Index shape -> Result check Int))
-> Map k (Int, Index shape -> Result check Int)
forall a b. (a, b) -> b
snd ((Int, Map k (Int, Index shape -> Result check Int))
 -> Map k (Int, Index shape -> Result check Int))
-> (Int, Map k (Int, Index shape -> Result check Int))
-> Map k (Int, Index shape -> Result check Int)
forall a b. (a -> b) -> a -> b
$
            (Int
 -> (Int, Index shape -> Result check Int)
 -> (Int, (Int, Index shape -> Result check Int)))
-> Int
-> Map k (Int, Index shape -> Result check Int)
-> (Int, Map k (Int, Index shape -> Result check Int))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Trav.mapAccumL (\Int
l (Int
sz,Index shape -> Result check Int
getOffset) -> (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz, (Int
l,Index shape -> Result check Int
getOffset))) Int
0 Map k (Int, Index shape -> Result check Int)
ms
      in \(k,ix) ->
         case k
-> Map k (Int, Index shape -> Result check Int)
-> Maybe (Int, Index shape -> Result check Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Int, Index shape -> Result check Int)
mu of
            Maybe (Int, Index shape -> Result check Int)
Nothing -> String -> Result check Int
forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.Map.offset: unknown key"
            Just (Int
l,Index shape -> Result check Int
getOffset) -> (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Result check Int -> Result check Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index shape -> Result check Int
getOffset Index shape
ix
   inBounds :: Map k shape -> Index (Map k shape) -> Bool
inBounds Map k shape
m (k,ix) = (shape -> Bool) -> Maybe shape -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Fold.any ((shape -> Index shape -> Bool) -> Index shape -> shape -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip shape -> Index shape -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds Index shape
ix) (Maybe shape -> Bool) -> Maybe shape -> Bool
forall a b. (a -> b) -> a -> b
$ k -> Map k shape -> Maybe shape
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k shape
m

   unifiedSizeOffset :: Map k shape -> (Int, Index (Map k shape) -> Result check Int)
unifiedSizeOffset = Map k (Int, Index shape -> Result check Int)
-> (Int, (k, Index shape) -> Result check Int)
forall check k i ix.
(Checking check, Ord k, Num i) =>
Map k (i, ix -> Result check i) -> (i, (k, ix) -> Result check i)
mapSizeOffset (Map k (Int, Index shape -> Result check Int)
 -> (Int, (k, Index shape) -> Result check Int))
-> (Map k shape -> Map k (Int, Index shape -> Result check Int))
-> Map k shape
-> (Int, (k, Index shape) -> Result check Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (shape -> (Int, Index shape -> Result check Int))
-> Map k shape -> Map k (Int, Index shape -> Result check Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap shape -> (Int, Index shape -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset

{-# INLINE mapSizeOffset #-}
mapSizeOffset ::
   (Checking check, Ord k, Num i) =>
   Map k (i, ix -> Result check i) -> (i, (k, ix) -> Result check i)
mapSizeOffset :: Map k (i, ix -> Result check i) -> (i, (k, ix) -> Result check i)
mapSizeOffset Map k (i, ix -> Result check i)
ms =
   (Map k i -> i
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum (Map k i -> i) -> Map k i -> i
forall a b. (a -> b) -> a -> b
$ ((i, ix -> Result check i) -> i)
-> Map k (i, ix -> Result check i) -> Map k i
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (i, ix -> Result check i) -> i
forall a b. (a, b) -> a
fst Map k (i, ix -> Result check i)
ms,
    let mu :: Map k (ix -> Result check i)
mu = (i, Map k (ix -> Result check i)) -> Map k (ix -> Result check i)
forall a b. (a, b) -> b
snd ((i, Map k (ix -> Result check i)) -> Map k (ix -> Result check i))
-> (i, Map k (ix -> Result check i))
-> Map k (ix -> Result check i)
forall a b. (a -> b) -> a -> b
$
         (i -> (i, ix -> Result check i) -> (i, ix -> Result check i))
-> i
-> Map k (i, ix -> Result check i)
-> (i, Map k (ix -> Result check i))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Trav.mapAccumL (\i
l (i
sz,ix -> Result check i
offs) -> (i
l i -> i -> i
forall a. Num a => a -> a -> a
+ i
sz, (i -> i) -> Result check i -> Result check i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i
li -> i -> i
forall a. Num a => a -> a -> a
+) (Result check i -> Result check i)
-> (ix -> Result check i) -> ix -> Result check i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> Result check i
offs)) i
0 Map k (i, ix -> Result check i)
ms
    in \(k
k,ix
ix) ->
         Result check i
-> ((ix -> Result check i) -> Result check i)
-> Maybe (ix -> Result check i)
-> Result check i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (String -> Result check i
forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.Map.sizeOffset: unknown key")
            ((ix -> Result check i) -> ix -> Result check i
forall a b. (a -> b) -> a -> b
$ix
ix)
            (k -> Map k (ix -> Result check i) -> Maybe (ix -> Result check i)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (ix -> Result check i)
mu))

instance (Ord k, InvIndexed shape) => InvIndexed (Map k shape) where
   unifiedIndexFromOffset :: Map k shape -> Int -> Result check (Index (Map k shape))
unifiedIndexFromOffset Map k shape
m Int
i =
      (\[(Int, Result check (k, Index shape))]
xs ->
         case [(Int, Result check (k, Index shape))]
xs of
            (Int
_u,Result check (k, Index shape)
ix):[(Int, Result check (k, Index shape))]
_ -> Result check (k, Index shape)
ix
            [] -> String -> Result check (k, Index shape)
forall check a. Checking check => String -> Result check a
throwOrError (String -> Result check (k, Index shape))
-> String -> Result check (k, Index shape)
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Map" Int
i) ([(Int, Result check (k, Index shape))]
 -> Result check (k, Index shape))
-> [(Int, Result check (k, Index shape))]
-> Result check (k, Index shape)
forall a b. (a -> b) -> a -> b
$
      ((Int, Result check (k, Index shape)) -> Bool)
-> [(Int, Result check (k, Index shape))]
-> [(Int, Result check (k, Index shape))]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
u,Result check (k, Index shape)
_ix) -> Int
uInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
i) ([(Int, Result check (k, Index shape))]
 -> [(Int, Result check (k, Index shape))])
-> [(Int, Result check (k, Index shape))]
-> [(Int, Result check (k, Index shape))]
forall a b. (a -> b) -> a -> b
$ (Int, [(Int, Result check (k, Index shape))])
-> [(Int, Result check (k, Index shape))]
forall a b. (a, b) -> b
snd ((Int, [(Int, Result check (k, Index shape))])
 -> [(Int, Result check (k, Index shape))])
-> (Int, [(Int, Result check (k, Index shape))])
-> [(Int, Result check (k, Index shape))]
forall a b. (a -> b) -> a -> b
$
      (Int -> (k, shape) -> (Int, (Int, Result check (k, Index shape))))
-> Int
-> [(k, shape)]
-> (Int, [(Int, Result check (k, Index shape))])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
List.mapAccumL
         (\Int
l (k
k,shape
sh) ->
            let u :: Int
u = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ shape -> Int
forall sh. C sh => sh -> Int
size shape
sh
            in (Int
u, (Int
u, (,) k
k (Index shape -> (k, Index shape))
-> Result check (Index shape) -> Result check (k, Index shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> shape -> Int -> Result check (Index shape)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset shape
sh (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l)))) Int
0 ([(k, shape)] -> (Int, [(Int, Result check (k, Index shape))]))
-> [(k, shape)] -> (Int, [(Int, Result check (k, Index shape))])
forall a b. (a -> b) -> a -> b
$
      Map k shape -> [(k, shape)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k shape
m



{- |
This data type wraps another array shape.
Its index type is a wrapped 'Int'.
The advantages are:
No conversion forth and back 'Int' and @Index sh@.
You can convert once using 'deferIndex' and 'revealIndex'
whenever you need your application specific index type.
No need for e.g. @Storable (Index sh)@, because 'Int' is already 'Storable'.
You get 'Indexed' and 'InvIndexed' instances
without the need for an 'Index' type.
The disadvantage is:
A deferred index should be bound to a specific shape, but this is not checked.
That is, you may obtain a deferred index for one shape
and accidentally abuse it for another shape without a warning.

Example:

>>> :{
let sh2 = (Shape.ZeroBased (2::Int), Shape.ZeroBased (2::Int)) in
let sh3 = (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int)) in
(Shape.offset sh3 $ Shape.indexFromOffset sh2 3,
 Shape.offset (Shape.Deferred sh3) $
   Shape.indexFromOffset (Shape.Deferred sh2) 3)
:}
(4,3)
-}
newtype Deferred sh = Deferred sh
   deriving (Deferred sh -> Deferred sh -> Bool
(Deferred sh -> Deferred sh -> Bool)
-> (Deferred sh -> Deferred sh -> Bool) -> Eq (Deferred sh)
forall sh. Eq sh => Deferred sh -> Deferred sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Deferred sh -> Deferred sh -> Bool
$c/= :: forall sh. Eq sh => Deferred sh -> Deferred sh -> Bool
== :: Deferred sh -> Deferred sh -> Bool
$c== :: forall sh. Eq sh => Deferred sh -> Deferred sh -> Bool
Eq, Int -> Deferred sh -> String -> String
[Deferred sh] -> String -> String
Deferred sh -> String
(Int -> Deferred sh -> String -> String)
-> (Deferred sh -> String)
-> ([Deferred sh] -> String -> String)
-> Show (Deferred sh)
forall sh. Show sh => Int -> Deferred sh -> String -> String
forall sh. Show sh => [Deferred sh] -> String -> String
forall sh. Show sh => Deferred sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Deferred sh] -> String -> String
$cshowList :: forall sh. Show sh => [Deferred sh] -> String -> String
show :: Deferred sh -> String
$cshow :: forall sh. Show sh => Deferred sh -> String
showsPrec :: Int -> Deferred sh -> String -> String
$cshowsPrec :: forall sh. Show sh => Int -> Deferred sh -> String -> String
Show)

{- |
'DeferredIndex' has an 'Ord' instance
that is based on the storage order in memory.
This way, you can put 'DeferredIndex' values
in a 'Set' or use them as keys in a 'Map'
even if @Index sh@ has no 'Ord' instance.
The downside is, that the ordering of @DeferredIndex sh@
may differ from the one of @Index sh@.
-}
newtype DeferredIndex sh = DeferredIndex Int
   deriving (DeferredIndex sh -> DeferredIndex sh -> Bool
(DeferredIndex sh -> DeferredIndex sh -> Bool)
-> (DeferredIndex sh -> DeferredIndex sh -> Bool)
-> Eq (DeferredIndex sh)
forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c/= :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
== :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c== :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
Eq, Eq (DeferredIndex sh)
Eq (DeferredIndex sh)
-> (DeferredIndex sh -> DeferredIndex sh -> Ordering)
-> (DeferredIndex sh -> DeferredIndex sh -> Bool)
-> (DeferredIndex sh -> DeferredIndex sh -> Bool)
-> (DeferredIndex sh -> DeferredIndex sh -> Bool)
-> (DeferredIndex sh -> DeferredIndex sh -> Bool)
-> (DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh)
-> (DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh)
-> Ord (DeferredIndex sh)
DeferredIndex sh -> DeferredIndex sh -> Bool
DeferredIndex sh -> DeferredIndex sh -> Ordering
DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
forall sh. Eq (DeferredIndex sh)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
forall sh. DeferredIndex sh -> DeferredIndex sh -> Ordering
forall sh. DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
min :: DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
$cmin :: forall sh. DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
max :: DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
$cmax :: forall sh. DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
>= :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c>= :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
> :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c> :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
<= :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c<= :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
< :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c< :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
compare :: DeferredIndex sh -> DeferredIndex sh -> Ordering
$ccompare :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Ordering
$cp1Ord :: forall sh. Eq (DeferredIndex sh)
Ord, Int -> DeferredIndex sh -> String -> String
[DeferredIndex sh] -> String -> String
DeferredIndex sh -> String
(Int -> DeferredIndex sh -> String -> String)
-> (DeferredIndex sh -> String)
-> ([DeferredIndex sh] -> String -> String)
-> Show (DeferredIndex sh)
forall sh. Int -> DeferredIndex sh -> String -> String
forall sh. [DeferredIndex sh] -> String -> String
forall sh. DeferredIndex sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DeferredIndex sh] -> String -> String
$cshowList :: forall sh. [DeferredIndex sh] -> String -> String
show :: DeferredIndex sh -> String
$cshow :: forall sh. DeferredIndex sh -> String
showsPrec :: Int -> DeferredIndex sh -> String -> String
$cshowsPrec :: forall sh. Int -> DeferredIndex sh -> String -> String
Show)

instance (NFData sh) => NFData (Deferred sh) where
   rnf :: Deferred sh -> ()
rnf (Deferred sh
sh) = sh -> ()
forall a. NFData a => a -> ()
rnf sh
sh

instance (C sh) => C (Deferred sh) where
   size :: Deferred sh -> Int
size (Deferred sh
sh) = sh -> Int
forall sh. C sh => sh -> Int
size sh
sh

instance (C sh) => Indexed (Deferred sh) where
   type Index (Deferred sh) = DeferredIndex sh
   indices :: Deferred sh -> [Index (Deferred sh)]
indices (Deferred sh
sh) = (Int -> DeferredIndex sh) -> [Int] -> [DeferredIndex sh]
forall a b. (a -> b) -> [a] -> [b]
map Int -> DeferredIndex sh
forall sh. Int -> DeferredIndex sh
DeferredIndex ([Int] -> [DeferredIndex sh]) -> [Int] -> [DeferredIndex sh]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (sh -> Int
forall sh. C sh => sh -> Int
size sh
sh) [Int
0 ..]
   unifiedOffset :: Deferred sh -> Index (Deferred sh) -> Result check Int
unifiedOffset (Deferred sh
sh) (DeferredIndex k) = (CheckSingleton check -> Result check Int) -> Result check Int
forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck ((CheckSingleton check -> Result check Int) -> Result check Int)
-> (CheckSingleton check -> Result check Int) -> Result check Int
forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
      case CheckSingleton check
check of
         CheckSingleton check
Checked -> ZeroBased Int -> Index (ZeroBased Int) -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset (Int -> ZeroBased Int
forall n. n -> ZeroBased n
ZeroBased (Int -> ZeroBased Int) -> Int -> ZeroBased Int
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
size sh
sh) Int
Index (ZeroBased Int)
k
         CheckSingleton check
Unchecked -> Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
k
   unifiedSizeOffset :: Deferred sh -> (Int, Index (Deferred sh) -> Result check Int)
unifiedSizeOffset (Deferred sh
sh) =
      ((Int -> Result check Int) -> DeferredIndex sh -> Result check Int)
-> (Int, Int -> Result check Int)
-> (Int, DeferredIndex sh -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\Int -> Result check Int
offs (DeferredIndex Int
k) -> Int -> Result check Int
offs Int
k) ((Int, Int -> Result check Int)
 -> (Int, DeferredIndex sh -> Result check Int))
-> (Int, Int -> Result check Int)
-> (Int, DeferredIndex sh -> Result check Int)
forall a b. (a -> b) -> a -> b
$
      ZeroBased Int -> (Int, Index (ZeroBased Int) -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset (Int -> ZeroBased Int
forall n. n -> ZeroBased n
ZeroBased (Int -> ZeroBased Int) -> Int -> ZeroBased Int
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
size sh
sh)
   inBounds :: Deferred sh -> Index (Deferred sh) -> Bool
inBounds (Deferred sh
sh) (DeferredIndex k) =
      ZeroBased Int -> Index (ZeroBased Int) -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (Int -> ZeroBased Int
forall n. n -> ZeroBased n
ZeroBased (Int -> ZeroBased Int) -> Int -> ZeroBased Int
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
size sh
sh) Int
Index (ZeroBased Int)
k

instance (C sh) => InvIndexed (Deferred sh) where
   indexFromOffset :: Deferred sh -> Int -> Index (Deferred sh)
indexFromOffset (Deferred sh
sh) Int
k =
      Int -> DeferredIndex sh
forall sh. Int -> DeferredIndex sh
DeferredIndex (Int -> DeferredIndex sh) -> Int -> DeferredIndex sh
forall a b. (a -> b) -> a -> b
$ ZeroBased Int -> Int -> Index (ZeroBased Int)
forall sh. InvIndexed sh => sh -> Int -> Index sh
indexFromOffset (Int -> ZeroBased Int
forall n. n -> ZeroBased n
ZeroBased (Int -> ZeroBased Int) -> Int -> ZeroBased Int
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
size sh
sh) Int
k
   uncheckedIndexFromOffset :: Deferred sh -> Int -> Index (Deferred sh)
uncheckedIndexFromOffset Deferred sh
_sh = Int -> Index (Deferred sh)
forall sh. Int -> DeferredIndex sh
DeferredIndex
   unifiedIndexFromOffset :: Deferred sh -> Int -> Result check (Index (Deferred sh))
unifiedIndexFromOffset (Deferred sh
sh) Int
k = (CheckSingleton check -> Result check (DeferredIndex sh))
-> Result check (DeferredIndex sh)
forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck ((CheckSingleton check -> Result check (DeferredIndex sh))
 -> Result check (DeferredIndex sh))
-> (CheckSingleton check -> Result check (DeferredIndex sh))
-> Result check (DeferredIndex sh)
forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
      case CheckSingleton check
check of
         CheckSingleton check
Unchecked -> DeferredIndex sh -> Result check (DeferredIndex sh)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeferredIndex sh -> Result check (DeferredIndex sh))
-> DeferredIndex sh -> Result check (DeferredIndex sh)
forall a b. (a -> b) -> a -> b
$ Int -> DeferredIndex sh
forall sh. Int -> DeferredIndex sh
DeferredIndex Int
k
         CheckSingleton check
Checked ->
            Int -> DeferredIndex sh
forall sh. Int -> DeferredIndex sh
DeferredIndex (Int -> DeferredIndex sh)
-> Result check Int -> Result check (DeferredIndex sh)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZeroBased Int -> Int -> Result check (Index (ZeroBased Int))
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (Int -> ZeroBased Int
forall n. n -> ZeroBased n
ZeroBased (Int -> ZeroBased Int) -> Int -> ZeroBased Int
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
size sh
sh) Int
k

deferIndex :: (Indexed sh, Index sh ~ ix) => sh -> ix -> DeferredIndex sh
deferIndex :: sh -> ix -> DeferredIndex sh
deferIndex sh
sh ix
ix = Int -> DeferredIndex sh
forall sh. Int -> DeferredIndex sh
DeferredIndex (Int -> DeferredIndex sh) -> Int -> DeferredIndex sh
forall a b. (a -> b) -> a -> b
$ sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
offset sh
sh ix
Index sh
ix

revealIndex :: (InvIndexed sh, Index sh ~ ix) => sh -> DeferredIndex sh -> ix
revealIndex :: sh -> DeferredIndex sh -> ix
revealIndex sh
sh (DeferredIndex Int
ix) = sh -> Int -> Index sh
forall sh. InvIndexed sh => sh -> Int -> Index sh
indexFromOffset sh
sh Int
ix

instance (Static sh) => Static (Deferred sh) where
   static :: Deferred sh
static = sh -> Deferred sh
forall sh. sh -> Deferred sh
Deferred sh
forall sh. Static sh => sh
static

instance Storable (DeferredIndex sh) where
   {-# INLINE sizeOf #-}
   {-# INLINE alignment #-}
   {-# INLINE peek #-}
   {-# INLINE poke #-}
   sizeOf :: DeferredIndex sh -> Int
sizeOf (DeferredIndex Int
k) = Int -> Int
forall a. Storable a => a -> Int
sizeOf Int
k
   alignment :: DeferredIndex sh -> Int
alignment (DeferredIndex Int
k) = Int -> Int
forall a. Storable a => a -> Int
alignment Int
k
   poke :: Ptr (DeferredIndex sh) -> DeferredIndex sh -> IO ()
poke Ptr (DeferredIndex sh)
p (DeferredIndex Int
k) = Ptr Int -> Int -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (DeferredIndex sh) -> Ptr Int
forall a b. Ptr a -> Ptr b
castPtr Ptr (DeferredIndex sh)
p) Int
k
   peek :: Ptr (DeferredIndex sh) -> IO (DeferredIndex sh)
peek Ptr (DeferredIndex sh)
p = (Int -> DeferredIndex sh) -> IO Int -> IO (DeferredIndex sh)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DeferredIndex sh
forall sh. Int -> DeferredIndex sh
DeferredIndex (IO Int -> IO (DeferredIndex sh))
-> IO Int -> IO (DeferredIndex sh)
forall a b. (a -> b) -> a -> b
$ Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek (Ptr (DeferredIndex sh) -> Ptr Int
forall a b. Ptr a -> Ptr b
castPtr Ptr (DeferredIndex sh)
p)



instance (C sh) => C (Tagged s sh) where
   size :: Tagged s sh -> Int
size (Tagged sh
sh) = sh -> Int
forall sh. C sh => sh -> Int
size sh
sh

instance (Indexed sh) => Indexed (Tagged s sh) where
   type Index (Tagged s sh) = Tagged s (Index sh)
   indices :: Tagged s sh -> [Index (Tagged s sh)]
indices (Tagged sh
sh) = (Index sh -> Tagged s (Index sh))
-> [Index sh] -> [Tagged s (Index sh)]
forall a b. (a -> b) -> [a] -> [b]
map Index sh -> Tagged s (Index sh)
forall k (s :: k) b. b -> Tagged s b
Tagged ([Index sh] -> [Tagged s (Index sh)])
-> [Index sh] -> [Tagged s (Index sh)]
forall a b. (a -> b) -> a -> b
$ sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
indices sh
sh
   unifiedOffset :: Tagged s sh -> Index (Tagged s sh) -> Result check Int
unifiedOffset (Tagged sh
sh) = sh -> Index sh -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh (Index sh -> Result check Int)
-> (Tagged s (Index sh) -> Index sh)
-> Tagged s (Index sh)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged s (Index sh) -> Index sh
forall k (s :: k) b. Tagged s b -> b
unTagged
   unifiedSizeOffset :: Tagged s sh -> (Int, Index (Tagged s sh) -> Result check Int)
unifiedSizeOffset (Tagged sh
sh) =
      ((Index sh -> Result check Int)
 -> Tagged s (Index sh) -> Result check Int)
-> (Int, Index sh -> Result check Int)
-> (Int, Tagged s (Index sh) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh -> Result check Int)
-> (Tagged s (Index sh) -> Index sh)
-> Tagged s (Index sh)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged s (Index sh) -> Index sh
forall k (s :: k) b. Tagged s b -> b
unTagged) ((Int, Index sh -> Result check Int)
 -> (Int, Tagged s (Index sh) -> Result check Int))
-> (Int, Index sh -> Result check Int)
-> (Int, Tagged s (Index sh) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh -> (Int, Index sh -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
   inBounds :: Tagged s sh -> Index (Tagged s sh) -> Bool
inBounds (Tagged sh
sh) (Tagged k) = sh -> Index sh -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh
sh Index sh
k

instance (InvIndexed sh) => InvIndexed (Tagged s sh) where
   unifiedIndexFromOffset :: Tagged s sh -> Int -> Result check (Index (Tagged s sh))
unifiedIndexFromOffset (Tagged sh
sh) Int
k =
      Index sh -> Tagged s (Index sh)
forall k (s :: k) b. b -> Tagged s b
Tagged (Index sh -> Tagged s (Index sh))
-> Result check (Index sh) -> Result check (Tagged s (Index sh))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sh -> Int -> Result check (Index sh)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh Int
k

instance (Static sh) => Static (Tagged s sh) where
   static :: Tagged s sh
static = sh -> Tagged s sh
forall k (s :: k) b. b -> Tagged s b
Tagged sh
forall sh. Static sh => sh
static



instance (C sh0, C sh1) => C (sh0,sh1) where
   size :: (sh0, sh1) -> Int
size (sh0
sh0,sh1
sh1) = sh0 -> Int
forall sh. C sh => sh -> Int
size sh0
sh0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* sh1 -> Int
forall sh. C sh => sh -> Int
size sh1
sh1

{- |
Row-major composition of two dimensions.

>>> Shape.indices (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int))
[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]
-}
instance (Indexed sh0, Indexed sh1) => Indexed (sh0,sh1) where
   type Index (sh0,sh1) = (Index sh0, Index sh1)
   indices :: (sh0, sh1) -> [Index (sh0, sh1)]
indices (sh0
sh0,sh1
sh1) = (Index sh0 -> Index sh1 -> (Index sh0, Index sh1))
-> [Index sh0] -> [Index sh1] -> [(Index sh0, Index sh1)]
forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 (,) (sh0 -> [Index sh0]
forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) (sh1 -> [Index sh1]
forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1)
   unifiedOffset :: (sh0, sh1) -> Index (sh0, sh1) -> Result check Int
unifiedOffset (sh0
sh0,sh1
sh1) =
      (sh0 -> Index sh0 -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh0
sh0 (Index sh0 -> Result check Int)
-> ((Index sh0, Index sh1) -> Index sh0)
-> (Index sh0, Index sh1)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index sh0, Index sh1) -> Index sh0
forall a b. (a, b) -> a
fst)
      ((Index sh0, Index sh1) -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
-> (Index sh0, Index sh1)
-> Result check Int
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> ix -> f a
`combineOffset`
      (((Index sh1 -> Result check Int)
 -> (Index sh0, Index sh1) -> Result check Int)
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh1 -> Result check Int)
-> ((Index sh0, Index sh1) -> Index sh1)
-> (Index sh0, Index sh1)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1) -> Index sh1
forall a b. (a, b) -> b
snd) ((Int, Index sh1 -> Result check Int)
 -> (Int, (Index sh0, Index sh1) -> Result check Int))
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh1 -> (Int, Index sh1 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
   unifiedSizeOffset :: (sh0, sh1) -> (Int, Index (sh0, sh1) -> Result check Int)
unifiedSizeOffset (sh0
sh0,sh1
sh1) =
      (((Index sh0 -> Result check Int)
 -> (Index sh0, Index sh1) -> Result check Int)
-> (Int, Index sh0 -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh0 -> Result check Int)
-> ((Index sh0, Index sh1) -> Index sh0)
-> (Index sh0, Index sh1)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1) -> Index sh0
forall a b. (a, b) -> a
fst) ((Int, Index sh0 -> Result check Int)
 -> (Int, (Index sh0, Index sh1) -> Result check Int))
-> (Int, Index sh0 -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh0 -> (Int, Index sh0 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0)
      (Int, (Index sh0, Index sh1) -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (((Index sh1 -> Result check Int)
 -> (Index sh0, Index sh1) -> Result check Int)
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh1 -> Result check Int)
-> ((Index sh0, Index sh1) -> Index sh1)
-> (Index sh0, Index sh1)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1) -> Index sh1
forall a b. (a, b) -> b
snd) ((Int, Index sh1 -> Result check Int)
 -> (Int, (Index sh0, Index sh1) -> Result check Int))
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh1 -> (Int, Index sh1 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
   inBounds :: (sh0, sh1) -> Index (sh0, sh1) -> Bool
inBounds (sh0
sh0,sh1
sh1) (ix0,ix1) = sh0 -> Index sh0 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0 Index sh0
ix0 Bool -> Bool -> Bool
&& sh1 -> Index sh1 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1 Index sh1
ix1

instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0,sh1) where
   unifiedIndexFromOffset :: (sh0, sh1) -> Int -> Result check (Index (sh0, sh1))
unifiedIndexFromOffset (sh0
sh0,sh1
sh1) Int
k = do
      let (Result check (Index sh0)
rix0,Index sh1
ix1) =
            Int
-> Backwards (State Int) (Result check (Index sh0), Index sh1)
-> (Result check (Index sh0), Index sh1)
forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k (Backwards (State Int) (Result check (Index sh0), Index sh1)
 -> (Result check (Index sh0), Index sh1))
-> Backwards (State Int) (Result check (Index sh0), Index sh1)
-> (Result check (Index sh0), Index sh1)
forall a b. (a -> b) -> a -> b
$ (Result check (Index sh0)
 -> Index sh1 -> (Result check (Index sh0), Index sh1))
-> Backwards (State Int) (Result check (Index sh0))
-> Backwards (State Int) (Index sh1)
-> Backwards (State Int) (Result check (Index sh0), Index sh1)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (sh0 -> Backwards (State Int) (Result check (Index sh0))
forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (State Int) (Result check (Index sh))
pickLastIndex sh0
sh0) (sh1 -> Backwards (State Int) (Index sh1)
forall sh. InvIndexed sh => sh -> Backwards (State Int) (Index sh)
pickIndex sh1
sh1)
      Index sh0
ix0 <- Result check (Index sh0)
rix0
      (Index sh0, Index sh1) -> Result check (Index sh0, Index sh1)
forall (m :: * -> *) a. Monad m => a -> m a
return (Index sh0
ix0,Index sh1
ix1)

instance (Static sh0, Static sh1) => Static (sh0,sh1) where
   static :: (sh0, sh1)
static = (sh0
forall sh. Static sh => sh
static, sh1
forall sh. Static sh => sh
static)


instance (C sh0, C sh1, C sh2) => C (sh0,sh1,sh2) where
   size :: (sh0, sh1, sh2) -> Int
size (sh0
sh0,sh1
sh1,sh2
sh2) = sh0 -> Int
forall sh. C sh => sh -> Int
size sh0
sh0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* sh1 -> Int
forall sh. C sh => sh -> Int
size sh1
sh1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* sh2 -> Int
forall sh. C sh => sh -> Int
size sh2
sh2

instance (Indexed sh0, Indexed sh1, Indexed sh2) => Indexed (sh0,sh1,sh2) where
   type Index (sh0,sh1,sh2) = (Index sh0, Index sh1, Index sh2)
   indices :: (sh0, sh1, sh2) -> [Index (sh0, sh1, sh2)]
indices (sh0
sh0,sh1
sh1,sh2
sh2) =
      (Index sh0
 -> Index sh1 -> Index sh2 -> (Index sh0, Index sh1, Index sh2))
-> [Index sh0]
-> [Index sh1]
-> [Index sh2]
-> [(Index sh0, Index sh1, Index sh2)]
forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
Monad.lift3 (,,) (sh0 -> [Index sh0]
forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) (sh1 -> [Index sh1]
forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1) (sh2 -> [Index sh2]
forall sh. Indexed sh => sh -> [Index sh]
indices sh2
sh2)
   unifiedOffset :: (sh0, sh1, sh2) -> Index (sh0, sh1, sh2) -> Result check Int
unifiedOffset (sh0
sh0,sh1
sh1,sh2
sh2) =
      (sh0 -> Index sh0 -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh0
sh0 (Index sh0 -> Result check Int)
-> ((Index sh0, Index sh1, Index sh2) -> Index sh0)
-> (Index sh0, Index sh1, Index sh2)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index sh0, Index sh1, Index sh2) -> Index sh0
forall a b c. (a, b, c) -> a
fst3)
      ((Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Index sh0, Index sh1, Index sh2)
-> Result check Int
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> ix -> f a
`combineOffset`
      (((Index sh1 -> Result check Int)
 -> (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh1 -> Result check Int)
-> ((Index sh0, Index sh1, Index sh2) -> Index sh1)
-> (Index sh0, Index sh1, Index sh2)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1, Index sh2) -> Index sh1
forall a b c. (a, b, c) -> b
snd3) ((Int, Index sh1 -> Result check Int)
 -> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int))
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh1 -> (Int, Index sh1 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
      (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (((Index sh2 -> Result check Int)
 -> (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, Index sh2 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh2 -> Result check Int)
-> ((Index sh0, Index sh1, Index sh2) -> Index sh2)
-> (Index sh0, Index sh1, Index sh2)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1, Index sh2) -> Index sh2
forall a b c. (a, b, c) -> c
thd3) ((Int, Index sh2 -> Result check Int)
 -> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int))
-> (Int, Index sh2 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh2 -> (Int, Index sh2 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh2
sh2)
   unifiedSizeOffset :: (sh0, sh1, sh2) -> (Int, Index (sh0, sh1, sh2) -> Result check Int)
unifiedSizeOffset (sh0
sh0,sh1
sh1,sh2
sh2) =
      (((Index sh0 -> Result check Int)
 -> (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, Index sh0 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh0 -> Result check Int)
-> ((Index sh0, Index sh1, Index sh2) -> Index sh0)
-> (Index sh0, Index sh1, Index sh2)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1, Index sh2) -> Index sh0
forall a b c. (a, b, c) -> a
fst3) ((Int, Index sh0 -> Result check Int)
 -> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int))
-> (Int, Index sh0 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh0 -> (Int, Index sh0 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0)
      (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (((Index sh1 -> Result check Int)
 -> (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh1 -> Result check Int)
-> ((Index sh0, Index sh1, Index sh2) -> Index sh1)
-> (Index sh0, Index sh1, Index sh2)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1, Index sh2) -> Index sh1
forall a b c. (a, b, c) -> b
snd3) ((Int, Index sh1 -> Result check Int)
 -> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int))
-> (Int, Index sh1 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh1 -> (Int, Index sh1 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
      (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (((Index sh2 -> Result check Int)
 -> (Index sh0, Index sh1, Index sh2) -> Result check Int)
-> (Int, Index sh2 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh2 -> Result check Int)
-> ((Index sh0, Index sh1, Index sh2) -> Index sh2)
-> (Index sh0, Index sh1, Index sh2)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh0, Index sh1, Index sh2) -> Index sh2
forall a b c. (a, b, c) -> c
thd3) ((Int, Index sh2 -> Result check Int)
 -> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int))
-> (Int, Index sh2 -> Result check Int)
-> (Int, (Index sh0, Index sh1, Index sh2) -> Result check Int)
forall a b. (a -> b) -> a -> b
$ sh2 -> (Int, Index sh2 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh2
sh2)
   inBounds :: (sh0, sh1, sh2) -> Index (sh0, sh1, sh2) -> Bool
inBounds (sh0
sh0,sh1
sh1,sh2
sh2) (ix0,ix1,ix2) =
      sh0 -> Index sh0 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0 Index sh0
ix0 Bool -> Bool -> Bool
&& sh1 -> Index sh1 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1 Index sh1
ix1 Bool -> Bool -> Bool
&& sh2 -> Index sh2 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh2
sh2 Index sh2
ix2

instance
   (InvIndexed sh0, InvIndexed sh1, InvIndexed sh2) =>
      InvIndexed (sh0,sh1,sh2) where
   unifiedIndexFromOffset :: (sh0, sh1, sh2) -> Int -> Result check (Index (sh0, sh1, sh2))
unifiedIndexFromOffset (sh0
sh0,sh1
sh1,sh2
sh2) Int
k = do
      let (Result check (Index sh0)
rix0,Index sh1
ix1,Index sh2
ix2) =
            Int
-> Backwards
     (State Int) (Result check (Index sh0), Index sh1, Index sh2)
-> (Result check (Index sh0), Index sh1, Index sh2)
forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k (Backwards
   (State Int) (Result check (Index sh0), Index sh1, Index sh2)
 -> (Result check (Index sh0), Index sh1, Index sh2))
-> Backwards
     (State Int) (Result check (Index sh0), Index sh1, Index sh2)
-> (Result check (Index sh0), Index sh1, Index sh2)
forall a b. (a -> b) -> a -> b
$
            (Result check (Index sh0)
 -> Index sh1
 -> Index sh2
 -> (Result check (Index sh0), Index sh1, Index sh2))
-> Backwards (State Int) (Result check (Index sh0))
-> Backwards (State Int) (Index sh1)
-> Backwards (State Int) (Index sh2)
-> Backwards
     (State Int) (Result check (Index sh0), Index sh1, Index sh2)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) (sh0 -> Backwards (State Int) (Result check (Index sh0))
forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (State Int) (Result check (Index sh))
pickLastIndex sh0
sh0) (sh1 -> Backwards (State Int) (Index sh1)
forall sh. InvIndexed sh => sh -> Backwards (State Int) (Index sh)
pickIndex sh1
sh1) (sh2 -> Backwards (State Int) (Index sh2)
forall sh. InvIndexed sh => sh -> Backwards (State Int) (Index sh)
pickIndex sh2
sh2)
      Index sh0
ix0 <- Result check (Index sh0)
rix0
      (Index sh0, Index sh1, Index sh2)
-> Result check (Index sh0, Index sh1, Index sh2)
forall (m :: * -> *) a. Monad m => a -> m a
return (Index sh0
ix0,Index sh1
ix1,Index sh2
ix2)

instance (Static sh0, Static sh1, Static sh2) => Static (sh0,sh1,sh2) where
   static :: (sh0, sh1, sh2)
static = (sh0
forall sh. Static sh => sh
static, sh1
forall sh. Static sh => sh
static, sh2
forall sh. Static sh => sh
static)

runInvIndex :: s -> Back.Backwards (MS.State s) a -> a
runInvIndex :: s -> Backwards (State s) a -> a
runInvIndex s
k = (State s a -> s -> a) -> s -> State s a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State s a -> s -> a
forall s a. State s a -> s -> a
MS.evalState s
k (State s a -> a)
-> (Backwards (State s) a -> State s a)
-> Backwards (State s) a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards (State s) a -> State s a
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
Back.forwards

pickLastIndex ::
   (Checking check, InvIndexed sh) =>
   sh -> Back.Backwards (MS.State Int) (Result check (Index sh))
pickLastIndex :: sh -> Backwards (State Int) (Result check (Index sh))
pickLastIndex sh
sh =
   StateT Int Identity (Result check (Index sh))
-> Backwards (State Int) (Result check (Index sh))
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards (StateT Int Identity (Result check (Index sh))
 -> Backwards (State Int) (Result check (Index sh)))
-> StateT Int Identity (Result check (Index sh))
-> Backwards (State Int) (Result check (Index sh))
forall a b. (a -> b) -> a -> b
$ (Int -> Result check (Index sh))
-> StateT Int Identity (Result check (Index sh))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets ((Int -> Result check (Index sh))
 -> StateT Int Identity (Result check (Index sh)))
-> (Int -> Result check (Index sh))
-> StateT Int Identity (Result check (Index sh))
forall a b. (a -> b) -> a -> b
$ sh -> Int -> Result check (Index sh)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh

pickIndex :: (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)
pickIndex :: sh -> Backwards (State Int) (Index sh)
pickIndex sh
sh =
   (Int -> Index sh)
-> Backwards (State Int) Int -> Backwards (State Int) (Index sh)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (sh -> Int -> Index sh
forall sh. InvIndexed sh => sh -> Int -> Index sh
uncheckedIndexFromOffset sh
sh) (Backwards (State Int) Int -> Backwards (State Int) (Index sh))
-> Backwards (State Int) Int -> Backwards (State Int) (Index sh)
forall a b. (a -> b) -> a -> b
$
   StateT Int Identity Int -> Backwards (State Int) Int
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards (StateT Int Identity Int -> Backwards (State Int) Int)
-> StateT Int Identity Int -> Backwards (State Int) Int
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Int)) -> StateT Int Identity Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state ((Int -> (Int, Int)) -> StateT Int Identity Int)
-> (Int -> (Int, Int)) -> StateT Int Identity Int
forall a b. (a -> b) -> a -> b
$ \Int
k -> (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
k (Int -> (Int, Int)) -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
size sh
sh



infixr 7 `combineOffset`, `combineSizeOffset`

{-# INLINE combineOffset #-}
combineOffset ::
   (Applicative f, Num a) =>
   (ix -> f a) -> (a, ix -> f a) -> (ix -> f a)
combineOffset :: (ix -> f a) -> (a, ix -> f a) -> ix -> f a
combineOffset ix -> f a
offset0 (a
size1,ix -> f a
offset1) ix
ix =
   ix -> f a
offset0 ix
ix f a -> a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
|* a
size1 f a -> f a -> f a
forall (f :: * -> *) a. (Applicative f, Num a) => f a -> f a -> f a
|+| ix -> f a
offset1 ix
ix

{-# INLINE combineSizeOffset #-}
combineSizeOffset ::
   (Applicative f, Num a) =>
   (a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
combineSizeOffset :: (a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
combineSizeOffset (a
size0,ix -> f a
offset0) (a
size1,ix -> f a
offset1) =
   (a
size0a -> a -> a
forall a. Num a => a -> a -> a
*a
size1, \ix
ix -> ix -> f a
offset0 ix
ix f a -> a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
|* a
size1 f a -> f a -> f a
forall (f :: * -> *) a. (Applicative f, Num a) => f a -> f a -> f a
|+| ix -> f a
offset1 ix
ix)



{- |
'Square' is like a Cartesian product,
but it is statically asserted that both dimension shapes match.

>>> Shape.indices $ Shape.Square $ Shape.ZeroBased (3::Int)
[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]
-}
newtype Square sh = Square {Square sh -> sh
squareSize :: sh}
   deriving (Square sh -> Square sh -> Bool
(Square sh -> Square sh -> Bool)
-> (Square sh -> Square sh -> Bool) -> Eq (Square sh)
forall sh. Eq sh => Square sh -> Square sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Square sh -> Square sh -> Bool
$c/= :: forall sh. Eq sh => Square sh -> Square sh -> Bool
== :: Square sh -> Square sh -> Bool
$c== :: forall sh. Eq sh => Square sh -> Square sh -> Bool
Eq, Int -> Square sh -> String -> String
[Square sh] -> String -> String
Square sh -> String
(Int -> Square sh -> String -> String)
-> (Square sh -> String)
-> ([Square sh] -> String -> String)
-> Show (Square sh)
forall sh. Show sh => Int -> Square sh -> String -> String
forall sh. Show sh => [Square sh] -> String -> String
forall sh. Show sh => Square sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Square sh] -> String -> String
$cshowList :: forall sh. Show sh => [Square sh] -> String -> String
show :: Square sh -> String
$cshow :: forall sh. Show sh => Square sh -> String
showsPrec :: Int -> Square sh -> String -> String
$cshowsPrec :: forall sh. Show sh => Int -> Square sh -> String -> String
Show)

instance Functor Square where
   fmap :: (a -> b) -> Square a -> Square b
fmap a -> b
f (Square a
sh) = b -> Square b
forall sh. sh -> Square sh
Square (b -> Square b) -> b -> Square b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh

instance Applicative Square where
   pure :: a -> Square a
pure = a -> Square a
forall sh. sh -> Square sh
Square
   Square a -> b
f <*> :: Square (a -> b) -> Square a -> Square b
<*> Square a
sh = b -> Square b
forall sh. sh -> Square sh
Square (b -> Square b) -> b -> Square b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh

instance (NFData sh) => NFData (Square sh) where
   rnf :: Square sh -> ()
rnf (Square sh
sh) = sh -> ()
forall a. NFData a => a -> ()
rnf sh
sh

instance (Storable sh) => Storable (Square sh) where
   sizeOf :: Square sh -> Int
sizeOf = (Square sh -> sh) -> Square sh -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf Square sh -> sh
forall sh. Square sh -> sh
squareSize
   alignment :: Square sh -> Int
alignment = (Square sh -> sh) -> Square sh -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment Square sh -> sh
forall sh. Square sh -> sh
squareSize
   peek :: Ptr (Square sh) -> IO (Square sh)
peek = (sh -> Square sh) -> Ptr (Square sh) -> IO (Square sh)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek sh -> Square sh
forall sh. sh -> Square sh
Square
   poke :: Ptr (Square sh) -> Square sh -> IO ()
poke = (Square sh -> sh) -> Ptr (Square sh) -> Square sh -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke Square sh -> sh
forall sh. Square sh -> sh
squareSize

instance (C sh) => C (Square sh) where
   size :: Square sh -> Int
size (Square sh
sh) = sh -> Int
forall sh. C sh => sh -> Int
size sh
sh Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2::Int)

instance (Indexed sh) => Indexed (Square sh) where
   type Index (Square sh) = (Index sh, Index sh)
   indices :: Square sh -> [Index (Square sh)]
indices (Square sh
sh) = (sh, sh) -> [Index (sh, sh)]
forall sh. Indexed sh => sh -> [Index sh]
indices (sh
sh,sh
sh)
   unifiedSizeOffset :: Square sh -> (Int, Index (Square sh) -> Result check Int)
unifiedSizeOffset (Square sh
sh) =
      let szo :: (Int, Index sh -> Result check Int)
szo = sh -> (Int, Index sh -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
      in ((Index sh -> Result check Int)
 -> (Index sh, Index sh) -> Result check Int)
-> (Int, Index sh -> Result check Int)
-> (Int, (Index sh, Index sh) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh -> Result check Int)
-> ((Index sh, Index sh) -> Index sh)
-> (Index sh, Index sh)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh, Index sh) -> Index sh
forall a b. (a, b) -> a
fst) (Int, Index sh -> Result check Int)
szo (Int, (Index sh, Index sh) -> Result check Int)
-> (Int, (Index sh, Index sh) -> Result check Int)
-> (Int, (Index sh, Index sh) -> Result check Int)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset` ((Index sh -> Result check Int)
 -> (Index sh, Index sh) -> Result check Int)
-> (Int, Index sh -> Result check Int)
-> (Int, (Index sh, Index sh) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh -> Result check Int)
-> ((Index sh, Index sh) -> Index sh)
-> (Index sh, Index sh)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh, Index sh) -> Index sh
forall a b. (a, b) -> b
snd) (Int, Index sh -> Result check Int)
szo
   inBounds :: Square sh -> Index (Square sh) -> Bool
inBounds (Square sh
sh) = (sh, sh) -> Index (sh, sh) -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (sh
sh,sh
sh)

instance (InvIndexed sh) => InvIndexed (Square sh) where
   unifiedIndexFromOffset :: Square sh -> Int -> Result check (Index (Square sh))
unifiedIndexFromOffset (Square sh
sh) =
      (sh, sh) -> Int -> Result check (Index (sh, sh))
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (sh
sh,sh
sh)



{- |
'Cube' is like a Cartesian product,
but it is statically asserted that both dimension shapes match.

>>> Shape.indices $ Shape.Cube $ Shape.ZeroBased (2::Int)
[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1)]
-}
newtype Cube sh = Cube {Cube sh -> sh
cubeSize :: sh}
   deriving (Cube sh -> Cube sh -> Bool
(Cube sh -> Cube sh -> Bool)
-> (Cube sh -> Cube sh -> Bool) -> Eq (Cube sh)
forall sh. Eq sh => Cube sh -> Cube sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cube sh -> Cube sh -> Bool
$c/= :: forall sh. Eq sh => Cube sh -> Cube sh -> Bool
== :: Cube sh -> Cube sh -> Bool
$c== :: forall sh. Eq sh => Cube sh -> Cube sh -> Bool
Eq, Int -> Cube sh -> String -> String
[Cube sh] -> String -> String
Cube sh -> String
(Int -> Cube sh -> String -> String)
-> (Cube sh -> String)
-> ([Cube sh] -> String -> String)
-> Show (Cube sh)
forall sh. Show sh => Int -> Cube sh -> String -> String
forall sh. Show sh => [Cube sh] -> String -> String
forall sh. Show sh => Cube sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cube sh] -> String -> String
$cshowList :: forall sh. Show sh => [Cube sh] -> String -> String
show :: Cube sh -> String
$cshow :: forall sh. Show sh => Cube sh -> String
showsPrec :: Int -> Cube sh -> String -> String
$cshowsPrec :: forall sh. Show sh => Int -> Cube sh -> String -> String
Show)

instance Functor Cube where
   fmap :: (a -> b) -> Cube a -> Cube b
fmap a -> b
f (Cube a
sh) = b -> Cube b
forall sh. sh -> Cube sh
Cube (b -> Cube b) -> b -> Cube b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh

instance Applicative Cube where
   pure :: a -> Cube a
pure = a -> Cube a
forall sh. sh -> Cube sh
Cube
   Cube a -> b
f <*> :: Cube (a -> b) -> Cube a -> Cube b
<*> Cube a
sh = b -> Cube b
forall sh. sh -> Cube sh
Cube (b -> Cube b) -> b -> Cube b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh

instance (NFData sh) => NFData (Cube sh) where
   rnf :: Cube sh -> ()
rnf (Cube sh
sh) = sh -> ()
forall a. NFData a => a -> ()
rnf sh
sh

instance (Storable sh) => Storable (Cube sh) where
   sizeOf :: Cube sh -> Int
sizeOf = (Cube sh -> sh) -> Cube sh -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf Cube sh -> sh
forall sh. Cube sh -> sh
cubeSize
   alignment :: Cube sh -> Int
alignment = (Cube sh -> sh) -> Cube sh -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment Cube sh -> sh
forall sh. Cube sh -> sh
cubeSize
   peek :: Ptr (Cube sh) -> IO (Cube sh)
peek = (sh -> Cube sh) -> Ptr (Cube sh) -> IO (Cube sh)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek sh -> Cube sh
forall sh. sh -> Cube sh
Cube
   poke :: Ptr (Cube sh) -> Cube sh -> IO ()
poke = (Cube sh -> sh) -> Ptr (Cube sh) -> Cube sh -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke Cube sh -> sh
forall sh. Cube sh -> sh
cubeSize

instance (C sh) => C (Cube sh) where
   size :: Cube sh -> Int
size (Cube sh
sh) = sh -> Int
forall sh. C sh => sh -> Int
size sh
sh Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3::Int)

instance (Indexed sh) => Indexed (Cube sh) where
   type Index (Cube sh) = (Index sh, Index sh, Index sh)
   indices :: Cube sh -> [Index (Cube sh)]
indices (Cube sh
sh) = (sh, sh, sh) -> [Index (sh, sh, sh)]
forall sh. Indexed sh => sh -> [Index sh]
indices (sh
sh,sh
sh,sh
sh)
   unifiedSizeOffset :: Cube sh -> (Int, Index (Cube sh) -> Result check Int)
unifiedSizeOffset (Cube sh
sh) =
      let szo :: (Int, Index sh -> Result check Int)
szo = sh -> (Int, Index sh -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
      in ((Index sh -> Result check Int)
 -> (Index sh, Index sh, Index sh) -> Result check Int)
-> (Int, Index sh -> Result check Int)
-> (Int, (Index sh, Index sh, Index sh) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh -> Result check Int)
-> ((Index sh, Index sh, Index sh) -> Index sh)
-> (Index sh, Index sh, Index sh)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh, Index sh, Index sh) -> Index sh
forall a b c. (a, b, c) -> a
fst3) (Int, Index sh -> Result check Int)
szo
         (Int, (Index sh, Index sh, Index sh) -> Result check Int)
-> (Int, (Index sh, Index sh, Index sh) -> Result check Int)
-> (Int, (Index sh, Index sh, Index sh) -> Result check Int)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
         ((Index sh -> Result check Int)
 -> (Index sh, Index sh, Index sh) -> Result check Int)
-> (Int, Index sh -> Result check Int)
-> (Int, (Index sh, Index sh, Index sh) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh -> Result check Int)
-> ((Index sh, Index sh, Index sh) -> Index sh)
-> (Index sh, Index sh, Index sh)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh, Index sh, Index sh) -> Index sh
forall a b c. (a, b, c) -> b
snd3) (Int, Index sh -> Result check Int)
szo
         (Int, (Index sh, Index sh, Index sh) -> Result check Int)
-> (Int, (Index sh, Index sh, Index sh) -> Result check Int)
-> (Int, (Index sh, Index sh, Index sh) -> Result check Int)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
         ((Index sh -> Result check Int)
 -> (Index sh, Index sh, Index sh) -> Result check Int)
-> (Int, Index sh -> Result check Int)
-> (Int, (Index sh, Index sh, Index sh) -> Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Index sh -> Result check Int)
-> ((Index sh, Index sh, Index sh) -> Index sh)
-> (Index sh, Index sh, Index sh)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Index sh, Index sh, Index sh) -> Index sh
forall a b c. (a, b, c) -> c
thd3) (Int, Index sh -> Result check Int)
szo
   inBounds :: Cube sh -> Index (Cube sh) -> Bool
inBounds (Cube sh
sh) = (sh, sh, sh) -> Index (sh, sh, sh) -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (sh
sh,sh
sh,sh
sh)

instance (InvIndexed sh) => InvIndexed (Cube sh) where
   unifiedIndexFromOffset :: Cube sh -> Int -> Result check (Index (Cube sh))
unifiedIndexFromOffset (Cube sh
sh) =
      (sh, sh, sh) -> Int -> Result check (Index (sh, sh, sh))
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (sh
sh,sh
sh,sh
sh)



data Lower = Lower deriving (Lower -> Lower -> Bool
(Lower -> Lower -> Bool) -> (Lower -> Lower -> Bool) -> Eq Lower
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lower -> Lower -> Bool
$c/= :: Lower -> Lower -> Bool
== :: Lower -> Lower -> Bool
$c== :: Lower -> Lower -> Bool
Eq, Int -> Lower -> String -> String
[Lower] -> String -> String
Lower -> String
(Int -> Lower -> String -> String)
-> (Lower -> String) -> ([Lower] -> String -> String) -> Show Lower
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Lower] -> String -> String
$cshowList :: [Lower] -> String -> String
show :: Lower -> String
$cshow :: Lower -> String
showsPrec :: Int -> Lower -> String -> String
$cshowsPrec :: Int -> Lower -> String -> String
Show)
data Upper = Upper deriving (Upper -> Upper -> Bool
(Upper -> Upper -> Bool) -> (Upper -> Upper -> Bool) -> Eq Upper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Upper -> Upper -> Bool
$c/= :: Upper -> Upper -> Bool
== :: Upper -> Upper -> Bool
$c== :: Upper -> Upper -> Bool
Eq, Int -> Upper -> String -> String
[Upper] -> String -> String
Upper -> String
(Int -> Upper -> String -> String)
-> (Upper -> String) -> ([Upper] -> String -> String) -> Show Upper
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Upper] -> String -> String
$cshowList :: [Upper] -> String -> String
show :: Upper -> String
$cshow :: Upper -> String
showsPrec :: Int -> Upper -> String -> String
$cshowsPrec :: Int -> Upper -> String -> String
Show)

class TriangularPart part where
   switchTriangularPart :: f Lower -> f Upper -> f part
instance TriangularPart Lower where switchTriangularPart :: f Lower -> f Upper -> f Lower
switchTriangularPart f Lower
f f Upper
_ = f Lower
f
instance TriangularPart Upper where switchTriangularPart :: f Lower -> f Upper -> f Upper
switchTriangularPart f Lower
_ f Upper
f = f Upper
f

getConstAs :: c -> Const a c -> a
getConstAs :: c -> Const a c -> a
getConstAs c
_ = Const a c -> a
forall a k (b :: k). Const a b -> a
getConst

caseTriangularPart :: (TriangularPart part) => part -> a -> a -> a
caseTriangularPart :: part -> a -> a -> a
caseTriangularPart part
part a
lo a
up =
   part -> Const a part -> a
forall c a. c -> Const a c -> a
getConstAs part
part (Const a part -> a) -> Const a part -> a
forall a b. (a -> b) -> a -> b
$ Const a Lower -> Const a Upper -> Const a part
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (a -> Const a Lower
forall k a (b :: k). a -> Const a b
Const a
lo) (a -> Const a Upper
forall k a (b :: k). a -> Const a b
Const a
up)

{- |
>>> Shape.indices $ Shape.Triangular Shape.Upper $ Shape.ZeroBased (3::Int)
[(0,0),(0,1),(0,2),(1,1),(1,2),(2,2)]
>>> Shape.indices $ Shape.Triangular Shape.Lower $ Shape.ZeroBased (3::Int)
[(0,0),(1,0),(1,1),(2,0),(2,1),(2,2)]
-}
data Triangular part size =
   Triangular {
      Triangular part size -> part
triangularPart :: part,
      Triangular part size -> size
triangularSize :: size
   } deriving (Int -> Triangular part size -> String -> String
[Triangular part size] -> String -> String
Triangular part size -> String
(Int -> Triangular part size -> String -> String)
-> (Triangular part size -> String)
-> ([Triangular part size] -> String -> String)
-> Show (Triangular part size)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall part size.
(Show part, Show size) =>
Int -> Triangular part size -> String -> String
forall part size.
(Show part, Show size) =>
[Triangular part size] -> String -> String
forall part size.
(Show part, Show size) =>
Triangular part size -> String
showList :: [Triangular part size] -> String -> String
$cshowList :: forall part size.
(Show part, Show size) =>
[Triangular part size] -> String -> String
show :: Triangular part size -> String
$cshow :: forall part size.
(Show part, Show size) =>
Triangular part size -> String
showsPrec :: Int -> Triangular part size -> String -> String
$cshowsPrec :: forall part size.
(Show part, Show size) =>
Int -> Triangular part size -> String -> String
Show)

newtype Equal part = Equal {Equal part -> part -> part -> Bool
getEqual :: part -> part -> Bool}

equalPart :: (TriangularPart part) => part -> part -> Bool
equalPart :: part -> part -> Bool
equalPart = Equal part -> part -> part -> Bool
forall part. Equal part -> part -> part -> Bool
getEqual (Equal part -> part -> part -> Bool)
-> Equal part -> part -> part -> Bool
forall a b. (a -> b) -> a -> b
$ Equal Lower -> Equal Upper -> Equal part
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart ((Lower -> Lower -> Bool) -> Equal Lower
forall part. (part -> part -> Bool) -> Equal part
Equal Lower -> Lower -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ((Upper -> Upper -> Bool) -> Equal Upper
forall part. (part -> part -> Bool) -> Equal part
Equal Upper -> Upper -> Bool
forall a. Eq a => a -> a -> Bool
(==))

instance (TriangularPart part, Eq size) => Eq (Triangular part size) where
   Triangular part size
x== :: Triangular part size -> Triangular part size -> Bool
==Triangular part size
y  =  (part -> part -> Bool)
-> (Triangular part size -> part)
-> Triangular part size
-> Triangular part size
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 part -> part -> Bool
forall part. TriangularPart part => part -> part -> Bool
equalPart Triangular part size -> part
forall part size. Triangular part size -> part
triangularPart Triangular part size
x Triangular part size
y Bool -> Bool -> Bool
&& (Triangular part size -> size)
-> Triangular part size -> Triangular part size -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating Triangular part size -> size
forall part size. Triangular part size -> size
triangularSize Triangular part size
x Triangular part size
y

type LowerTriangular = Triangular Lower
type UpperTriangular = Triangular Upper

lowerTriangular :: size -> LowerTriangular size
lowerTriangular :: size -> LowerTriangular size
lowerTriangular = Lower -> size -> LowerTriangular size
forall part size. part -> size -> Triangular part size
Triangular Lower
Lower

upperTriangular :: size -> UpperTriangular size
upperTriangular :: size -> UpperTriangular size
upperTriangular = Upper -> size -> UpperTriangular size
forall part size. part -> size -> Triangular part size
Triangular Upper
Upper

-- cf. Data.Bifunctor.Flip
newtype Flip f b a = Flip {Flip f b a -> f a b
getFlip :: f a b}

instance
      (TriangularPart part, NFData size) => NFData (Triangular part size) where
   rnf :: Triangular part size -> ()
rnf (Triangular part
part size
sz) =
      ((), size) -> ()
forall a. NFData a => a -> ()
rnf
         ((Flip (->) () part -> part -> ())
-> part -> Flip (->) () part -> ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Flip (->) () part -> part -> ()
forall (f :: * -> * -> *) b a. Flip f b a -> f a b
getFlip part
part (Flip (->) () part -> ()) -> Flip (->) () part -> ()
forall a b. (a -> b) -> a -> b
$
            Flip (->) () Lower -> Flip (->) () Upper -> Flip (->) () part
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart ((Lower -> ()) -> Flip (->) () Lower
forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip ((Lower -> ()) -> Flip (->) () Lower)
-> (Lower -> ()) -> Flip (->) () Lower
forall a b. (a -> b) -> a -> b
$ \Lower
Lower -> ()) ((Upper -> ()) -> Flip (->) () Upper
forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip ((Upper -> ()) -> Flip (->) () Upper)
-> (Upper -> ()) -> Flip (->) () Upper
forall a b. (a -> b) -> a -> b
$ \Upper
Upper -> ()),
          size
sz)

instance (TriangularPart part, C size) => C (Triangular part size) where
   size :: Triangular part size -> Int
size (Triangular part
_part size
sz) = Int -> Int
triangleSize (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ size -> Int
forall sh. C sh => sh -> Int
size size
sz

instance
   (TriangularPart part, Indexed size) =>
      Indexed (Triangular part size) where
   type Index (Triangular part size) = (Index size, Index size)

   indices :: Triangular part size -> [Index (Triangular part size)]
indices (Triangular part
part size
sz) =
      let ixs :: [Index size]
ixs = size -> [Index size]
forall sh. Indexed sh => sh -> [Index sh]
indices size
sz
      in [[(Index size, Index size)]] -> [(Index size, Index size)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Index size, Index size)]] -> [(Index size, Index size)])
-> [[(Index size, Index size)]] -> [(Index size, Index size)]
forall a b. (a -> b) -> a -> b
$
         part
-> [[(Index size, Index size)]]
-> [[(Index size, Index size)]]
-> [[(Index size, Index size)]]
forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
            (([Index size] -> Index size -> [(Index size, Index size)])
-> [[Index size]] -> [Index size] -> [[(Index size, Index size)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Index size]
cs Index size
r -> (Index size -> (Index size, Index size))
-> [Index size] -> [(Index size, Index size)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) Index size
r) [Index size]
cs)
               (T [] [Index size] -> [[Index size]]
forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail (T [] [Index size] -> [[Index size]])
-> T [] [Index size] -> [[Index size]]
forall a b. (a -> b) -> a -> b
$ [Index size] -> T [] [Index size]
forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Snoc g, Empty g) =>
f a -> T f (g a)
NonEmpty.inits [Index size]
ixs) [Index size]
ixs)
            ((Index size -> [Index size] -> [(Index size, Index size)])
-> [Index size] -> [[Index size]] -> [[(Index size, Index size)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Index size
r [Index size]
cs -> (Index size -> (Index size, Index size))
-> [Index size] -> [(Index size, Index size)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) Index size
r) [Index size]
cs) [Index size]
ixs ([[Index size]] -> [[(Index size, Index size)]])
-> [[Index size]] -> [[(Index size, Index size)]]
forall a b. (a -> b) -> a -> b
$ [Index size] -> [[Index size]]
forall a. [a] -> [[a]]
tails [Index size]
ixs)

   unifiedSizeOffset :: Triangular part size
-> (Int, Index (Triangular part size) -> Result check Int)
unifiedSizeOffset (Triangular part
part size
sz) =
      let (Int
n, Index size -> Result check Int
getOffset) = size -> (Int, Index size -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset size
sz
      in (Int -> Int
triangleSize Int
n, \(rs,cs) -> do
         Int
r <- Index size -> Result check Int
getOffset Index size
rs
         Int
c <- Index size -> Result check Int
getOffset Index size
cs
         String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Triangular.sizeOffset: wrong array part" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$
            part -> Int -> Int -> Bool
forall part a.
(TriangularPart part, Ord a) =>
part -> a -> a -> Bool
compareIndices part
part Int
r Int
c
         Int -> Result check Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ part -> Int -> (Int, Int) -> Int
forall part.
TriangularPart part =>
part -> Int -> (Int, Int) -> Int
triangleOffset part
part Int
n (Int
r,Int
c))

   inBounds :: Triangular part size -> Index (Triangular part size) -> Bool
inBounds (Triangular part
part size
sz) ix :: Index (Triangular part size)
ix@(r,c) =
      (size, size) -> Index (size, size) -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (size
sz,size
sz) Index (size, size)
Index (Triangular part size)
ix
      Bool -> Bool -> Bool
&&
      let getOffset :: Index size -> Int
getOffset = size -> Index size -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
offset size
sz
      in part -> Int -> Int -> Bool
forall part a.
(TriangularPart part, Ord a) =>
part -> a -> a -> Bool
compareIndices part
part (Index size -> Int
getOffset Index size
r) (Index size -> Int
getOffset Index size
c)

triangleOffset :: TriangularPart part => part -> Int -> (Int, Int) -> Int
triangleOffset :: part -> Int -> (Int, Int) -> Int
triangleOffset part
part Int
n (Int
r,Int
c) =
   part -> Int -> Int -> Int
forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
      (Int -> Int
triangleSize Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c)
      (Int -> Int
triangleSize Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
triangleSize (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r)

compareIndices :: (TriangularPart part, Ord a) => part -> a -> a -> Bool
compareIndices :: part -> a -> a -> Bool
compareIndices part
part = part -> (a -> a -> Bool) -> (a -> a -> Bool) -> a -> a -> Bool
forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

instance
   (TriangularPart part, InvIndexed size) =>
      InvIndexed (Triangular part size) where

   unifiedIndexFromOffset :: Triangular part size
-> Int -> Result check (Index (Triangular part size))
unifiedIndexFromOffset (Triangular part
part size
sz) Int
k =
      let n :: Int
n = size -> Int
forall sh. C sh => sh -> Int
size size
sz in
      (Int -> Result check (Index size),
 Int -> Result check (Index size))
-> (Int, Int) -> Result check (Index size, Index size)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c, b -> f d) -> (a, b) -> f (c, d)
AppHT.mapPair (size -> Int -> Result check (Index size)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset size
sz, size -> Int -> Result check (Index size)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset size
sz) ((Int, Int) -> Result check (Index size, Index size))
-> (Int, Int) -> Result check (Index size, Index size)
forall a b. (a -> b) -> a -> b
$
       part -> (Int, Int) -> (Int, Int) -> (Int, Int)
forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
         (let r :: Int
r = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Double
triangleRootDouble Int
k)
          in (Int
r, Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
triangleSize Int
r))
         (let triSize :: Int
triSize = Int -> Int
triangleSize Int
n
              rr :: Int
rr = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
triangleRootDouble (Int
triSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k))
              r :: Int
r = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rr
          in (Int
r, Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
triSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
triangleSize Int
rr)))

triangleSize :: Int -> Int
triangleSize :: Int -> Int
triangleSize Int
n = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) Int
2

{-
n*(n+1)/2 = m
n^2 + n - 2m = 0
n = -1/2 + sqrt(1/4+2m)
  = (sqrt(8m+1) - 1) / 2
-}
triangleRoot :: Floating a => a -> a
triangleRoot :: a -> a
triangleRoot a
sz = (a -> a
forall a. Floating a => a -> a
sqrt (a
8a -> a -> a
forall a. Num a => a -> a -> a
*a
sza -> a -> a
forall a. Num a => a -> a -> a
+a
1)a -> a -> a
forall a. Num a => a -> a -> a
-a
1)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
2

triangleRootDouble :: Int -> Double
triangleRootDouble :: Int -> Double
triangleRootDouble = Double -> Double
forall a. Floating a => a -> a
triangleRoot (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance
   (TriangularPart part, Static size) =>
      Static (Triangular part size) where
   static :: Triangular part size
static = part -> size -> Triangular part size
forall part size. part -> size -> Triangular part size
Triangular part
forall part. TriangularPart part => part
autoPart size
forall sh. Static sh => sh
static

autoPart :: (TriangularPart part) => part
autoPart :: part
autoPart = Identity part -> part
forall a. Identity a -> a
runIdentity (Identity part -> part) -> Identity part -> part
forall a b. (a -> b) -> a -> b
$ Identity Lower -> Identity Upper -> Identity part
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (Lower -> Identity Lower
forall a. a -> Identity a
Identity Lower
Lower) (Upper -> Identity Upper
forall a. a -> Identity a
Identity Upper
Upper)



{- |
Simplex is a generalization of 'Triangular' to more than two dimensions.
Indices are tuples of fixed size
with elements ordered in ascending, strictly ascending,
descending or strictly descending order.
\"Order\" refers to the index order in 'indices'.
In order to avoid confusion we suggest that the order of 'indices'
is consistent with '<='.

Obviously, 'offset' implements ranking
and 'indexFromOffset' implements unranking
of combinations (in the combinatorial sense)
with or without repetitions.

>>> Shape.indices $ Shape.simplexAscending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int)
[[0,1,2],[0,1,3],[0,2,3],[1,2,3]]
>>> Shape.indices $ Shape.simplexAscending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int)
[[0,0,0],[0,0,1],[0,0,2],[0,1,1],[0,1,2],[0,2,2],[1,1,1],[1,1,2],[1,2,2],[2,2,2]]
>>> Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int)
[[0,0,1],[0,0,2],[0,0,3],[0,1,2],[0,1,3],[0,2,3],[1,1,2],[1,1,3],[1,2,3],[2,2,3]]
>>> Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int)
[[0,0,1],[0,0,2],[0,0,3],[0,1,2],[0,1,3],[0,2,3],[1,1,2],[1,1,3],[1,2,3],[2,2,3]]

>>> Shape.indices $ Shape.simplexDescending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int)
[[2,1,0],[3,1,0],[3,2,0],[3,2,1]]
>>> Shape.indices $ Shape.simplexDescending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int)
[[0,0,0],[1,0,0],[1,1,0],[1,1,1],[2,0,0],[2,1,0],[2,1,1],[2,2,0],[2,2,1],[2,2,2]]
>>> Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int)
[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]
>>> Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int)
[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]
-}
data Simplex order coll f size =
   Simplex {
      Simplex order coll f size -> SimplexOrder order
simplexOrder :: SimplexOrder order,
      Simplex order coll f size -> f coll
simplexDimension :: f coll,
      Simplex order coll f size -> size
simplexSize :: size
   }

data Ascending
data Descending
data SimplexOrder order where
   Ascending :: SimplexOrder Ascending
   Descending :: SimplexOrder Descending

instance Eq (SimplexOrder order) where
   SimplexOrder order
Ascending == :: SimplexOrder order -> SimplexOrder order -> Bool
== SimplexOrder order
Ascending = Bool
True
   SimplexOrder order
Descending == SimplexOrder order
Descending = Bool
True

instance Show (SimplexOrder order) where
   show :: SimplexOrder order -> String
show SimplexOrder order
Ascending = String
"Ascending"
   show SimplexOrder order
Descending = String
"Descending"

type SimplexAscending = Simplex Ascending
type SimplexDescending = Simplex Descending

simplexAscending :: f coll -> size -> SimplexAscending coll f size
simplexAscending :: f coll -> size -> SimplexAscending coll f size
simplexAscending = SimplexOrder Ascending
-> f coll -> size -> SimplexAscending coll f size
forall order coll (f :: * -> *) size.
SimplexOrder order -> f coll -> size -> Simplex order coll f size
Simplex SimplexOrder Ascending
Ascending

simplexDescending :: f coll -> size -> SimplexDescending coll f size
simplexDescending :: f coll -> size -> SimplexDescending coll f size
simplexDescending = SimplexOrder Descending
-> f coll -> size -> SimplexDescending coll f size
forall order coll (f :: * -> *) size.
SimplexOrder order -> f coll -> size -> Simplex order coll f size
Simplex SimplexOrder Descending
Descending

isAscending :: SimplexOrder order -> Bool
isAscending :: SimplexOrder order -> Bool
isAscending SimplexOrder order
Ascending = Bool
True
isAscending SimplexOrder order
Descending = Bool
False

class SimplexOrderC order where
instance SimplexOrderC Ascending where
instance SimplexOrderC Descending where

data AllDistinct = AllDistinct deriving (Int -> AllDistinct -> String -> String
[AllDistinct] -> String -> String
AllDistinct -> String
(Int -> AllDistinct -> String -> String)
-> (AllDistinct -> String)
-> ([AllDistinct] -> String -> String)
-> Show AllDistinct
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AllDistinct] -> String -> String
$cshowList :: [AllDistinct] -> String -> String
show :: AllDistinct -> String
$cshow :: AllDistinct -> String
showsPrec :: Int -> AllDistinct -> String -> String
$cshowsPrec :: Int -> AllDistinct -> String -> String
Show, AllDistinct -> AllDistinct -> Bool
(AllDistinct -> AllDistinct -> Bool)
-> (AllDistinct -> AllDistinct -> Bool) -> Eq AllDistinct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllDistinct -> AllDistinct -> Bool
$c/= :: AllDistinct -> AllDistinct -> Bool
== :: AllDistinct -> AllDistinct -> Bool
$c== :: AllDistinct -> AllDistinct -> Bool
Eq)
data SomeRepetitive = SomeRepetitive deriving (Int -> SomeRepetitive -> String -> String
[SomeRepetitive] -> String -> String
SomeRepetitive -> String
(Int -> SomeRepetitive -> String -> String)
-> (SomeRepetitive -> String)
-> ([SomeRepetitive] -> String -> String)
-> Show SomeRepetitive
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SomeRepetitive] -> String -> String
$cshowList :: [SomeRepetitive] -> String -> String
show :: SomeRepetitive -> String
$cshow :: SomeRepetitive -> String
showsPrec :: Int -> SomeRepetitive -> String -> String
$cshowsPrec :: Int -> SomeRepetitive -> String -> String
Show, SomeRepetitive -> SomeRepetitive -> Bool
(SomeRepetitive -> SomeRepetitive -> Bool)
-> (SomeRepetitive -> SomeRepetitive -> Bool) -> Eq SomeRepetitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeRepetitive -> SomeRepetitive -> Bool
$c/= :: SomeRepetitive -> SomeRepetitive -> Bool
== :: SomeRepetitive -> SomeRepetitive -> Bool
$c== :: SomeRepetitive -> SomeRepetitive -> Bool
Eq)
data Collision = Distinct | Repetitive deriving (Int -> Collision -> String -> String
[Collision] -> String -> String
Collision -> String
(Int -> Collision -> String -> String)
-> (Collision -> String)
-> ([Collision] -> String -> String)
-> Show Collision
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Collision] -> String -> String
$cshowList :: [Collision] -> String -> String
show :: Collision -> String
$cshow :: Collision -> String
showsPrec :: Int -> Collision -> String -> String
$cshowsPrec :: Int -> Collision -> String -> String
Show, Collision -> Collision -> Bool
(Collision -> Collision -> Bool)
-> (Collision -> Collision -> Bool) -> Eq Collision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Collision -> Collision -> Bool
$c/= :: Collision -> Collision -> Bool
== :: Collision -> Collision -> Bool
$c== :: Collision -> Collision -> Bool
Eq, Eq Collision
Eq Collision
-> (Collision -> Collision -> Ordering)
-> (Collision -> Collision -> Bool)
-> (Collision -> Collision -> Bool)
-> (Collision -> Collision -> Bool)
-> (Collision -> Collision -> Bool)
-> (Collision -> Collision -> Collision)
-> (Collision -> Collision -> Collision)
-> Ord Collision
Collision -> Collision -> Bool
Collision -> Collision -> Ordering
Collision -> Collision -> Collision
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Collision -> Collision -> Collision
$cmin :: Collision -> Collision -> Collision
max :: Collision -> Collision -> Collision
$cmax :: Collision -> Collision -> Collision
>= :: Collision -> Collision -> Bool
$c>= :: Collision -> Collision -> Bool
> :: Collision -> Collision -> Bool
$c> :: Collision -> Collision -> Bool
<= :: Collision -> Collision -> Bool
$c<= :: Collision -> Collision -> Bool
< :: Collision -> Collision -> Bool
$c< :: Collision -> Collision -> Bool
compare :: Collision -> Collision -> Ordering
$ccompare :: Collision -> Collision -> Ordering
$cp1Ord :: Eq Collision
Ord, Int -> Collision
Collision -> Int
Collision -> [Collision]
Collision -> Collision
Collision -> Collision -> [Collision]
Collision -> Collision -> Collision -> [Collision]
(Collision -> Collision)
-> (Collision -> Collision)
-> (Int -> Collision)
-> (Collision -> Int)
-> (Collision -> [Collision])
-> (Collision -> Collision -> [Collision])
-> (Collision -> Collision -> [Collision])
-> (Collision -> Collision -> Collision -> [Collision])
-> Enum Collision
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Collision -> Collision -> Collision -> [Collision]
$cenumFromThenTo :: Collision -> Collision -> Collision -> [Collision]
enumFromTo :: Collision -> Collision -> [Collision]
$cenumFromTo :: Collision -> Collision -> [Collision]
enumFromThen :: Collision -> Collision -> [Collision]
$cenumFromThen :: Collision -> Collision -> [Collision]
enumFrom :: Collision -> [Collision]
$cenumFrom :: Collision -> [Collision]
fromEnum :: Collision -> Int
$cfromEnum :: Collision -> Int
toEnum :: Int -> Collision
$ctoEnum :: Int -> Collision
pred :: Collision -> Collision
$cpred :: Collision -> Collision
succ :: Collision -> Collision
$csucc :: Collision -> Collision
Enum)

class CollisionC coll where repetitionAllowed :: coll -> Bool
instance CollisionC AllDistinct where repetitionAllowed :: AllDistinct -> Bool
repetitionAllowed AllDistinct
AllDistinct = Bool
False
instance CollisionC SomeRepetitive where repetitionAllowed :: SomeRepetitive -> Bool
repetitionAllowed SomeRepetitive
SomeRepetitive = Bool
True
instance CollisionC Collision where
   repetitionAllowed :: Collision -> Bool
repetitionAllowed Collision
Distinct = Bool
False
   repetitionAllowed Collision
Repetitive = Bool
True

instance
   (SimplexOrderC order, Show coll, FunctorC.Show1 f, Show size) =>
      Show (Simplex order coll f size) where
   showsPrec :: Int -> Simplex order coll f size -> String -> String
showsPrec Int
p (Simplex SimplexOrder order
order f coll
d size
sz) =
      Bool -> (String -> String) -> String -> String
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
         String -> String -> String
showString String
"Simplex " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         SimplexOrder order -> String -> String
forall a. Show a => a -> String -> String
shows SimplexOrder order
order (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Int -> f coll -> String -> String
forall (f :: * -> *) a.
(Show1 f, Show a) =>
Int -> f a -> String -> String
FunctorC.showsPrec1 Int
11 f coll
d (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Int -> size -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 size
sz

instance
   (SimplexOrderC order, CollisionC coll, Traversable f, C size) =>
      C (Simplex order coll f size) where
   size :: Simplex order coll f size -> Int
size (Simplex SimplexOrder order
_order f coll
d size
sz) =
      let ds :: [coll]
ds = f coll -> [coll]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d
          rep :: Int
rep = [coll] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([coll] -> Int) -> [coll] -> Int
forall a b. (a -> b) -> a -> b
$ (coll -> Bool) -> [coll] -> [coll]
forall a. (a -> Bool) -> [a] -> [a]
filter coll -> Bool
forall coll. CollisionC coll => coll -> Bool
repetitionAllowed ([coll] -> [coll]) -> [coll] -> [coll]
forall a b. (a -> b) -> a -> b
$ [coll] -> [coll]
forall a. [a] -> [a]
laxInit [coll]
ds
      in Int -> Int -> Int
forall i. Integral i => Int -> i -> i
simplexLayoutSize ([coll] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [coll]
ds) (size -> Int
forall sh. C sh => sh -> Int
size size
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rep)

laxInit :: [a] -> [a]
laxInit :: [a] -> [a]
laxInit [a]
xs = [a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
Match.take (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs) [a]
xs

simplexLayoutSize :: Integral i => Int -> i -> i
simplexLayoutSize :: Int -> i -> i
simplexLayoutSize Int
d i
n =
   case Int -> [i] -> [i]
forall a. Int -> [a] -> [a]
drop Int
d ([i] -> [i]) -> [i] -> [i]
forall a b. (a -> b) -> a -> b
$ i -> [i]
forall a. Integral a => a -> [a]
binomials i
n of
      [] -> i
0
      i
m:[i]
_ -> i
m

-- cf. package combinatorial
binomials :: Integral a => a -> [a]
binomials :: a -> [a]
binomials a
n =
   (a -> (a, a) -> a) -> a -> [(a, a)] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\a
acc (a
num,a
den) -> a -> a -> a
forall a. Integral a => a -> a -> a
div (a
acca -> a -> a
forall a. Num a => a -> a -> a
*a
num) a
den) a
1
         ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
n, a -> a
forall a. Enum a => a -> a
pred a
n ..] [a
1..a
n])

foldLength :: (Foldable f) => f a -> Int
foldLength :: f a -> Int
foldLength = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (f a -> [a]) -> f a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList

instance
   (SimplexOrderC order, CollisionC coll,
    Traversable f, FunctorC.Eq1 f, Indexed size) =>
      Indexed (Simplex order coll f size) where
   type Index (Simplex order coll f size) = f (Index size)
   indices :: Simplex order coll f size -> [Index (Simplex order coll f size)]
indices (Simplex SimplexOrder order
order f coll
d size
sz) =
      (StateT [Index size] [] (f (Index size))
 -> [Index size] -> [f (Index size)])
-> [Index size]
-> StateT [Index size] [] (f (Index size))
-> [f (Index size)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [Index size] [] (f (Index size))
-> [Index size] -> [f (Index size)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT (size -> [Index size]
forall sh. Indexed sh => sh -> [Index sh]
indices size
sz) (StateT [Index size] [] (f (Index size)) -> [f (Index size)])
-> StateT [Index size] [] (f (Index size)) -> [f (Index size)]
forall a b. (a -> b) -> a -> b
$
      (coll -> StateT [Index size] [] (Index size))
-> f coll -> StateT [Index size] [] (f (Index size))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse
         (if SimplexOrder order -> Bool
forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
             then coll -> StateT [Index size] [] (Index size)
forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexAscending
             else coll -> StateT [Index size] [] (Index size)
forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexDescending)
         f coll
d
   inBounds :: Simplex order coll f size
-> Index (Simplex order coll f size) -> Bool
inBounds (Simplex SimplexOrder order
order f coll
d size
sz) =
      let getOffset :: Index size -> Int
getOffset = size -> Index size -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
offset size
sz in \Index (Simplex order coll f size)
ix ->
      let ixs :: [Index size]
ixs = f (Index size) -> [Index size]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f (Index size)
Index (Simplex order coll f size)
ix in
         (Index size -> Bool) -> [Index size] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (size -> Index size -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds size
sz) [Index size]
ixs Bool -> Bool -> Bool
&&
         f () -> f () -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
FunctorC.eq1 (f coll -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f coll
d) (f (Index size) -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f (Index size)
Index (Simplex order coll f size)
ix) Bool -> Bool -> Bool
&&
         SimplexOrder order -> [coll] -> [Int] -> Bool
forall coll order.
CollisionC coll =>
SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order (f coll -> [coll]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d) ((Index size -> Int) -> [Index size] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Index size -> Int
getOffset [Index size]
ixs)
   unifiedSizeOffset :: Simplex order coll f size
-> (Int, Index (Simplex order coll f size) -> Result check Int)
unifiedSizeOffset (Simplex SimplexOrder order
order f coll
d size
sz) =
      let (Int
n, Index size -> Result check Int
getOffset) = size -> (Int, Index size -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset size
sz in
      let dInt :: Int
dInt = f coll -> Int
forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength f coll
d
          prep :: (Int, f (Int, (Int, Int)))
prep = SimplexOrder order -> f coll -> Int -> (Int, f (Int, (Int, Int)))
forall (t :: * -> *) i coll order.
(Traversable t, Num i, CollisionC coll) =>
SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder SimplexOrder order
order f coll
d Int
n in
      (Int -> Int -> Int
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
dInt ((Int, f (Int, (Int, Int))) -> Int
forall a b. (a, b) -> a
fst (Int, f (Int, (Int, Int)))
prep),
          -- cf. Combinatorics.chooseRank
          \Index (Simplex order coll f size)
ixf -> do
            [Int]
ks <- (Index size -> Result check Int)
-> [Index size] -> Result check [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse Index size -> Result check Int
getOffset ([Index size] -> Result check [Int])
-> [Index size] -> Result check [Int]
forall a b. (a -> b) -> a -> b
$ f (Index size) -> [Index size]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f (Index size)
Index (Simplex order coll f size)
ixf
            String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert
               String
"Shape.Simplex.offset: simplex and index structure mismatch"
               (f () -> f () -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
FunctorC.eq1 (f coll -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f coll
d) (f (Index size) -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f (Index size)
Index (Simplex order coll f size)
ixf))
            String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert
               String
"Shape.Simplex.offset: index elements not monotonic"
               (SimplexOrder order -> [coll] -> [Int] -> Bool
forall coll order.
CollisionC coll =>
SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order (f coll -> [coll]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d) [Int]
ks)
            Int -> Result check Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$
               SimplexOrder order -> Int -> (Int, [(Int, Int)]) -> [Int] -> Int
forall i order.
Integral i =>
SimplexOrder order -> Int -> (i, [(Int, i)]) -> [i] -> i
simplexOffset SimplexOrder order
order Int
dInt
                  ((f (Int, (Int, Int)) -> [(Int, Int)])
-> (Int, f (Int, (Int, Int))) -> (Int, [(Int, Int)])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (((Int, (Int, Int)) -> (Int, Int))
-> [(Int, (Int, Int))] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd ([(Int, (Int, Int))] -> [(Int, Int)])
-> (f (Int, (Int, Int)) -> [(Int, (Int, Int))])
-> f (Int, (Int, Int))
-> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Int, (Int, Int)) -> [(Int, (Int, Int))]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList) (Int, f (Int, (Int, Int)))
prep) [Int]
ks)

simplexOffset ::
   (Integral i) => SimplexOrder order -> Int -> (i, [(Int, i)]) -> [i] -> i
simplexOffset :: SimplexOrder order -> Int -> (i, [(Int, i)]) -> [i] -> i
simplexOffset SimplexOrder order
order Int
d (i
nsum,[(Int, i)]
cis) [i]
ks =
   case SimplexOrder order
order of
      SimplexOrder order
Ascending ->
         Int -> i -> i
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
d i
nsum i -> i -> i
forall a. Num a => a -> a -> a
- i
1
         i -> i -> i
forall a. Num a => a -> a -> a
-
         [i] -> i
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((i -> (Int, i) -> i) -> [i] -> [(Int, i)] -> [i]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i
k (Int
x,i
y) -> Int -> i -> i
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (i
yi -> i -> i
forall a. Num a => a -> a -> a
-i
k)) [i]
ks [(Int, i)]
cis)
      SimplexOrder order
Descending ->
         [i] -> i
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((i -> (Int, i) -> i) -> [i] -> [(Int, i)] -> [i]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i
k (Int
x,i
y) -> Int -> i -> i
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (i
yi -> i -> i
forall a. Num a => a -> a -> a
+i
k)) [i]
ks [(Int, i)]
cis)

isMonotonic ::
   (CollisionC coll) => SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic :: SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order [coll]
cs =
   [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
   ([Bool] -> Bool) -> ([Int] -> [Bool]) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (if SimplexOrder order -> Bool
forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
      then
         ((coll, Int) -> (coll, Int) -> Bool) -> [(coll, Int)] -> [Bool]
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent
            (\(coll
c,Int
x) (coll
_,Int
y) -> if coll -> Bool
forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
c then Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
y else Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
y)
      else
         ((coll, Int) -> (coll, Int) -> Bool) -> [(coll, Int)] -> [Bool]
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent
            (\(coll
c,Int
x) (coll
_,Int
y) -> if coll -> Bool
forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
c then Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
y else Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
y))
   ([(coll, Int)] -> [Bool])
-> ([Int] -> [(coll, Int)]) -> [Int] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [coll] -> [Int] -> [(coll, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [coll]
cs

chooseIndexAscending, chooseIndexDescending ::
   (CollisionC coll) => coll -> MS.StateT [a] [] a

chooseIndexAscending :: coll -> StateT [a] [] a
chooseIndexAscending coll
coll =
   ([a] -> [(a, [a])]) -> StateT [a] [] a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT (([a] -> [(a, [a])]) -> StateT [a] [] a)
-> ([a] -> [(a, [a])]) -> StateT [a] [] a
forall a b. (a -> b) -> a -> b
$ \[a]
as -> [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as ([[a]] -> [(a, [a])]) -> [[a]] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$
      (if coll -> Bool
forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
coll then T [] [a] -> [[a]]
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten else T [] [a] -> [[a]]
forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail) (T [] [a] -> [[a]]) -> T [] [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$
      [a] -> T [] [a]
forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Cons g, Empty g) =>
f a -> T f (g a)
NonEmpty.tails [a]
as

chooseIndexDescending :: coll -> StateT [a] [] a
chooseIndexDescending coll
coll =
   ([a] -> [(a, [a])]) -> StateT [a] [] a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT (([a] -> [(a, [a])]) -> StateT [a] [] a)
-> ([a] -> [(a, [a])]) -> StateT [a] [] a
forall a b. (a -> b) -> a -> b
$ \[a]
as -> [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as ([[a]] -> [(a, [a])]) -> [[a]] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$
      (if coll -> Bool
forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
coll then T [] [a] -> [[a]]
forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail else T [] [a] -> [[a]]
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten) (T [] [a] -> [[a]]) -> T [] [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$
      [a] -> T [] [a]
forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Snoc g, Empty g) =>
f a -> T f (g a)
NonEmpty.inits [a]
as

instance
   (SimplexOrderC order, CollisionC coll,
    Traversable f, FunctorC.Eq1 f, InvIndexed size) =>
      InvIndexed (Simplex order coll f size) where
   unifiedIndexFromOffset :: Simplex order coll f size
-> Int -> Result check (Index (Simplex order coll f size))
unifiedIndexFromOffset (Simplex SimplexOrder order
order f coll
d size
sh) =
      let n :: Int
n = size -> Int
forall sh. C sh => sh -> Int
size size
sh in
      let (Int
nSum,f (Int, (Int, Int))
deco) = SimplexOrder order -> f coll -> Int -> (Int, f (Int, (Int, Int)))
forall (t :: * -> *) i coll order.
(Traversable t, Num i, CollisionC coll) =>
SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder SimplexOrder order
order f coll
d Int
n in
      let dInt :: Int
dInt = f coll -> Int
forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength f coll
d in \Int
k ->
      Result check (f (Index size))
-> (((Int, Int), f Int) -> Result check (f (Index size)))
-> Maybe ((Int, Int), f Int)
-> Result check (f (Index size))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
         (String -> Result check (f (Index size))
forall check a. Checking check => String -> Result check a
throwOrError (String -> Result check (f (Index size)))
-> String -> Result check (f (Index size))
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Simplex" Int
k)
         ((Int -> Result check (Index size))
-> f Int -> Result check (f (Index size))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse (size -> Int -> Result check (Index size)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset size
sh) (f Int -> Result check (f (Index size)))
-> (((Int, Int), f Int) -> f Int)
-> ((Int, Int), f Int)
-> Result check (f (Index size))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), f Int) -> f Int
forall a b. (a, b) -> b
snd) (Maybe ((Int, Int), f Int) -> Result check (f (Index size)))
-> Maybe ((Int, Int), f Int) -> Result check (f (Index size))
forall a b. (a -> b) -> a -> b
$
      if SimplexOrder order -> Bool
forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
         then
            ((Int, Int) -> (Int, (Int, Int)) -> Maybe ((Int, Int), Int))
-> (Int, Int) -> f (Int, (Int, Int)) -> Maybe ((Int, Int), f Int)
forall (t :: * -> *) (m :: * -> *) a b c.
(Traversable t, Monad m) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM
               (\(Int
a,Int
k0) (Int
db,(Int
x,Int
y)) ->
                  case ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$
                        (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
bi -> (Int
bi, Int
k0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
bi))) ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$
                        (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
n) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
a of
                     [] -> Maybe ((Int, Int), Int)
forall a. Maybe a
Nothing
                     (Int
b,Int
k1):[(Int, Int)]
_ -> ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
db, Int
k1), Int
b))
               (Int
0, Int -> Int -> Int
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
dInt Int
nSum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)
               f (Int, (Int, Int))
deco
         else
            ((Int, Int) -> (Int, (Int, Int)) -> Maybe ((Int, Int), Int))
-> (Int, Int) -> f (Int, (Int, Int)) -> Maybe ((Int, Int), f Int)
forall (t :: * -> *) (m :: * -> *) a b c.
(Traversable t, Monad m) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM
               (\(Int
a,Int
k0) (Int
db,(Int
x,Int
y)) ->
                  case ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$
                        (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
bi -> (Int
bi, Int
k0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bi))) ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$
                        (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) Int
a of
                     [] -> Maybe ((Int, Int), Int)
forall a. Maybe a
Nothing
                     (Int
b,Int
k1):[(Int, Int)]
_ -> ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
db, Int
k1), Int
b))
               (Int
n,Int
k)
               f (Int, (Int, Int))
deco

mapAccumLM ::
   (Traversable t, Monad m) => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM :: (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM a -> b -> m (a, c)
f a
a0 t b
xs =
   ((t c, a) -> (a, t c)) -> m (t c, a) -> m (a, t c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (t c, a) -> (a, t c)
forall a b. (a, b) -> (b, a)
swap (m (t c, a) -> m (a, t c)) -> m (t c, a) -> m (a, t c)
forall a b. (a -> b) -> a -> b
$
   StateT a m (t c) -> a -> m (t c, a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT
      ((b -> StateT a m c) -> t b -> StateT a m (t c)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Trav.mapM (\b
b -> (a -> m (c, a)) -> StateT a m c
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT ((a -> m (c, a)) -> StateT a m c)
-> (a -> m (c, a)) -> StateT a m c
forall a b. (a -> b) -> a -> b
$ \a
a -> ((a, c) -> (c, a)) -> m (a, c) -> m (c, a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, c) -> (c, a)
forall a b. (a, b) -> (b, a)
swap (m (a, c) -> m (c, a)) -> m (a, c) -> m (c, a)
forall a b. (a -> b) -> a -> b
$ a -> b -> m (a, c)
f a
a b
b) t b
xs) a
a0


prepareSimplexIndexingOrder ::
   (Traversable t, Num i, CollisionC coll) =>
   SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder :: SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder SimplexOrder order
order t coll
d Int
n =
   if SimplexOrder order -> Bool
forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
      then (Int -> Int)
-> (Int, t (Int, (i, Int))) -> (Int, t (Int, (i, Int)))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) ((Int, t (Int, (i, Int))) -> (Int, t (Int, (i, Int))))
-> (Int, t (Int, (i, Int))) -> (Int, t (Int, (i, Int)))
forall a b. (a -> b) -> a -> b
$ t coll -> Int -> (Int, t (Int, (i, Int)))
forall (t :: * -> *) i coll.
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
      else (Int -> Int)
-> (Int, t (Int, (i, Int))) -> (Int, t (Int, (i, Int)))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+) ((Int, t (Int, (i, Int))) -> (Int, t (Int, (i, Int))))
-> (Int, t (Int, (i, Int))) -> (Int, t (Int, (i, Int)))
forall a b. (a -> b) -> a -> b
$ t coll -> Int -> (Int, t (Int, (i, Int)))
forall (t :: * -> *) i coll.
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d Int
0

prepareSimplexIndexing ::
   (Traversable t, Num i, CollisionC coll) =>
   t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing :: t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d Int
n =
   let ((Bool
_,(i
_,Int
nSum)), t (Int, (i, Int))
deco) =
         ((Bool, (i, Int)) -> Bool -> ((Bool, (i, Int)), (Int, (i, Int))))
-> (Bool, (i, Int))
-> t Bool
-> ((Bool, (i, Int)), t (Int, (i, Int)))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Trav.mapAccumR
            (\(Bool
c0,(i
x,Int
y)) Bool
ci ->
               let c1 :: Int
c1 = Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool
ciBool -> Bool -> Bool
&&Bool
c0)
                   p :: (i, Int)
p = (i
xi -> i -> i
forall a. Num a => a -> a -> a
+i
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c1)
               in ((Bool
True,(i, Int)
p),(Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c1,(i, Int)
p)))
            (Bool
False,(i
0,Int
n))
            ((coll -> Bool) -> t coll -> t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap coll -> Bool
forall coll. CollisionC coll => coll -> Bool
repetitionAllowed t coll
d)
   in (Int
nSum, t (Int, (i, Int))
deco)



{- |
'Cyclic' is a shape, where the indices wrap around at the array boundaries.
E.g.

prop> let shape = Shape.Cyclic (10::Int) in Shape.offset shape (-1) == Shape.offset shape 9

This also means that there are multiple indices
that address the same array element.

>>> Shape.indices (Shape.Cyclic (7::Int))
[0,1,2,3,4,5,6]
-}
newtype Cyclic n = Cyclic {Cyclic n -> n
cyclicSize :: n}
   deriving (Cyclic n -> Cyclic n -> Bool
(Cyclic n -> Cyclic n -> Bool)
-> (Cyclic n -> Cyclic n -> Bool) -> Eq (Cyclic n)
forall n. Eq n => Cyclic n -> Cyclic n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cyclic n -> Cyclic n -> Bool
$c/= :: forall n. Eq n => Cyclic n -> Cyclic n -> Bool
== :: Cyclic n -> Cyclic n -> Bool
$c== :: forall n. Eq n => Cyclic n -> Cyclic n -> Bool
Eq, Int -> Cyclic n -> String -> String
[Cyclic n] -> String -> String
Cyclic n -> String
(Int -> Cyclic n -> String -> String)
-> (Cyclic n -> String)
-> ([Cyclic n] -> String -> String)
-> Show (Cyclic n)
forall n. Show n => Int -> Cyclic n -> String -> String
forall n. Show n => [Cyclic n] -> String -> String
forall n. Show n => Cyclic n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cyclic n] -> String -> String
$cshowList :: forall n. Show n => [Cyclic n] -> String -> String
show :: Cyclic n -> String
$cshow :: forall n. Show n => Cyclic n -> String
showsPrec :: Int -> Cyclic n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> Cyclic n -> String -> String
Show)

instance Functor Cyclic where
   fmap :: (a -> b) -> Cyclic a -> Cyclic b
fmap a -> b
f (Cyclic a
n) = b -> Cyclic b
forall n. n -> Cyclic n
Cyclic (b -> Cyclic b) -> b -> Cyclic b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance Applicative Cyclic where
   pure :: a -> Cyclic a
pure = a -> Cyclic a
forall n. n -> Cyclic n
Cyclic
   Cyclic a -> b
f <*> :: Cyclic (a -> b) -> Cyclic a -> Cyclic b
<*> Cyclic a
n = b -> Cyclic b
forall n. n -> Cyclic n
Cyclic (b -> Cyclic b) -> b -> Cyclic b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance (NFData n) => NFData (Cyclic n) where
   rnf :: Cyclic n -> ()
rnf (Cyclic n
n) = n -> ()
forall a. NFData a => a -> ()
rnf n
n

instance (Storable n) => Storable (Cyclic n) where
   sizeOf :: Cyclic n -> Int
sizeOf = (Cyclic n -> n) -> Cyclic n -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf Cyclic n -> n
forall n. Cyclic n -> n
cyclicSize
   alignment :: Cyclic n -> Int
alignment = (Cyclic n -> n) -> Cyclic n -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment Cyclic n -> n
forall n. Cyclic n -> n
cyclicSize
   peek :: Ptr (Cyclic n) -> IO (Cyclic n)
peek = (n -> Cyclic n) -> Ptr (Cyclic n) -> IO (Cyclic n)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek n -> Cyclic n
forall n. n -> Cyclic n
Cyclic
   poke :: Ptr (Cyclic n) -> Cyclic n -> IO ()
poke = (Cyclic n -> n) -> Ptr (Cyclic n) -> Cyclic n -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke Cyclic n -> n
forall n. Cyclic n -> n
cyclicSize

instance (Integral n) => C (Cyclic n) where
   size :: Cyclic n -> Int
size (Cyclic n
len) = n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len

instance (Integral n) => Indexed (Cyclic n) where
   type Index (Cyclic n) = n
   indices :: Cyclic n -> [Index (Cyclic n)]
indices (Cyclic n
len) = ZeroBased n -> [Index (ZeroBased n)]
forall sh. Indexed sh => sh -> [Index sh]
indices (ZeroBased n -> [Index (ZeroBased n)])
-> ZeroBased n -> [Index (ZeroBased n)]
forall a b. (a -> b) -> a -> b
$ n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased n
len
   unifiedOffset :: Cyclic n -> Index (Cyclic n) -> Result check Int
unifiedOffset (Cyclic n
len) Index (Cyclic n)
ix = Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (n -> Int) -> n -> Int
forall a b. (a -> b) -> a -> b
$ n -> n -> n
forall a. Integral a => a -> a -> a
mod n
Index (Cyclic n)
ix n
len
   inBounds :: Cyclic n -> Index (Cyclic n) -> Bool
inBounds (Cyclic n
len) Index (Cyclic n)
_ix = n
lenn -> n -> Bool
forall a. Ord a => a -> a -> Bool
>n
0

instance (Integral n) => InvIndexed (Cyclic n) where
   unifiedIndexFromOffset :: Cyclic n -> Int -> Result check (Index (Cyclic n))
unifiedIndexFromOffset (Cyclic n
len) Int
k0 = do
      let k :: n
k = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Cyclic" Int
k0 (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ n
0n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len
      n -> Result check n
forall (m :: * -> *) a. Monad m => a -> m a
return n
k



infixr 5 ::+

{- |
Row-major composition of two dimensions.

>>> Shape.indices (Shape.ZeroBased (3::Int) ::+ Shape.Range 'a' 'c')
[Left 0,Left 1,Left 2,Right 'a',Right 'b',Right 'c']
-}
data sh0::+sh1 = sh0::+sh1
   deriving ((sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
((sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool)
-> ((sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool) -> Eq (sh0 ::+ sh1)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall sh0 sh1.
(Eq sh0, Eq sh1) =>
(sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
/= :: (sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
$c/= :: forall sh0 sh1.
(Eq sh0, Eq sh1) =>
(sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
== :: (sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
$c== :: forall sh0 sh1.
(Eq sh0, Eq sh1) =>
(sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
Eq, Int -> (sh0 ::+ sh1) -> String -> String
[sh0 ::+ sh1] -> String -> String
(sh0 ::+ sh1) -> String
(Int -> (sh0 ::+ sh1) -> String -> String)
-> ((sh0 ::+ sh1) -> String)
-> ([sh0 ::+ sh1] -> String -> String)
-> Show (sh0 ::+ sh1)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall sh0 sh1.
(Show sh0, Show sh1) =>
Int -> (sh0 ::+ sh1) -> String -> String
forall sh0 sh1.
(Show sh0, Show sh1) =>
[sh0 ::+ sh1] -> String -> String
forall sh0 sh1. (Show sh0, Show sh1) => (sh0 ::+ sh1) -> String
showList :: [sh0 ::+ sh1] -> String -> String
$cshowList :: forall sh0 sh1.
(Show sh0, Show sh1) =>
[sh0 ::+ sh1] -> String -> String
show :: (sh0 ::+ sh1) -> String
$cshow :: forall sh0 sh1. (Show sh0, Show sh1) => (sh0 ::+ sh1) -> String
showsPrec :: Int -> (sh0 ::+ sh1) -> String -> String
$cshowsPrec :: forall sh0 sh1.
(Show sh0, Show sh1) =>
Int -> (sh0 ::+ sh1) -> String -> String
Show)

instance (NFData sh0, NFData sh1) => NFData (sh0::+sh1) where
   rnf :: (sh0 ::+ sh1) -> ()
rnf (sh0
sh0::+sh1
sh1) = (sh0, sh1) -> ()
forall a. NFData a => a -> ()
rnf (sh0
sh0,sh1
sh1)

instance (C sh0, C sh1) => C (sh0::+sh1) where
   size :: (sh0 ::+ sh1) -> Int
size (sh0
sh0::+sh1
sh1) = sh0 -> Int
forall sh. C sh => sh -> Int
size sh0
sh0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ sh1 -> Int
forall sh. C sh => sh -> Int
size sh1
sh1

instance (Indexed sh0, Indexed sh1) => Indexed (sh0::+sh1) where
   type Index (sh0::+sh1) = Either (Index sh0) (Index sh1)
   indices :: (sh0 ::+ sh1) -> [Index (sh0 ::+ sh1)]
indices (sh0
sh0::+sh1
sh1) = (Index sh0 -> Either (Index sh0) (Index sh1))
-> [Index sh0] -> [Either (Index sh0) (Index sh1)]
forall a b. (a -> b) -> [a] -> [b]
map Index sh0 -> Either (Index sh0) (Index sh1)
forall a b. a -> Either a b
Left (sh0 -> [Index sh0]
forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) [Either (Index sh0) (Index sh1)]
-> [Either (Index sh0) (Index sh1)]
-> [Either (Index sh0) (Index sh1)]
forall a. [a] -> [a] -> [a]
++ (Index sh1 -> Either (Index sh0) (Index sh1))
-> [Index sh1] -> [Either (Index sh0) (Index sh1)]
forall a b. (a -> b) -> [a] -> [b]
map Index sh1 -> Either (Index sh0) (Index sh1)
forall a b. b -> Either a b
Right (sh1 -> [Index sh1]
forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1)
   unifiedOffset :: (sh0 ::+ sh1) -> Index (sh0 ::+ sh1) -> Result check Int
unifiedOffset (sh0
sh0::+sh1
sh1) =
      let (Int
n0,Index sh0 -> Result check Int
getOffset0) = sh0 -> (Int, Index sh0 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0
          getOffset1 :: Index sh1 -> Result check Int
getOffset1 = sh1 -> Index sh1 -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh1
sh1
      in \Index (sh0 ::+ sh1)
ix ->
         case Index (sh0 ::+ sh1)
ix of
            Left ix0 -> Index sh0 -> Result check Int
getOffset0 Index sh0
ix0
            Right ix1 -> (Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Result check Int -> Result check Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index sh1 -> Result check Int
getOffset1 Index sh1
ix1
   unifiedSizeOffset :: (sh0 ::+ sh1) -> (Int, Index (sh0 ::+ sh1) -> Result check Int)
unifiedSizeOffset (sh0
sh0::+sh1
sh1) =
      let (Int
n0, Index sh0 -> Result check Int
getOffset0) = sh0 -> (Int, Index sh0 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0
          (Int
n1, Index sh1 -> Result check Int
getOffset1) = sh1 -> (Int, Index sh1 -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1
      in (Int
n0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n1, (Index sh0 -> Result check Int)
-> (Index sh1 -> Result check Int)
-> Either (Index sh0) (Index sh1)
-> Result check Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Index sh0 -> Result check Int
getOffset0 ((Int -> Int) -> Result check Int -> Result check Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
n0Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Result check Int -> Result check Int)
-> (Index sh1 -> Result check Int) -> Index sh1 -> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index sh1 -> Result check Int
getOffset1))
   inBounds :: (sh0 ::+ sh1) -> Index (sh0 ::+ sh1) -> Bool
inBounds (sh0
sh0::+sh1
sh1) = (Index sh0 -> Bool)
-> (Index sh1 -> Bool) -> Either (Index sh0) (Index sh1) -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (sh0 -> Index sh0 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0) (sh1 -> Index sh1 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1)

instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0::+sh1) where
   unifiedIndexFromOffset :: (sh0 ::+ sh1) -> Int -> Result check (Index (sh0 ::+ sh1))
unifiedIndexFromOffset (sh0
sh0::+sh1
sh1) =
      let pivot :: Int
pivot = sh0 -> Int
forall sh. C sh => sh -> Int
size sh0
sh0
      in \Int
k ->
         if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
pivot
            then Index sh0 -> Either (Index sh0) (Index sh1)
forall a b. a -> Either a b
Left (Index sh0 -> Either (Index sh0) (Index sh1))
-> Result check (Index sh0)
-> Result check (Either (Index sh0) (Index sh1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sh0 -> Int -> Result check (Index sh0)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh0
sh0 Int
k
            else Index sh1 -> Either (Index sh0) (Index sh1)
forall a b. b -> Either a b
Right (Index sh1 -> Either (Index sh0) (Index sh1))
-> Result check (Index sh1)
-> Result check (Either (Index sh0) (Index sh1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sh1 -> Int -> Result check (Index sh1)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh1
sh1 (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
pivot)

instance (Static sh0, Static sh1) => Static (sh0::+sh1) where
   static :: sh0 ::+ sh1
static = sh0
forall sh. Static sh => sh
staticsh0 -> sh1 -> sh0 ::+ sh1
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+sh1
forall sh. Static sh => sh
static


infixl 7 |*
infixl 6 |+|

(|*) :: (Functor f, Num a) => f a -> a -> f a
f a
f|* :: f a -> a -> f a
|*a
a = (a -> a) -> f a -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Num a => a -> a -> a
*a
a) f a
f

(|+|) :: (Applicative f, Num a) => f a -> f a -> f a
|+| :: f a -> f a -> f a
(|+|) = (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)