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

   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(..),

   NestedTuple(..),
   AccessorTuple(..),
   StaticTuple(..),
   Element(..),
   TupleAccessor,
   TupleIndex,

   ElementIndex,
   ElementTuple(..),
   indexTupleFromShape,

   Record(..),
   FieldIndex,
   indexRecordFromShape,

   Constructed,
   ConsIndex,
   Construction,
   construct,
   consIndex,
   ) 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.Writer as MW
import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.HT as Monad
import qualified Control.Applicative.HT as App
import qualified Control.Applicative.Backwards as Back
import Control.DeepSeq (NFData, rnf)
import Control.Monad (liftM)
import Control.Applicative (Applicative, pure, (<*>), (<$>))
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.Monoid (Sum(Sum, getSum))
import Data.Function.HT (compose2)
import Data.Tagged (Tagged(Tagged, unTagged))
import Data.Complex (Complex((:+)), realPart, imagPart)
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)

import Text.Printf (printf)


{- $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 ((::+)((::+)))
>>>
>>> import Test.ChasingBottoms.IsBottom (isBottom)
>>> import Control.DeepSeq (rnf)
-}


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 :: forall check. Checking check => CheckSingleton check
autoCheck = 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 :: forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
_ = forall check. Checking check => CheckSingleton check
autoCheck

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

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


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

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

instance Checking Unchecked where
   newtype Result Unchecked a = UncheckedResult {forall a. Result Unchecked a -> a
getUnchecked :: a}
   switchCheck :: forall (f :: * -> *). f Checked -> f Unchecked -> f Unchecked
switchCheck f Checked
_ f Unchecked
f = f Unchecked
f

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


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

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

assert :: (Checking check) => String -> Bool -> Result check ()
assert :: forall check. Checking check => String -> Bool -> Result check ()
assert String
msg Bool
cond = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
   case CheckSingleton check
check of
      CheckSingleton check
Unchecked -> forall a. a -> Result Unchecked a
UncheckedResult ()
      CheckSingleton check
Checked -> if Bool
cond then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else 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 (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 Either String a
a, CheckedResult Either String a
b)  ->  Either String a
aforall a. Eq a => a -> a -> Bool
==Either String a
b
         (CheckSingleton check
Unchecked, UncheckedResult a
a, UncheckedResult a
b)  ->  a
aforall a. Eq a => a -> a -> Bool
==a
b

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

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

instance (Checking check) => Monad (Result check) where
   return :: forall a. a -> Result check a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Result check a
a >>= :: forall a b.
Result check a -> (a -> Result check b) -> Result check b
>>= a -> Result check b
b =
      case (forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a, Result check a
a) of
         (CheckSingleton check
Checked, CheckedResult Either String a
e) -> forall a. Either String a -> Result Checked a
CheckedResult forall a b. (a -> b) -> a -> b
$ forall a. Result Checked a -> Either String a
getChecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result check b
b forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String a
e
         (CheckSingleton check
Unchecked, UncheckedResult a
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 = forall a. String -> Result Checked a -> a
runChecked String
"offset" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Result Unchecked a -> a
getUnchecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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 = forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Result Checked a -> Either String a
getChecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall sh. C sh => sh -> Int
size sh
sh, forall sh. Indexed sh => sh -> Index sh -> Int
offset sh
sh)
   uncheckedSizeOffset :: sh -> (Int, Index sh -> Int)
   uncheckedSizeOffset sh
sh = (forall sh. C sh => sh -> Int
size sh
sh, forall sh. Indexed sh => sh -> Index sh -> Int
uncheckedOffset sh
sh)
   unifiedSizeOffset ::
      (Checking check) => sh -> (Int, Index sh -> Result check Int)
   unifiedSizeOffset sh
sh = (forall sh. C sh => sh -> Int
size sh
sh, 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 = forall a. String -> Result Checked a -> a
runChecked String
"indexFromOffset" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh
   uncheckedIndexFromOffset :: sh -> Int -> Index sh
   uncheckedIndexFromOffset sh
sh = forall a. Result Unchecked a -> a
getUnchecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
name Int
k Bool
cond = 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

{-
We need superclass Indexed for Index type function.
But this disables the sensible instance Pattern Zero.
-}
class (Indexed sh) => Pattern sh where
   type DataPattern sh x
   indexPattern :: (Index sh -> x) -> sh -> DataPattern sh x


data Zero = Zero
   deriving (Zero -> Zero -> Bool
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
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
Ord, Int -> Zero -> String -> String
[Zero] -> String -> String
Zero -> String
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

{-
missing superclass Indexed

instance Pattern Zero where
   type DataPattern Zero x = ()
   indexPattern _ Zero = ()
-}


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

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

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

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

instance Pattern () where
   type DataPattern () x = x
   indexPattern :: forall x. (Index () -> x) -> () -> DataPattern () x
indexPattern Index () -> x
extend = Index () -> x
extend


{- |
'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 {forall n. ZeroBased n -> n
zeroBasedSize :: n}
   deriving (ZeroBased n -> ZeroBased n -> Bool
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
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 :: forall a b. (a -> b) -> ZeroBased a -> ZeroBased b
fmap a -> b
f (ZeroBased a
n) = forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance Applicative ZeroBased where
   pure :: forall n. n -> ZeroBased n
pure = forall n. n -> ZeroBased n
ZeroBased
   ZeroBased a -> b
f <*> :: forall a b. ZeroBased (a -> b) -> ZeroBased a -> ZeroBased b
<*> ZeroBased a
n = forall n. n -> ZeroBased n
ZeroBased 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) = forall a. NFData a => a -> ()
rnf n
n

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

instance (Integral n) => C (ZeroBased n) where
   size :: ZeroBased n -> Int
size (ZeroBased n
len) = 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) = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<n
len) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+n
1) n
0
   unifiedOffset :: forall check.
Checking check =>
ZeroBased n -> Index (ZeroBased n) -> Result check Int
unifiedOffset (ZeroBased n
len) = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset forall a b. (a -> b) -> a -> b
$ 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
0forall a. Ord a => a -> a -> Bool
<=Index (ZeroBased n)
ix Bool -> Bool -> Bool
&& Index (ZeroBased n)
ixforall a. Ord a => a -> a -> Bool
<n
len

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

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


instance (Integral n) => Pattern (ZeroBased n) where
   type DataPattern (ZeroBased n) x = n -> x
   indexPattern :: forall x.
(Index (ZeroBased n) -> x)
-> ZeroBased n -> DataPattern (ZeroBased n) x
indexPattern Index (ZeroBased n) -> x
extend (ZeroBased n
_n) = Index (ZeroBased n) -> x
extend


{- |
'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 {forall n. OneBased n -> n
oneBasedSize :: n}
   deriving (OneBased n -> OneBased n -> Bool
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
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 :: forall a b. (a -> b) -> OneBased a -> OneBased b
fmap a -> b
f (OneBased a
n) = forall n. n -> OneBased n
OneBased forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance Applicative OneBased where
   pure :: forall n. n -> OneBased n
pure = forall n. n -> OneBased n
OneBased
   OneBased a -> b
f <*> :: forall a b. OneBased (a -> b) -> OneBased a -> OneBased b
<*> OneBased a
n = forall n. n -> OneBased n
OneBased 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) = forall a. NFData a => a -> ()
rnf n
n

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

instance (Integral n) => C (OneBased n) where
   size :: OneBased n -> Int
size (OneBased n
len) = 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) = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<=n
len) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+n
1) n
1
   unifiedOffset :: forall check.
Checking check =>
OneBased n -> Index (OneBased n) -> Result check Int
unifiedOffset (OneBased n
len) = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset forall a b. (a -> b) -> a -> b
$ 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
0forall a. Ord a => a -> a -> Bool
<Index (OneBased n)
ix Bool -> Bool -> Bool
&& Index (OneBased n)
ixforall a. Ord a => a -> a -> Bool
<=n
len

instance (Integral n) => InvIndexed (OneBased n) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
OneBased n -> Int -> Result check (Index (OneBased n))
unifiedIndexFromOffset (OneBased n
len) Int
k0 = do
      let k :: n
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"OneBased" Int
k0 forall a b. (a -> b) -> a -> b
$ n
0forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kforall a. Ord a => a -> a -> Bool
<n
len
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ n
1forall 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 {forall n. Range n -> n
rangeFrom, forall n. Range n -> n
rangeTo :: n}
   deriving (Range n -> Range n -> Bool
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
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 :: forall a b. (a -> b) -> Range a -> Range b
fmap a -> b
f (Range a
from a
to) = 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) = 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) = 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) = 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 = forall a. Ix a => (a, a) -> a -> Int
Ix.index (n
from,n
to) Index (Range n)
ix
   uncheckedOffset :: Range n -> Index (Range n) -> Int
uncheckedOffset (Range n
from n
to) Index (Range n)
ix = forall a. Ix a => (a, a) -> a -> Int
Ix.unsafeIndex (n
from,n
to) Index (Range n)
ix
   unifiedOffset :: forall check.
Checking check =>
Range n -> Index (Range n) -> Result check Int
unifiedOffset (Range n
from n
to) Index (Range n)
ix = do
      forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Range: index out of range" forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (n
from,n
to) Index (Range n)
ix
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> a -> Int
Ix.unsafeIndex (n
from,n
to) Index (Range n)
ix
   inBounds :: Range n -> Index (Range n) -> Bool
inBounds (Range n
from n
to) Index (Range n)
ix = forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (n
from,n
to) Index (Range n)
ix

-- pretty inefficient when we rely solely on Ix
instance (Ix.Ix n) => InvIndexed (Range n) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Range n -> Int -> Result check (Index (Range n))
unifiedIndexFromOffset (Range n
from n
to) Int
k = do
      forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Range" Int
k forall a b. (a -> b) -> a -> b
$ Int
0forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
k forall a. Ord a => a -> a -> Bool
< forall a. Ix a => (a, a) -> Int
Ix.rangeSize (n
from,n
to)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> [a]
Ix.range (n
from,n
to) 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) = forall a. Storable a => a -> Int
sizeOf n
l forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod (- forall a. Storable a => a -> Int
sizeOf n
l) (forall a. Storable a => a -> Int
alignment n
r) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf n
r
   alignment :: Range n -> Int
alignment ~(Range n
l n
_) = 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 = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Range n)
p
      in  forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr n
q n
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Range n)
p
      in  forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 forall n. n -> n -> Range n
Range (forall a. Storable a => Ptr a -> IO a
peek Ptr n
q) (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 {forall n. Shifted n -> n
shiftedOffset, forall n. Shifted n -> n
shiftedSize :: n}
   deriving (Shifted n -> Shifted n -> Bool
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
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 :: forall a b. (a -> b) -> Shifted a -> Shifted b
fmap a -> b
f (Shifted a
from a
to) = 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) = 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) = 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) =
      forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
      forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
>n
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
      forall a b. [a] -> [b] -> [(a, b)]
zip
         (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
subtract n
1) n
len)
         (forall a. (a -> a) -> a -> [a]
iterate (n
1forall a. Num a => a -> a -> a
+) n
offs)
   unifiedOffset :: forall check.
Checking check =>
Shifted n -> Index (Shifted n) -> Result check Int
unifiedOffset (Shifted n
offs n
len) Index (Shifted n)
ix = do
      forall check. Checking check => String -> Bool -> Result check ()
assert (forall r. PrintfType r => String -> r
printf String
"Shape.Shifted: array index too small (%d vs %d)" (forall a. Integral a => a -> Integer
toInteger n
offs) (forall a. Integral a => a -> Integer
toInteger Index (Shifted n)
ix)) forall a b. (a -> b) -> a -> b
$ Index (Shifted n)
ixforall a. Ord a => a -> a -> Bool
>=n
offs
      let k :: n
k = Index (Shifted n)
ixforall a. Num a => a -> a -> a
-n
offs
      forall check. Checking check => String -> Bool -> Result check ()
assert (forall r. PrintfType r => String -> r
printf String
"Shape.Shifted: array index too big (%d vs %d)" (forall a. Integral a => a -> Integer
toInteger n
k) (forall a. Integral a => a -> Integer
toInteger n
len)) forall a b. (a -> b) -> a -> b
$ n
kforall a. Ord a => a -> a -> Bool
<n
len
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a. Ord a => a -> a -> Bool
<= Index (Shifted n)
ix Bool -> Bool -> Bool
&& Index (Shifted n)
ix forall a. Ord a => a -> a -> Bool
< n
offsforall a. Num a => a -> a -> a
+n
len

instance (Integral n) => InvIndexed (Shifted n) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Shifted n -> Int -> Result check (Index (Shifted n))
unifiedIndexFromOffset (Shifted n
offs n
len) Int
k0 = do
      let k :: n
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Shifted" Int
k0 forall a b. (a -> b) -> a -> b
$ n
0forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kforall a. Ord a => a -> a -> Bool
<n
len
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ n
offsforall 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) = forall a. Storable a => a -> Int
sizeOf n
l forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod (- forall a. Storable a => a -> Int
sizeOf n
l) (forall a. Storable a => a -> Int
alignment n
n) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf n
n
   alignment :: Shifted n -> Int
alignment ~(Shifted n
l n
_) = 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 = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Shifted n)
p
      in  forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr n
q n
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Shifted n)
p
      in  forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 forall n. n -> n -> Shifted n
Shifted (forall a. Storable a => Ptr a -> IO a
peek Ptr n
q) (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr n
q Int
1)


{-# INLINE castToElemPtr #-}
castToElemPtr :: Ptr (f a) -> Ptr a
castToElemPtr :: forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr = 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
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
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 = forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
minBound 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 = [forall n. Enumeration n -> n -> n
asEnumType Enumeration n
sh forall a. Bounded a => a
minBound .. forall n. Enumeration n -> n -> n
asEnumType Enumeration n
sh forall a. Bounded a => a
maxBound]
   unifiedOffset :: forall check.
Checking check =>
Enumeration n -> Index (Enumeration n) -> Result check Int
unifiedOffset Enumeration n
sh Index (Enumeration n)
ix = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Index (Enumeration n)
ix forall a. Num a => a -> a -> a
- forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh 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 :: forall check.
Checking check =>
Enumeration n -> Int -> Result check (Index (Enumeration n))
unifiedIndexFromOffset Enumeration n
sh Int
k = do
      let minBnd :: Int
minBnd = forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
minBound
      forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Enumeration" Int
k forall a b. (a -> b) -> a -> b
$
         Int
0forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
k forall a. Ord a => a -> a -> Bool
<= forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- Int
minBnd
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int
minBnd forall a. Num a => a -> a -> a
+ Int
k

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

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

instance (Enum n, Bounded n) => Static (Enumeration n) where
   static :: Enumeration n
static = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
   peek :: Ptr (Enumeration n) -> IO (Enumeration n)
peek Ptr (Enumeration n)
_p = forall (m :: * -> *) a. Monad m => a -> m a
return forall n. Enumeration n
Enumeration


instance (Ord n) => C (Set n) where
   size :: Set n -> Int
size = 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'.

An @Array (Set k) a@ is isomorphic to a @Map k a@,
however it is missing most 'Map' operations like @insert@, @delete@ and @union@.
An @Array (Set k, Set j) a@ has a cartesian structure
and thus is not isomorphic to @Map (k,j) a@.
This means, if the array has two elements with indices @(k0,j0)@ and @(k1,j1)@
it has also an element with index @(k0,j1)@.

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 = forall a. Set a -> [a]
Set.toAscList
   unifiedOffset :: forall check.
Checking check =>
Set n -> Index (Set n) -> Result check Int
unifiedOffset Set n
sh Index (Set n)
ix = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
      case CheckSingleton check
check of
         CheckSingleton check
Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> a -> Int
ShapeSet.uncheckedOffset Set n
sh Index (Set n)
ix
         CheckSingleton check
Checked ->
            case forall a. Ord a => Set a -> a -> Maybe Int
ShapeSet.offset Set n
sh Index (Set n)
ix of
               Just Int
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
k
               Maybe Int
Nothing ->
                  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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Bool
Set.member

instance (Ord n) => InvIndexed (Set n) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Set n -> Int -> Result check (Index (Set n))
unifiedIndexFromOffset Set n
sh Int
k = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
      case CheckSingleton check
check of
         CheckSingleton check
Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Int -> a
ShapeSet.uncheckedIndexFromOffset Set n
sh Int
k
         CheckSingleton check
Checked ->
            case forall a. Set a -> Int -> Maybe a
ShapeSet.indexFromOffset Set n
sh Int
k of
               Just n
ix -> forall (f :: * -> *) a. Applicative f => a -> f a
pure n
ix
               Maybe n
Nothing -> forall a. String -> Result Checked a
throw 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map 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 =
      forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Fold.fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\k
k shape
shape -> forall a b. (a -> b) -> [a] -> [b]
map ((,) k
k) forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> [Index sh]
indices shape
shape)
   unifiedOffset :: forall check.
Checking check =>
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
Trav.mapAccumL (\Int
l (Int
sz,Index shape -> Result check Int
getOffset) -> (Int
l 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
k,Index shape
ix) ->
         case 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 -> 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
lforall a. Num a => a -> a -> a
+) 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
k,Index shape
ix) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Fold.any (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds Index shape
ix) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k shape
m

   unifiedSizeOffset :: forall check.
Checking check =>
Map k shape -> (Int, Index (Map k shape) -> Result check Int)
unifiedSizeOffset = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 :: 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 (i, ix -> Result check i)
ms =
   (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a, b) -> a
fst Map k (i, ix -> Result check i)
ms,
    let mu :: Map k (ix -> Result check i)
mu = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
         forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
Trav.mapAccumL (\i
l (i
sz,ix -> Result check i
offs) -> (i
l forall a. Num a => a -> a -> a
+ i
sz, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i
lforall a. Num a => a -> a -> a
+) 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) ->
         forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.Map.sizeOffset: unknown key")
            (forall a b. (a -> b) -> a -> b
$ix
ix)
            (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 :: forall check.
Checking check =>
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
            [] -> forall check a. Checking check => String -> Result check a
throwOrError forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Map" Int
i) forall a b. (a -> b) -> a -> b
$
      forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
u,Result check (k, Index shape)
_ix) -> Int
uforall a. Ord a => a -> a -> Bool
<=Int
i) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
         (\Int
l (k
k,shape
sh) ->
            let u :: Int
u = Int
l forall a. Num a => a -> a -> a
+ forall sh. C sh => sh -> Int
size shape
sh
            in (Int
u, (Int
u, (,) k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset shape
sh (Int
iforall a. Num a => a -> a -> a
-Int
l)))) Int
0 forall a b. (a -> b) -> a -> b
$
      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
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
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
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, 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
Ord, Int -> DeferredIndex sh -> String -> String
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) = forall a. NFData a => a -> ()
rnf sh
sh

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

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

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

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

instance (Static sh) => Static (Deferred sh) where
   static :: Deferred sh
static = forall sh. sh -> Deferred sh
Deferred 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) = forall a. Storable a => a -> Int
sizeOf Int
k
   alignment :: DeferredIndex sh -> Int
alignment (DeferredIndex Int
k) = forall a. Storable a => a -> Int
alignment Int
k
   poke :: Ptr (DeferredIndex sh) -> DeferredIndex sh -> IO ()
poke Ptr (DeferredIndex sh)
p (DeferredIndex Int
k) = forall a. Storable a => Ptr a -> a -> IO ()
poke (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall sh. Int -> DeferredIndex sh
DeferredIndex forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek (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) = 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) = forall a b. (a -> b) -> [a] -> [b]
map forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> [Index sh]
indices sh
sh
   unifiedOffset :: forall check.
Checking check =>
Tagged s sh -> Index (Tagged s sh) -> Result check Int
unifiedOffset (Tagged sh
sh) = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged
   unifiedSizeOffset :: forall check.
Checking check =>
Tagged s sh -> (Int, Index (Tagged s sh) -> Result check Int)
unifiedSizeOffset (Tagged sh
sh) =
      forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged) forall a b. (a -> b) -> a -> b
$ 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 Index sh
k) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh
sh Index sh
k

instance (InvIndexed sh) => InvIndexed (Tagged s sh) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Tagged s sh -> Int -> Result check (Index (Tagged s sh))
unifiedIndexFromOffset (Tagged sh
sh) Int
k =
      forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall sh. Static sh => sh
static

instance (Pattern sh) => Pattern (Tagged s sh) where
   type DataPattern (Tagged s sh) x = DataPattern sh x
   indexPattern :: forall x.
(Index (Tagged s sh) -> x)
-> Tagged s sh -> DataPattern (Tagged s sh) x
indexPattern Index (Tagged s sh) -> x
extend (Tagged sh
sh) = forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (Index (Tagged s sh) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. b -> Tagged s b
Tagged) sh
sh



instance (C sh0, C sh1) => C (sh0,sh1) where
   size :: (sh0, sh1) -> Int
size (sh0
sh0,sh1
sh1) = forall sh. C sh => sh -> Int
size sh0
sh0 forall a. Num a => a -> a -> a
* 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) = forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 (,) (forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) (forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1)
   unifiedOffset :: forall check.
Checking check =>
(sh0, sh1) -> Index (sh0, sh1) -> Result check Int
unifiedOffset (sh0
sh0,sh1
sh1) =
      (forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh0
sh0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
      forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> ix -> f a
`combineOffset`
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
   unifiedSizeOffset :: forall check.
Checking check =>
(sh0, sh1) -> (Int, Index (sh0, sh1) -> Result check Int)
unifiedSizeOffset (sh0
sh0,sh1
sh1) =
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0)
      forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ 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) (Index sh0
ix0,Index sh1
ix1) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0 Index sh0
ix0 Bool -> Bool -> 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 :: forall check.
Checking check =>
(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) =
            forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) (forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh0
sh0) (forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh1
sh1)
      Index sh0
ix0 <- Result check (Index sh0)
rix0
      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 = (forall sh. Static sh => sh
static, forall sh. Static sh => sh
static)

instance (Pattern sh0, Pattern sh1) => Pattern (sh0,sh1) where
   type DataPattern (sh0,sh1) x = PatternRecord sh0 (DataPattern sh1 x)
   indexPattern :: forall x.
(Index (sh0, sh1) -> x) -> (sh0, sh1) -> DataPattern (sh0, sh1) x
indexPattern Index (sh0, sh1) -> x
extend (sh0
sh0,sh1
sh1) =
      forall sh a. DataPattern sh a -> PatternRecord sh a
PatternRecord forall a b. (a -> b) -> a -> b
$
         forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh0
i -> forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh1
j -> Index (sh0, sh1) -> x
extend (Index sh0
i,Index sh1
j)) sh1
sh1) sh0
sh0


instance (C sh0, C sh1, C sh2) => C (sh0,sh1,sh2) where
   size :: (sh0, sh1, sh2) -> Int
size (sh0
sh0,sh1
sh1,sh2
sh2) = forall sh. C sh => sh -> Int
size sh0
sh0 forall a. Num a => a -> a -> a
* forall sh. C sh => sh -> Int
size sh1
sh1 forall a. Num a => a -> a -> a
* 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) =
      forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
Monad.lift3 (,,) (forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) (forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1) (forall sh. Indexed sh => sh -> [Index sh]
indices sh2
sh2)
   unifiedOffset :: forall check.
Checking check =>
(sh0, sh1, sh2) -> Index (sh0, sh1, sh2) -> Result check Int
unifiedOffset (sh0
sh0,sh1
sh1,sh2
sh2) =
      (forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh0
sh0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3)
      forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> ix -> f a
`combineOffset`
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> b
snd3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
      forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> c
thd3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh2
sh2)
   unifiedSizeOffset :: forall check.
Checking check =>
(sh0, sh1, sh2) -> (Int, Index (sh0, sh1, sh2) -> Result check Int)
unifiedSizeOffset (sh0
sh0,sh1
sh1,sh2
sh2) =
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> a
fst3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0)
      forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> b
snd3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
      forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> c
thd3) forall a b. (a -> b) -> a -> b
$ 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) (Index sh0
ix0,Index sh1
ix1,Index sh2
ix2) =
      forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0 Index sh0
ix0 Bool -> Bool -> Bool
&& forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1 Index sh1
ix1 Bool -> Bool -> 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 :: forall check.
Checking check =>
(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) =
            forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,) (forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh0
sh0) (forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh1
sh1) (forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh2
sh2)
      Index sh0
ix0 <- Result check (Index sh0)
rix0
      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 = (forall sh. Static sh => sh
static, forall sh. Static sh => sh
static, forall sh. Static sh => sh
static)

runInvIndex :: s -> Back.Backwards (MS.State s) a -> a
runInvIndex :: forall s a. s -> Backwards (State s) a -> a
runInvIndex s
k = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
MS.evalState s
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh
sh =
   forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets forall a b. (a -> b) -> a -> b
$ 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 :: forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh
sh =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall sh. InvIndexed sh => sh -> Int -> Index sh
uncheckedIndexFromOffset sh
sh) forall a b. (a -> b) -> a -> b
$
   forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state forall a b. (a -> b) -> a -> b
$ \Int
k -> forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> (a, a)
divMod Int
k forall a b. (a -> b) -> a -> b
$ 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 :: forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(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 forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
|* a
size1 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 :: forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(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
size0forall a. Num a => a -> a -> a
*a
size1, \ix
ix -> ix -> f a
offset0 ix
ix forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
|* a
size1 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 {forall sh. Square sh -> sh
squareSize :: sh}
   deriving (Square sh -> Square sh -> Bool
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
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 :: forall a b. (a -> b) -> Square a -> Square b
fmap a -> b
f (Square a
sh) = forall sh. sh -> Square sh
Square forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh

instance Applicative Square where
   pure :: forall sh. sh -> Square sh
pure = forall sh. sh -> Square sh
Square
   Square a -> b
f <*> :: forall a b. Square (a -> b) -> Square a -> Square b
<*> Square a
sh = forall sh. sh -> Square sh
Square 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) = forall a. NFData a => a -> ()
rnf sh
sh

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

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

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

newtype PatternRecord sh a = PatternRecord (DataPattern sh a)

instance (Pattern sh) => Pattern (Square sh) where
   -- Would require UndecidableInstances
   -- type DataPattern (Square sh) x = DataPattern sh (DataPattern sh x)

   type DataPattern (Square sh) x = PatternRecord sh (DataPattern sh x)
   indexPattern :: forall x.
(Index (Square sh) -> x) -> Square sh -> DataPattern (Square sh) x
indexPattern Index (Square sh) -> x
extend (Square sh
sh) =
      forall sh a. DataPattern sh a -> PatternRecord sh a
PatternRecord forall a b. (a -> b) -> a -> b
$
         forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh
i -> forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh
j -> Index (Square sh) -> x
extend (Index sh
i,Index sh
j)) 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 {forall sh. Cube sh -> sh
cubeSize :: sh}
   deriving (Cube sh -> Cube sh -> Bool
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
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 :: forall a b. (a -> b) -> Cube a -> Cube b
fmap a -> b
f (Cube a
sh) = forall sh. sh -> Cube sh
Cube forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh

instance Applicative Cube where
   pure :: forall sh. sh -> Cube sh
pure = forall sh. sh -> Cube sh
Cube
   Cube a -> b
f <*> :: forall a b. Cube (a -> b) -> Cube a -> Cube b
<*> Cube a
sh = forall sh. sh -> Cube sh
Cube 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) = forall a. NFData a => a -> ()
rnf sh
sh

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

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

instance (InvIndexed sh) => InvIndexed (Cube sh) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Cube sh -> Int -> Result check (Index (Cube sh))
unifiedIndexFromOffset (Cube 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
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
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
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
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 :: forall (f :: * -> *). f Lower -> f Upper -> f Lower
switchTriangularPart f Lower
f f Upper
_ = f Lower
f
instance TriangularPart Upper where switchTriangularPart :: forall (f :: * -> *). f Lower -> f Upper -> f Upper
switchTriangularPart f Lower
_ f Upper
f = f Upper
f

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

caseTriangularPart :: (TriangularPart part) => part -> a -> a -> a
caseTriangularPart :: forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part a
lo a
up =
   forall c a. c -> Const a c -> a
getConstAs part
part forall a b. (a -> b) -> a -> b
$ forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall {k} a (b :: k). a -> Const a b
Const a
lo) (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 {
      forall part size. Triangular part size -> part
triangularPart :: part,
      forall part size. Triangular part size -> size
triangularSize :: size
   } deriving (Int -> Triangular part size -> String -> String
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 {forall part. Equal part -> part -> part -> Bool
getEqual :: part -> part -> Bool}

equalPart :: (TriangularPart part) => part -> part -> Bool
equalPart :: forall part. TriangularPart part => part -> part -> Bool
equalPart = forall part. Equal part -> part -> part -> Bool
getEqual forall a b. (a -> b) -> a -> b
$ forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall part. (part -> part -> Bool) -> Equal part
Equal forall a. Eq a => a -> a -> Bool
(==)) (forall part. (part -> part -> Bool) -> Equal part
Equal 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  =  forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 forall part. TriangularPart part => part -> part -> Bool
equalPart forall part size. Triangular part size -> part
triangularPart Triangular part size
x Triangular part size
y Bool -> Bool -> Bool
&& forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating 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 :: forall size. size -> LowerTriangular size
lowerTriangular = forall part size. part -> size -> Triangular part size
Triangular Lower
Lower

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

-- cf. Data.Bifunctor.Flip
newtype Flip f b a = Flip {forall (f :: * -> * -> *) b a. 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) =
      forall a. NFData a => a -> ()
rnf
         (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> * -> *) b a. Flip f b a -> f a b
getFlip part
part forall a b. (a -> b) -> a -> b
$
            forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip forall a b. (a -> b) -> a -> b
$ \Lower
Lower -> ()) (forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip 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 forall a b. (a -> b) -> a -> b
$ 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 = forall sh. Indexed sh => sh -> [Index sh]
indices size
sz
      in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
         forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
            (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Index size]
cs Index size
r -> forall a b. (a -> b) -> [a] -> [b]
map ((,) Index size
r) [Index size]
cs)
               (forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Snoc g, Empty g) =>
f a -> T f (g a)
NonEmpty.inits [Index size]
ixs) [Index size]
ixs)
            (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Index size
r [Index size]
cs -> forall a b. (a -> b) -> [a] -> [b]
map ((,) Index size
r) [Index size]
cs) [Index size]
ixs forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
tails [Index size]
ixs)

   unifiedSizeOffset :: forall check.
Checking check =>
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) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset size
sz
      in (Int -> Int
triangleSize Int
n, \(Index size
rs,Index size
cs) -> do
         Int
r <- Index size -> Result check Int
getOffset Index size
rs
         Int
c <- Index size -> Result check Int
getOffset Index size
cs
         forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Triangular.sizeOffset: wrong array part" forall a b. (a -> b) -> a -> b
$
            forall part a.
(TriangularPart part, Ord a) =>
part -> a -> a -> Bool
compareIndices part
part Int
r Int
c
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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@(Index size
r,Index size
c) =
      forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (size
sz,size
sz) Index (Triangular part size)
ix
      Bool -> Bool -> Bool
&&
      let getOffset :: Index size -> Int
getOffset = forall sh. Indexed sh => sh -> Index sh -> Int
offset size
sz
      in 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 :: forall part.
TriangularPart part =>
part -> Int -> (Int, Int) -> Int
triangleOffset part
part Int
n (Int
r,Int
c) =
   forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
      (Int -> Int
triangleSize Int
r forall a. Num a => a -> a -> a
+ Int
c)
      (Int -> Int
triangleSize Int
n forall a. Num a => a -> a -> a
- Int -> Int
triangleSize (Int
nforall a. Num a => a -> a -> a
-Int
r) forall a. Num a => a -> a -> a
+ Int
cforall a. Num a => a -> a -> a
-Int
r)

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

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

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

triangleSize :: Int -> Int
triangleSize :: Int -> Int
triangleSize Int
n = forall a. Integral a => a -> a -> a
div (Int
nforall a. Num a => a -> a -> a
*(Int
nforall 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 :: forall a. Floating a => a -> a
triangleRoot a
sz = (forall a. Floating a => a -> a
sqrt (a
8forall a. Num a => a -> a -> a
*a
szforall a. Num a => a -> a -> a
+a
1)forall a. Num a => a -> a -> a
-a
1)forall a. Fractional a => a -> a -> a
/a
2

triangleRootDouble :: Int -> Double
triangleRootDouble :: Int -> Double
triangleRootDouble = forall a. Floating a => a -> a
triangleRoot forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall part size. part -> size -> Triangular part size
Triangular forall part. TriangularPart part => part
autoPart forall sh. Static sh => sh
static

autoPart :: (TriangularPart part) => part
autoPart :: forall part. TriangularPart part => part
autoPart = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall a. a -> Identity a
Identity Lower
Lower) (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 {
      forall order coll (f :: * -> *) size.
Simplex order coll f size -> SimplexOrder order
simplexOrder :: SimplexOrder order,
      forall order coll (f :: * -> *) size.
Simplex order coll f size -> f coll
simplexDimension :: f coll,
      forall order coll (f :: * -> *) size.
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 :: forall (f :: * -> *) coll size.
f coll -> size -> SimplexAscending coll f size
simplexAscending = 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 :: forall (f :: * -> *) coll size.
f coll -> size -> SimplexDescending coll f size
simplexDescending = forall order coll (f :: * -> *) size.
SimplexOrder order -> f coll -> size -> Simplex order coll f size
Simplex SimplexOrder Descending
Descending

isAscending :: SimplexOrder order -> Bool
isAscending :: forall order. 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
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
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
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
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
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
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
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
Ord, Int -> Collision
Collision -> Int
Collision -> [Collision]
Collision -> Collision
Collision -> Collision -> [Collision]
Collision -> Collision -> Collision -> [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
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
         String -> String -> String
showString String
"Simplex " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a. Show a => a -> String -> String
shows SimplexOrder order
order forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         String -> String -> String
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall (f :: * -> *) a.
(Show1 f, Show a) =>
Int -> f a -> String -> String
FunctorC.showsPrec1 Int
11 f coll
d forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         String -> String -> String
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         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 = forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d
          rep :: Int
rep = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall coll. CollisionC coll => coll -> Bool
repetitionAllowed forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
laxInit [coll]
ds
      in forall i. Integral i => Int -> i -> i
simplexLayoutSize (forall (t :: * -> *) a. Foldable t => t a -> Int
length [coll]
ds) (forall sh. C sh => sh -> Int
size size
sz forall a. Num a => a -> a -> a
+ Int
rep)

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

simplexLayoutSize :: Integral i => Int -> i -> i
simplexLayoutSize :: forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
d i
n =
   case forall a. Int -> [a] -> [a]
drop Int
d forall a b. (a -> b) -> a -> b
$ 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 :: forall a. Integral a => a -> [a]
binomials a
n =
   forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\a
acc (a
num,a
den) -> forall a. Integral a => a -> a -> a
div (a
accforall a. Num a => a -> a -> a
*a
num) a
den) a
1
         (forall a b. [a] -> [b] -> [(a, b)]
zip [a
n, forall a. Enum a => a -> a
pred a
n ..] [a
1..a
n])

foldLength :: (Foldable f) => f a -> Int
foldLength :: forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) =
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT (forall sh. Indexed sh => sh -> [Index sh]
indices size
sz) forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse
         (if forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
             then forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexAscending
             else 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 = forall sh. Indexed sh => sh -> Index sh -> Int
offset size
sz in \Index (Simplex order coll f size)
ix ->
      let ixs :: [Index size]
ixs = forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList Index (Simplex order coll f size)
ix in
         forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds size
sz) [Index size]
ixs Bool -> Bool -> Bool
&&
         forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
FunctorC.eq1 (forall (f :: * -> *) a. Functor f => f a -> f ()
void f coll
d) (forall (f :: * -> *) a. Functor f => f a -> f ()
void Index (Simplex order coll f size)
ix) Bool -> Bool -> Bool
&&
         forall coll order.
CollisionC coll =>
SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order (forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d) (forall a b. (a -> b) -> [a] -> [b]
map Index size -> Int
getOffset [Index size]
ixs)
   unifiedSizeOffset :: forall check.
Checking check =>
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) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset size
sz in
      let dInt :: Int
dInt = forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength f coll
d
          prep :: (Int, f (Int, (Int, Int)))
prep = 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
      (forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
dInt (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 <- 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList Index (Simplex order coll f size)
ixf
            forall check. Checking check => String -> Bool -> Result check ()
assert
               String
"Shape.Simplex.offset: simplex and index structure mismatch"
               (forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
FunctorC.eq1 (forall (f :: * -> *) a. Functor f => f a -> f ()
void f coll
d) (forall (f :: * -> *) a. Functor f => f a -> f ()
void Index (Simplex order coll f size)
ixf))
            forall check. Checking check => String -> Bool -> Result check ()
assert
               String
"Shape.Simplex.offset: index elements not monotonic"
               (forall coll order.
CollisionC coll =>
SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order (forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d) [Int]
ks)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
               forall i order.
Integral i =>
SimplexOrder order -> Int -> (i, [(Int, i)]) -> [i] -> i
simplexOffset SimplexOrder order
order Int
dInt
                  (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall i order.
Integral i =>
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 ->
         forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
d i
nsum forall a. Num a => a -> a -> a
- i
1
         forall a. Num a => a -> a -> a
-
         forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i
k (Int
x,i
y) -> forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (i
yforall a. Num a => a -> a -> a
-i
k)) [i]
ks [(Int, i)]
cis)
      SimplexOrder order
Descending ->
         forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i
k (Int
x,i
y) -> forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (i
yforall a. Num a => a -> a -> a
+i
k)) [i]
ks [(Int, i)]
cis)

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

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

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

chooseIndexDescending :: forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexDescending coll
coll =
   forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ \[a]
as -> forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as forall a b. (a -> b) -> a -> b
$
      (if forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
coll then forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail else forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten) forall a b. (a -> b) -> a -> b
$
      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 :: forall check.
Checking check =>
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 = forall sh. C sh => sh -> Int
size size
sh in
      let (Int
nSum,f (Int, (Int, Int))
deco) = 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 = forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength f coll
d in \Int
k ->
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
         (forall check a. Checking check => String -> Result check a
throwOrError forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Simplex" Int
k)
         (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse (forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset size
sh) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
      if forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
         then
            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 forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Ord a => a -> a -> Bool
<Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
                        forall a b. (a -> b) -> [a] -> [b]
map (\Int
bi -> (Int
bi, Int
k0 forall a. Num a => a -> a -> a
- forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (Int
yforall a. Num a => a -> a -> a
-Int
bi))) forall a b. (a -> b) -> a -> b
$
                        forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<Int
n) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Int
1forall a. Num a => a -> a -> a
+) Int
a of
                     [] -> forall a. Maybe a
Nothing
                     (Int
b,Int
k1):[(Int, Int)]
_ -> forall a. a -> Maybe a
Just ((Int
bforall a. Num a => a -> a -> a
+Int
db, Int
k1), Int
b))
               (Int
0, forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
dInt Int
nSum forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
k)
               f (Int, (Int, Int))
deco
         else
            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 forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Ord a => a -> a -> Bool
<Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
                        forall a b. (a -> b) -> [a] -> [b]
map (\Int
bi -> (Int
bi, Int
k0 forall a. Num a => a -> a -> a
- forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (Int
yforall a. Num a => a -> a -> a
+Int
bi))) forall a b. (a -> b) -> a -> b
$
                        forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
>=Int
0) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
subtract Int
1) Int
a of
                     [] -> forall a. Maybe a
Nothing
                     (Int
b,Int
k1):[(Int, Int)]
_ -> forall a. a -> Maybe a
Just ((Int
bforall 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 :: forall (t :: * -> *) (m :: * -> *) a b c.
(Traversable t, Monad m) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM a -> b -> m (a, c)
f a
a0 t b
xs =
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
   forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT
      (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Trav.mapM (\b
b -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ \a
a -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (a, b) -> (b, a)
swap 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 :: 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 t coll
d Int
n =
   if forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
      then forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int
1forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) i coll.
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d (Int
nforall a. Num a => a -> a -> a
-Int
1)
      else forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int
nforall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ 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 :: forall (t :: * -> *) i coll.
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d Int
n =
   let ((Bool
_,(i
_,Int
nSum)), t (Int, (i, Int))
deco) =
         forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
Trav.mapAccumR
            (\(Bool
c0,(i
x,Int
y)) Bool
ci ->
               let c1 :: Int
c1 = forall a. Enum a => a -> Int
fromEnum (Bool
ciBool -> Bool -> Bool
&&Bool
c0)
                   p :: (i, Int)
p = (i
xforall a. Num a => a -> a -> a
+i
1,Int
yforall a. Num a => a -> a -> a
+Int
c1)
               in ((Bool
True,(i, Int)
p),(Int
1forall a. Num a => a -> a -> a
-Int
c1,(i, Int)
p)))
            (Bool
False,(i
0,Int
n))
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 {forall n. Cyclic n -> n
cyclicSize :: n}
   deriving (Cyclic n -> Cyclic n -> Bool
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
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 :: forall a b. (a -> b) -> Cyclic a -> Cyclic b
fmap a -> b
f (Cyclic a
n) = forall n. n -> Cyclic n
Cyclic forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

instance Applicative Cyclic where
   pure :: forall n. n -> Cyclic n
pure = forall n. n -> Cyclic n
Cyclic
   Cyclic a -> b
f <*> :: forall a b. Cyclic (a -> b) -> Cyclic a -> Cyclic b
<*> Cyclic a
n = forall n. n -> Cyclic n
Cyclic 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) = forall a. NFData a => a -> ()
rnf n
n

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

instance (Integral n) => C (Cyclic n) where
   size :: Cyclic n -> Int
size (Cyclic n
len) = 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) = forall sh. Indexed sh => sh -> [Index sh]
indices forall a b. (a -> b) -> a -> b
$ forall n. n -> ZeroBased n
ZeroBased n
len
   unifiedOffset :: forall check.
Checking check =>
Cyclic n -> Index (Cyclic n) -> Result check Int
unifiedOffset (Cyclic n
len) Index (Cyclic n)
ix = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
mod Index (Cyclic n)
ix n
len
   inBounds :: Cyclic n -> Index (Cyclic n) -> Bool
inBounds (Cyclic n
len) Index (Cyclic n)
_ix = n
lenforall a. Ord a => a -> a -> Bool
>n
0

instance (Integral n) => InvIndexed (Cyclic n) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Cyclic n -> Int -> Result check (Index (Cyclic n))
unifiedIndexFromOffset (Cyclic n
len) Int
k0 = do
      let k :: n
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Cyclic" Int
k0 forall a b. (a -> b) -> a -> b
$ n
0forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kforall a. Ord a => a -> a -> Bool
<n
len
      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
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
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) = 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) = forall sh. C sh => sh -> Int
size sh0
sh0 forall a. Num a => a -> a -> a
+ 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) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left (forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right (forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1)
   unifiedOffset :: forall check.
Checking check =>
(sh0 ::+ sh1) -> Index (sh0 ::+ sh1) -> Result check Int
unifiedOffset (sh0
sh0::+sh1
sh1) =
      let (Int
n0,Index sh0 -> Result check Int
getOffset0) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0
          getOffset1 :: Index sh1 -> Result check Int
getOffset1 = 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 Index sh0
ix0 -> Index sh0 -> Result check Int
getOffset0 Index sh0
ix0
            Right Index sh1
ix1 -> (Int
n0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index sh1 -> Result check Int
getOffset1 Index sh1
ix1
   unifiedSizeOffset :: forall check.
Checking check =>
(sh0 ::+ sh1) -> (Int, Index (sh0 ::+ sh1) -> Result check Int)
unifiedSizeOffset (sh0
sh0::+sh1
sh1) =
      let (Int
n0, Index sh0 -> Result check Int
getOffset0) = 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) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1
      in (Int
n0forall a. Num a => a -> a -> a
+Int
n1, forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Index sh0 -> Result check Int
getOffset0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
n0forall a. Num a => a -> a -> a
+) 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) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0) (forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1)

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

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

instance (Pattern sh0, Pattern sh1) => Pattern (sh0::+sh1) where
   type DataPattern (sh0::+sh1) x = DataPattern sh0 x ::+ DataPattern sh1 x
   indexPattern :: forall x.
(Index (sh0 ::+ sh1) -> x)
-> (sh0 ::+ sh1) -> DataPattern (sh0 ::+ sh1) x
indexPattern Index (sh0 ::+ sh1) -> x
extend (sh0
sh0::+sh1
sh1) =
      forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (Index (sh0 ::+ sh1) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) sh0
sh0 forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (Index (sh0 ::+ sh1) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) sh1
sh1


infixl 7 |*
infixl 6 |+|

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

(|+|) :: (Applicative f, Num a) => f a -> f a -> f a
|+| :: forall (f :: * -> *) a. (Applicative f, Num a) => f a -> f a -> f a
(|+|) = forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 forall a. Num a => a -> a -> a
(+)



{- |
Shape for arrays that hold elements
that can alternatively be stored in nested tuples.
-}
newtype NestedTuple ixtype tuple = NestedTuple {forall ixtype tuple. NestedTuple ixtype tuple -> tuple
getNestedTuple :: tuple}
   deriving (NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ixtype tuple.
Eq tuple =>
NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
/= :: NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
$c/= :: forall ixtype tuple.
Eq tuple =>
NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
== :: NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
$c== :: forall ixtype tuple.
Eq tuple =>
NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
Eq, Int -> NestedTuple ixtype tuple -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall ixtype tuple.
Show tuple =>
Int -> NestedTuple ixtype tuple -> String -> String
forall ixtype tuple.
Show tuple =>
[NestedTuple ixtype tuple] -> String -> String
forall ixtype tuple.
Show tuple =>
NestedTuple ixtype tuple -> String
showList :: [NestedTuple ixtype tuple] -> String -> String
$cshowList :: forall ixtype tuple.
Show tuple =>
[NestedTuple ixtype tuple] -> String -> String
show :: NestedTuple ixtype tuple -> String
$cshow :: forall ixtype tuple.
Show tuple =>
NestedTuple ixtype tuple -> String
showsPrec :: Int -> NestedTuple ixtype tuple -> String -> String
$cshowsPrec :: forall ixtype tuple.
Show tuple =>
Int -> NestedTuple ixtype tuple -> String -> String
Show)

data TupleAccessor
data TupleIndex

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

instance NFData Element where
   rnf :: Element -> ()
rnf (Element Int
k) = forall a. NFData a => a -> ()
rnf Int
k


class ElementTuple tuple where
   type DataTuple tuple x
   indexTupleA ::
      (Applicative f) => (Element -> f a) -> tuple -> f (DataTuple tuple a)

tupleSize :: (ElementTuple tuple) => tuple -> Int
tupleSize :: forall tuple. ElementTuple tuple => tuple -> Int
tupleSize =
   forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> w
MW.execWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA (\Element
x -> forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
MW.tell (forall a. a -> Sum a
Sum Int
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Element
x)

indexTuple ::
   (ElementTuple tuple) => (Element -> a) -> tuple -> DataTuple tuple a
indexTuple :: forall tuple a.
ElementTuple tuple =>
(Element -> a) -> tuple -> DataTuple tuple a
indexTuple Element -> a
extend = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> a
extend)

{- |
>>> rnf (Shape.NestedTuple (Shape.Element 1, Shape.Element 2))
()
>>> rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element 3)))
()
>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, Shape.Element 2))
True
>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, (Shape.Element 2, Shape.Element 3)))
True
>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element undefined, Shape.Element 3)))
True
>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element undefined)))
True
-}
instance (ElementTuple tuple) => NFData (NestedTuple ixtype tuple) where
   rnf :: NestedTuple ixtype tuple -> ()
rnf (NestedTuple tuple
tuple) =
      forall a. StrictUnitWriter a -> ()
execStrictUnitWriter forall a b. (a -> b) -> a -> b
$ forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA ((forall a. a -> StrictUnitWriter a
StrictUnitWriterforall a b. (a -> b) -> a -> b
$!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> ()
rnf) tuple
tuple

data StrictUnitWriter a = StrictUnitWriter a

execStrictUnitWriter :: StrictUnitWriter a -> ()
execStrictUnitWriter :: forall a. StrictUnitWriter a -> ()
execStrictUnitWriter (StrictUnitWriter a
_) = ()

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

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

instance Monad StrictUnitWriter where
   return :: forall a. a -> StrictUnitWriter a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
   StrictUnitWriter a
a >>= :: forall a b.
StrictUnitWriter a
-> (a -> StrictUnitWriter b) -> StrictUnitWriter b
>>= a -> StrictUnitWriter b
k = a -> StrictUnitWriter b
k a
a



class (ElementTuple tuple) => AccessorTuple tuple where
   tupleAccessors :: tuple -> [tuple -> Element]

class (ElementTuple tuple, Eq tuple) => StaticTuple tuple where
   staticTuple :: MS.State Element tuple


instance ElementTuple () where
   type DataTuple () x = ()
   indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> () -> f (DataTuple () a)
indexTupleA Element -> f a
_ () = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance AccessorTuple () where
   tupleAccessors :: () -> [() -> Element]
tupleAccessors () = []

instance StaticTuple () where
   staticTuple :: State Element ()
staticTuple = forall (m :: * -> *) a. Monad m => a -> m a
return ()


instance ElementTuple Element where
   type DataTuple Element x = x
   indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> Element -> f (DataTuple Element a)
indexTupleA Element -> f a
extend = Element -> f a
extend

instance AccessorTuple Element where
   tupleAccessors :: Element -> [Element -> Element]
tupleAccessors Element
_ = [forall a. a -> a
id]

instance StaticTuple Element where
   staticTuple :: State Element Element
staticTuple = do
      Element
ix <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
      forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (\(Element Int
k) -> Int -> Element
Element (Int
kforall a. Num a => a -> a -> a
+Int
1))
      forall (m :: * -> *) a. Monad m => a -> m a
return Element
ix


instance (ElementTuple a, ElementTuple b) => ElementTuple (a,b) where
   type DataTuple (a,b) x = (DataTuple a x, DataTuple b x)
   indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> (a, b) -> f (DataTuple (a, b) a)
indexTupleA Element -> f a
extend (a
a,b
b) =
      forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend b
b)

instance (AccessorTuple a, AccessorTuple b) => AccessorTuple (a,b) where
   tupleAccessors :: (a, b) -> [(a, b) -> Element]
tupleAccessors (a
a,b
b) =
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b)

instance (StaticTuple a, StaticTuple b) => StaticTuple (a,b) where
   staticTuple :: State Element (a, b)
staticTuple = forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple


instance
   (ElementTuple a, ElementTuple b, ElementTuple c) =>
      ElementTuple (a,b,c) where
   type DataTuple (a,b,c) x = (DataTuple a x, DataTuple b x, DataTuple c x)
   indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> (a, b, c) -> f (DataTuple (a, b, c) a)
indexTupleA Element -> f a
extend (a
a,b
b,c
c) =
      forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,)
         (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend b
b) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend c
c)

instance
   (AccessorTuple a, AccessorTuple b, AccessorTuple c) =>
      AccessorTuple (a,b,c) where
   tupleAccessors :: (a, b, c) -> [(a, b, c) -> Element]
tupleAccessors (a
a,b
b,c
c) =
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> a
fst3) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> b
snd3) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b) forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> c
thd3) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors c
c)

instance
   (StaticTuple a, StaticTuple b, StaticTuple c) =>
      StaticTuple (a,b,c) where
   staticTuple :: State Element (a, b, c)
staticTuple = forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple


instance
   (ElementTuple a, ElementTuple b, ElementTuple c, ElementTuple d) =>
      ElementTuple (a,b,c,d) where
   type DataTuple (a,b,c,d) x =
         (DataTuple a x, DataTuple b x, DataTuple c x, DataTuple d x)
   indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> (a, b, c, d) -> f (DataTuple (a, b, c, d) a)
indexTupleA Element -> f a
extend (a
a,b
b,c
c,d
d) =
      forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 (,,,)
         (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend b
b)
         (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend c
c) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend d
d)

instance
   (AccessorTuple a, AccessorTuple b, AccessorTuple c, AccessorTuple d) =>
      AccessorTuple (a,b,c,d) where
   tupleAccessors :: (a, b, c, d) -> [(a, b, c, d) -> Element]
tupleAccessors (a
a,b
b,c
c,d
d) =
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
i,b
_,c
_,d
_) -> a
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
i,c
_,d
_) -> b
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b) forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
_,c
i,d
_) -> c
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors c
c) forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
_,c
_,d
i) -> d
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors d
d)

instance
   (StaticTuple a, StaticTuple b, StaticTuple c, StaticTuple d) =>
      StaticTuple (a,b,c,d) where
   staticTuple :: State Element (a, b, c, d)
staticTuple = forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 (,,,) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple


instance (ElementTuple a) => ElementTuple (Complex a) where
   type DataTuple (Complex a) x = Complex (DataTuple a x)
   indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> Complex a -> f (DataTuple (Complex a) a)
indexTupleA Element -> f a
extend (a
a:+a
b) =
      forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 forall a. a -> a -> Complex a
(:+) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
b)

instance (AccessorTuple a) => AccessorTuple (Complex a) where
   tupleAccessors :: Complex a -> [Complex a -> Element]
tupleAccessors (a
a:+a
b) =
      forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Complex a -> a
realPart) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Complex a -> a
imagPart) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
b)

instance (StaticTuple a) => StaticTuple (Complex a) where
   staticTuple :: State Element (Complex a)
staticTuple = forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 forall a. a -> a -> Complex a
(:+) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple


instance (ElementTuple tuple) => C (NestedTuple ixtype tuple) where
   size :: NestedTuple ixtype tuple -> Int
size (NestedTuple tuple
tuple) = forall tuple. ElementTuple tuple => tuple -> Int
tupleSize tuple
tuple

instance (StaticTuple tuple) => Static (NestedTuple ixtype tuple) where
   static :: NestedTuple ixtype tuple
static = forall ixtype tuple. tuple -> NestedTuple ixtype tuple
NestedTuple forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> a
MS.evalState forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall a b. (a -> b) -> a -> b
$ Int -> Element
Element Int
0

-- requires FlexibleInstances
instance (AccessorTuple tuple) => Indexed (NestedTuple TupleAccessor tuple) where
   type Index (NestedTuple TupleAccessor tuple) = tuple -> Element
   indices :: NestedTuple TupleAccessor tuple
-> [Index (NestedTuple TupleAccessor tuple)]
indices (NestedTuple tuple
tuple) = forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors tuple
tuple
   unifiedOffset :: forall check.
Checking check =>
NestedTuple TupleAccessor tuple
-> Index (NestedTuple TupleAccessor tuple) -> Result check Int
unifiedOffset (NestedTuple tuple
tuple) Index (NestedTuple TupleAccessor tuple)
ix =
      case Index (NestedTuple TupleAccessor tuple)
ix tuple
tuple of Element Int
k -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
k



newtype ElementIndex tuple = ElementIndex Int
   deriving (ElementIndex tuple -> ElementIndex tuple -> Bool
forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c/= :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
== :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c== :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
Eq, ElementIndex tuple -> ElementIndex tuple -> Bool
ElementIndex tuple -> ElementIndex tuple -> Ordering
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
forall tuple. Eq (ElementIndex tuple)
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 tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
forall tuple. ElementIndex tuple -> ElementIndex tuple -> Ordering
forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
min :: ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
$cmin :: forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
max :: ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
$cmax :: forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
>= :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c>= :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
> :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c> :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
<= :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c<= :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
< :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c< :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
compare :: ElementIndex tuple -> ElementIndex tuple -> Ordering
$ccompare :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Ordering
Ord, Int -> ElementIndex tuple -> String -> String
forall tuple. Int -> ElementIndex tuple -> String -> String
forall tuple. [ElementIndex tuple] -> String -> String
forall tuple. ElementIndex tuple -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ElementIndex tuple] -> String -> String
$cshowList :: forall tuple. [ElementIndex tuple] -> String -> String
show :: ElementIndex tuple -> String
$cshow :: forall tuple. ElementIndex tuple -> String
showsPrec :: Int -> ElementIndex tuple -> String -> String
$cshowsPrec :: forall tuple. Int -> ElementIndex tuple -> String -> String
Show)

instance (ElementTuple tuple) => Indexed (NestedTuple TupleIndex tuple) where
   type Index (NestedTuple TupleIndex tuple) = ElementIndex tuple
   indices :: NestedTuple TupleIndex tuple
-> [Index (NestedTuple TupleIndex tuple)]
indices (NestedTuple tuple
tuple) =
      forall a b. (a -> b) -> [a] -> [b]
map forall tuple. Int -> ElementIndex tuple
ElementIndex forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall tuple. ElementTuple tuple => tuple -> Int
tupleSize tuple
tuple) [Int
0..]
   unifiedOffset :: forall check.
Checking check =>
NestedTuple TupleIndex tuple
-> Index (NestedTuple TupleIndex tuple) -> Result check Int
unifiedOffset (NestedTuple tuple
_tuple) (ElementIndex Int
k) = forall (m :: * -> *) a. Monad m => a -> m a
return Int
k

instance (ElementTuple tuple) => Pattern (NestedTuple TupleIndex tuple) where
   type DataPattern (NestedTuple TupleIndex tuple) x = DataTuple tuple x
   indexPattern :: forall x.
(Index (NestedTuple TupleIndex tuple) -> x)
-> NestedTuple TupleIndex tuple
-> DataPattern (NestedTuple TupleIndex tuple) x
indexPattern Index (NestedTuple TupleIndex tuple) -> x
extend (NestedTuple tuple
tuple) =
      let elemIx :: tuple -> Element -> ElementIndex tuple
          elemIx :: forall tuple. tuple -> Element -> ElementIndex tuple
elemIx tuple
_ (Element Int
k) = forall tuple. Int -> ElementIndex tuple
ElementIndex Int
k
      in forall tuple a.
ElementTuple tuple =>
(Element -> a) -> tuple -> DataTuple tuple a
indexTuple (Index (NestedTuple TupleIndex tuple) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tuple. tuple -> Element -> ElementIndex tuple
elemIx tuple
tuple) tuple
tuple

indexTupleFromShape ::
   (ElementTuple tuple) =>
   NestedTuple TupleIndex tuple -> DataTuple tuple (ElementIndex tuple)
indexTupleFromShape :: forall tuple.
ElementTuple tuple =>
NestedTuple TupleIndex tuple
-> DataTuple tuple (ElementIndex tuple)
indexTupleFromShape = forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern forall a. a -> a
id




nextCounter :: MS.State Int Int
nextCounter :: StateT Int Identity Int
nextCounter = do Int
k <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get; forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put (Int
kforall a. Num a => a -> a -> a
+Int
1); forall (m :: * -> *) a. Monad m => a -> m a
return Int
k

{- |
Shape for arrays that hold elements
that can alternatively be stored in a 'Traversable' record.
-}
newtype Record f = Record {forall (f :: * -> *). Record f -> f Element
getRecord :: f Element}

instance (Foldable f) => Eq (Record f) where
   Record f Element
sh0 == :: Record f -> Record f -> Bool
== Record f Element
sh1  =  forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f Element
sh0 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f Element
sh1
{-
instance (Eq (f Element)) => Eq (Record f) where
   Record sh0 == Record sh1  =  sh0 == sh1
-}

newtype FieldIndex (f :: * -> *) = FieldIndex Int
   deriving (FieldIndex f -> FieldIndex f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *). FieldIndex f -> FieldIndex f -> Bool
/= :: FieldIndex f -> FieldIndex f -> Bool
$c/= :: forall (f :: * -> *). FieldIndex f -> FieldIndex f -> Bool
== :: FieldIndex f -> FieldIndex f -> Bool
$c== :: forall (f :: * -> *). FieldIndex f -> FieldIndex f -> Bool
Eq, Int -> FieldIndex f -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (f :: * -> *). Int -> FieldIndex f -> String -> String
forall (f :: * -> *). [FieldIndex f] -> String -> String
forall (f :: * -> *). FieldIndex f -> String
showList :: [FieldIndex f] -> String -> String
$cshowList :: forall (f :: * -> *). [FieldIndex f] -> String -> String
show :: FieldIndex f -> String
$cshow :: forall (f :: * -> *). FieldIndex f -> String
showsPrec :: Int -> FieldIndex f -> String -> String
$cshowsPrec :: forall (f :: * -> *). Int -> FieldIndex f -> String -> String
Show)

instance (Foldable f) => C (Record f) where
   size :: Record f -> Int
size = forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Record f -> f Element
getRecord

instance (Applicative f, Traversable f) => Static (Record f) where
   static :: Record f
static =
      forall (f :: * -> *). f Element -> Record f
Record forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
MS.evalState Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Trav.sequence forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Element
Element StateT Int Identity Int
nextCounter)

instance (Foldable f) => Indexed (Record f) where
   type Index (Record f) = FieldIndex f
   indices :: Record f -> [Index (Record f)]
indices (Record f Element
xs) = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). Int -> FieldIndex f
FieldIndex forall a b. (a -> b) -> a -> b
$ forall b a. [b] -> [a] -> [a]
Match.take (forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f Element
xs) [Int
0..]
   unifiedOffset :: forall check.
Checking check =>
Record f -> Index (Record f) -> Result check Int
unifiedOffset (Record f Element
_xs) (FieldIndex Int
k) = forall (m :: * -> *) a. Monad m => a -> m a
return Int
k

indexRecordFromShape ::
   (Traversable f) =>
   Record f -> f (FieldIndex f)
indexRecordFromShape :: forall (f :: * -> *). Traversable f => Record f -> f (FieldIndex f)
indexRecordFromShape (Record f Element
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Element Int
k) -> forall (f :: * -> *). Int -> FieldIndex f
FieldIndex Int
k) f Element
xs



newtype Constructed tag = Constructed {forall tag. Constructed tag -> Int
constructedSize :: Int}
   deriving (Constructed tag -> Constructed tag -> Bool
forall tag. Constructed tag -> Constructed tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructed tag -> Constructed tag -> Bool
$c/= :: forall tag. Constructed tag -> Constructed tag -> Bool
== :: Constructed tag -> Constructed tag -> Bool
$c== :: forall tag. Constructed tag -> Constructed tag -> Bool
Eq, Int -> Constructed tag -> String -> String
forall tag. Int -> Constructed tag -> String -> String
forall tag. [Constructed tag] -> String -> String
forall tag. Constructed tag -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Constructed tag] -> String -> String
$cshowList :: forall tag. [Constructed tag] -> String -> String
show :: Constructed tag -> String
$cshow :: forall tag. Constructed tag -> String
showsPrec :: Int -> Constructed tag -> String -> String
$cshowsPrec :: forall tag. Int -> Constructed tag -> String -> String
Show)

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

newtype Construction tag a = Construction (MS.State Int a)

instance Functor (Construction tag) where
   fmap :: forall a b. (a -> b) -> Construction tag a -> Construction tag b
fmap a -> b
f (Construction State Int a
m) = forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f State Int a
m

instance Applicative (Construction tag) where
   pure :: forall a. a -> Construction tag a
pure = forall tag a. State Int a -> Construction tag a
Construction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Construction State Int (a -> b)
f  <*> :: forall a b.
Construction tag (a -> b)
-> Construction tag a -> Construction tag b
<*>  Construction State Int a
a = forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ State Int (a -> b)
fforall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>State Int a
a

instance Monad (Construction tag) where
   return :: forall a. a -> Construction tag a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Construction State Int a
am  >>= :: forall a b.
Construction tag a
-> (a -> Construction tag b) -> Construction tag b
>>=  a -> Construction tag b
k  =
      forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ State Int a
am forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> case a -> Construction tag b
k a
a of Construction StateT Int Identity b
bm -> StateT Int Identity b
bm

construct :: Construction tag a -> (Constructed tag, a)
construct :: forall tag a. Construction tag a -> (Constructed tag, a)
construct (Construction State Int a
m) =
   case forall s a. State s a -> s -> (a, s)
MS.runState State Int a
m Int
0 of (a
a, Int
sz) -> (forall tag. Int -> Constructed tag
Constructed Int
sz, a
a)

consIndex :: Construction tag (ConsIndex tag)
consIndex :: forall tag. Construction tag (ConsIndex tag)
consIndex = forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall tag. Int -> ConsIndex tag
ConsIndex StateT Int Identity Int
nextCounter


instance C (Constructed tag) where
   size :: Constructed tag -> Int
size = forall tag. Constructed tag -> Int
constructedSize

instance Indexed (Constructed tag) where
   type Index (Constructed tag) = ConsIndex tag
   indices :: Constructed tag -> [Index (Constructed tag)]
indices (Constructed Int
len) = forall a b. (a -> b) -> [a] -> [b]
map forall tag. Int -> ConsIndex tag
ConsIndex forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
len [Int
0..]
   unifiedOffset :: forall check.
Checking check =>
Constructed tag -> Index (Constructed tag) -> Result check Int
unifiedOffset (Constructed Int
len) =
      let f :: Index (ZeroBased Int) -> Result check Int
f = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset (forall n. n -> ZeroBased n
ZeroBased Int
len) in \(ConsIndex Int
k) -> Index (ZeroBased Int) -> Result check Int
f Int
k
   inBounds :: Constructed tag -> Index (Constructed tag) -> Bool
inBounds (Constructed Int
len) (ConsIndex Int
ix) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (forall n. n -> ZeroBased n
ZeroBased Int
len) Int
ix

instance InvIndexed (Constructed tag) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Constructed tag -> Int -> Result check (Index (Constructed tag))
unifiedIndexFromOffset (Constructed Int
len) =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall tag. Int -> ConsIndex tag
ConsIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (forall n. n -> ZeroBased n
ZeroBased Int
len)