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

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

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

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

   (::+)(..),

   Square(..), cartesianFromSquare,
   Cube(..), cartesianFromCube,

   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.IntMap as IntMap
import qualified Data.IntSet as IntSet
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.IntMap (IntMap)
import Data.IntSet (IntSet)
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.IntMap as IntMap
>>> import qualified Data.IntSet as IntSet
>>> 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 = CheckSingleton Checked
-> CheckSingleton Unchecked -> CheckSingleton check
forall check (f :: * -> *).
Checking check =>
f Checked -> f Unchecked -> f check
forall (f :: * -> *). 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
_ = CheckSingleton check
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 CheckSingleton check
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
_ = Result check a -> Result check a
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) =
   (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (String -> String) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
"Shape." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ") String -> String -> String
forall a. [a] -> [a] -> [a]
++)) a -> a
forall a. a -> a
id Either String a
m

instance Checking Unchecked where
   newtype Result Unchecked a = UncheckedResult {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 = Result Unchecked a -> a
forall a. Result Unchecked a -> a
getUnchecked


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

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

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


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

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

instance (Checking check) => Monad (Result check) where
   return :: forall a. a -> Result check a
return = a -> Result check a
forall a. a -> Result check a
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 (Result check a -> CheckSingleton check
forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a, Result check a
a) of
         (CheckSingleton check
Checked, CheckedResult Either String a
e) -> Either String b -> Result Checked b
forall a. Either String a -> Result Checked a
CheckedResult (Either String b -> Result Checked b)
-> Either String b -> Result Checked b
forall a b. (a -> b) -> a -> b
$ Result Checked b -> Either String b
forall a. Result Checked a -> Either String a
getChecked (Result Checked b -> Either String b)
-> (a -> Result Checked b) -> a -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result check b
a -> Result Checked b
b (a -> Either String b) -> Either String a -> Either String b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String a
e
         (CheckSingleton check
Unchecked, UncheckedResult a
x) -> a -> Result check b
b a
x


{- |
Shape types, that is, instances of 'C', that are also instance of 'Eq',
must have proper 'Eq' instances,
otherwise evil memory corruption will occur.
At least, it must hold @sh0 == sh1  ==>  Shape.size sh0 == Shape.size sh1@.
-}
class C sh where
   {-
   This is the counterpart to 'Ix.rangeSize'.
   We do not support a counterpart to 'Ix.unsafeRangeSize' anymore.
   First, there is hardly any speed advantage
   of using 'Ix.unsafeRangeSize' instead of 'Ix.rangeSize'.
   Second, I do not know of an 'Ix' instance
   where 'Ix.rangeSize' and 'Ix.unsafeRangeSize' differ.
   -}
   size :: sh -> Int

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

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

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

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

{-
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



{- |
We cannot use 'Semigroup'
because 'Semigroup' instances for '()' and '(a,b)' are already defined in a way,
that is incompatible for our needs.
-}
class (C sh) => AppendSemigroup sh where
   append :: sh -> sh -> sh

class (AppendSemigroup sh) => AppendMonoid sh where
   empty :: sh


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

instance AppendMonoid Zero where
   empty :: Zero
empty = Zero
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 () () = Int -> Result check Int
forall a. a -> Result check a
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 = String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"()" Int
k (Int
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)

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

instance Pattern () where
   type DataPattern () x = x
   indexPattern :: forall x. (Index () -> x) -> () -> DataPattern () x
indexPattern Index () -> x
extend = () -> DataPattern () x
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
(ZeroBased n -> ZeroBased n -> Bool)
-> (ZeroBased n -> ZeroBased n -> Bool) -> Eq (ZeroBased n)
forall n. Eq n => ZeroBased n -> ZeroBased n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: ZeroBased n -> ZeroBased n -> Bool
Eq, Int -> ZeroBased n -> String -> String
[ZeroBased n] -> String -> String
ZeroBased n -> String
(Int -> ZeroBased n -> String -> String)
-> (ZeroBased n -> String)
-> ([ZeroBased n] -> String -> String)
-> Show (ZeroBased n)
forall n. Show n => Int -> ZeroBased n -> String -> String
forall n. Show n => [ZeroBased n] -> String -> String
forall n. Show n => ZeroBased n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall n. Show n => Int -> ZeroBased n -> String -> String
showsPrec :: Int -> ZeroBased n -> String -> String
$cshow :: forall n. Show n => ZeroBased n -> String
show :: ZeroBased n -> String
$cshowList :: forall n. Show n => [ZeroBased n] -> String -> String
showList :: [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) = b -> ZeroBased b
forall n. n -> ZeroBased n
ZeroBased (b -> ZeroBased b) -> b -> ZeroBased b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

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

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

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

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

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

instance (Integral n) => InvIndexed (ZeroBased n) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
ZeroBased n -> Int -> Result check (Index (ZeroBased n))
unifiedIndexFromOffset (ZeroBased n
len) Int
k0 = do
      let k :: n
k = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
      String -> Int -> Bool -> Result check ()
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"ZeroBased" Int
k0 (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ n
0n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
len
      n -> Result check n
forall a. a -> Result check a
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
nn -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
0
      then String -> ZeroBased n ::+ ZeroBased n
forall a. HasCallStack => String -> a
error String
"Shape.zeroBasedSplit: negative number of elements"
      else let k :: n
k = n -> n -> n
forall a. Ord a => a -> a -> a
min n
n n
m in n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased n
k ZeroBased n -> ZeroBased n -> ZeroBased n ::+ ZeroBased n
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased (n
mn -> n -> n
forall a. Num a => a -> a -> a
-n
k)

instance (Integral n) => AppendSemigroup (ZeroBased n) where
   append :: ZeroBased n -> ZeroBased n -> ZeroBased n
append (ZeroBased n
n) (ZeroBased n
m) = n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased (n
nn -> n -> n
forall a. Num a => a -> a -> a
+n
m)

instance (Integral n) => AppendMonoid (ZeroBased n) where
   empty :: ZeroBased n
empty = n -> ZeroBased n
forall n. n -> ZeroBased n
ZeroBased n
0


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) = DataPattern (ZeroBased n) x
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
(OneBased n -> OneBased n -> Bool)
-> (OneBased n -> OneBased n -> Bool) -> Eq (OneBased n)
forall n. Eq n => OneBased n -> OneBased n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: OneBased n -> OneBased n -> Bool
Eq, Int -> OneBased n -> String -> String
[OneBased n] -> String -> String
OneBased n -> String
(Int -> OneBased n -> String -> String)
-> (OneBased n -> String)
-> ([OneBased n] -> String -> String)
-> Show (OneBased n)
forall n. Show n => Int -> OneBased n -> String -> String
forall n. Show n => [OneBased n] -> String -> String
forall n. Show n => OneBased n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall n. Show n => Int -> OneBased n -> String -> String
showsPrec :: Int -> OneBased n -> String -> String
$cshow :: forall n. Show n => OneBased n -> String
show :: OneBased n -> String
$cshowList :: forall n. Show n => [OneBased n] -> String -> String
showList :: [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) = b -> OneBased b
forall n. n -> OneBased n
OneBased (b -> OneBased b) -> b -> OneBased b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
n

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

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

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

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

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

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

instance (Integral n) => AppendSemigroup (OneBased n) where
   append :: OneBased n -> OneBased n -> OneBased n
append (OneBased n
n) (OneBased n
m) = n -> OneBased n
forall n. n -> OneBased n
OneBased (n
nn -> n -> n
forall a. Num a => a -> a -> a
+n
m)

instance (Integral n) => AppendMonoid (OneBased n) where
   empty :: OneBased n
empty = n -> OneBased n
forall n. n -> OneBased n
OneBased n
0


{- |
'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
(Range n -> Range n -> Bool)
-> (Range n -> Range n -> Bool) -> Eq (Range n)
forall n. Eq n => Range n -> Range n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Range n -> Range n -> Bool
Eq, Int -> Range n -> String -> String
[Range n] -> String -> String
Range n -> String
(Int -> Range n -> String -> String)
-> (Range n -> String)
-> ([Range n] -> String -> String)
-> Show (Range n)
forall n. Show n => Int -> Range n -> String -> String
forall n. Show n => [Range n] -> String -> String
forall n. Show n => Range n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall n. Show n => Int -> Range n -> String -> String
showsPrec :: Int -> Range n -> String -> String
$cshow :: forall n. Show n => Range n -> String
show :: Range n -> String
$cshowList :: forall n. Show n => [Range n] -> String -> String
showList :: [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) = b -> b -> Range b
forall n. n -> n -> Range n
Range (a -> b
f a
from) (a -> b
f a
to)

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

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

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

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

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


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

>>> Shape.indices (Shape.Shifted (-4) (8::Int))
[-4,-3,-2,-1,0,1,2,3]
-}
data Shifted n = Shifted {forall n. Shifted n -> n
shiftedOffset, forall n. Shifted n -> n
shiftedSize :: n}
   deriving (Shifted n -> Shifted n -> Bool
(Shifted n -> Shifted n -> Bool)
-> (Shifted n -> Shifted n -> Bool) -> Eq (Shifted n)
forall n. Eq n => Shifted n -> Shifted n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Shifted n -> Shifted n -> Bool
Eq, Int -> Shifted n -> String -> String
[Shifted n] -> String -> String
Shifted n -> String
(Int -> Shifted n -> String -> String)
-> (Shifted n -> String)
-> ([Shifted n] -> String -> String)
-> Show (Shifted n)
forall n. Show n => Int -> Shifted n -> String -> String
forall n. Show n => [Shifted n] -> String -> String
forall n. Show n => Shifted n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall n. Show n => Int -> Shifted n -> String -> String
showsPrec :: Int -> Shifted n -> String -> String
$cshow :: forall n. Show n => Shifted n -> String
show :: Shifted n -> String
$cshowList :: forall n. Show n => [Shifted n] -> String -> String
showList :: [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) = b -> b -> Shifted b
forall n. n -> n -> Shifted n
Shifted (a -> b
f a
from) (a -> b
f a
to)

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

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

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

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

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


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



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

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

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

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

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

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

asEnumType :: Enumeration n -> n -> n
asEnumType :: forall n. Enumeration n -> n -> n
asEnumType Enumeration n
Enumeration = n -> n
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 = n -> Int
forall a. Enum a => a -> Int
fromEnum

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

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


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

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

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

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



instance C IntSet where
   size :: IntSet -> Int
size = IntSet -> Int
IntSet.size

{- |
>>> Shape.indices (IntSet.fromList [3,1,4,1,5,9,2,6,5,3])
[1,2,3,4,5,6,9]
-}
instance Indexed IntSet where
   type Index IntSet = Int
   indices :: IntSet -> [Index IntSet]
indices = IntSet -> [Int]
IntSet -> [Index IntSet]
IntSet.toAscList
   unifiedOffset :: forall check.
Checking check =>
IntSet -> Index IntSet -> Result check Int
unifiedOffset IntSet
set Index IntSet
ix =
      case Int -> IntSet -> (IntSet, Bool, IntSet)
IntSet.splitMember Int
Index IntSet
ix IntSet
set of
         (IntSet
less, Bool
hit, IntSet
_) -> do
            String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.IntSet: array index not member of the index set" Bool
hit
            Int -> Result check Int
forall a. a -> Result check a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ IntSet -> Int
IntSet.size IntSet
less
   inBounds :: IntSet -> Index IntSet -> Bool
inBounds = (Int -> IntSet -> Bool) -> IntSet -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntSet -> Bool
IntSet.member

instance InvIndexed IntSet where
   unifiedIndexFromOffset :: forall check.
Checking check =>
IntSet -> Int -> Result check (Index IntSet)
unifiedIndexFromOffset IntSet
sh =
      let m :: IntMap Int
m = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Index IntSet]
forall sh. Indexed sh => sh -> [Index sh]
indices IntSet
sh
      in \Int
k ->
         case Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap Int
m of
            Maybe Int
Nothing -> String -> Result check Int
forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.IntSet.offset: unknown key"
            Just Int
ix -> Int -> Result check Int
forall a. a -> Result check a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
ix



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

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

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

   unifiedSizeOffset :: forall check.
Checking check =>
Map k shape -> (Int, Index (Map k shape) -> Result check Int)
unifiedSizeOffset = Map k (Int, Index shape -> Result check Int)
-> (Int, (k, Index shape) -> Result check Int)
forall check k i ix.
(Checking check, Ord k, Num i) =>
Map k (i, ix -> Result check i) -> (i, (k, ix) -> Result check i)
mapSizeOffset (Map k (Int, Index shape -> Result check Int)
 -> (Int, (k, Index shape) -> Result check Int))
-> (Map k shape -> Map k (Int, Index shape -> Result check Int))
-> Map k shape
-> (Int, (k, Index shape) -> Result check Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (shape -> (Int, Index shape -> Result check Int))
-> Map k shape -> Map k (Int, Index shape -> Result check Int)
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap shape -> (Int, Index shape -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
forall check.
Checking check =>
shape -> (Int, Index shape -> 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 =
   (Map k i -> i
forall a. Num a => Map k a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum (Map k i -> i) -> Map k i -> i
forall a b. (a -> b) -> a -> b
$ ((i, ix -> Result check i) -> i)
-> Map k (i, ix -> Result check i) -> Map k i
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (i, ix -> Result check i) -> i
forall a b. (a, b) -> a
fst Map k (i, ix -> Result check i)
ms,
    let mu :: Map k (ix -> Result check i)
mu = (i, Map k (ix -> Result check i)) -> Map k (ix -> Result check i)
forall a b. (a, b) -> b
snd ((i, Map k (ix -> Result check i)) -> Map k (ix -> Result check i))
-> (i, Map k (ix -> Result check i))
-> Map k (ix -> Result check i)
forall a b. (a -> b) -> a -> b
$
         (i -> (i, ix -> Result check i) -> (i, ix -> Result check i))
-> i
-> Map k (i, ix -> Result check i)
-> (i, Map k (ix -> Result check i))
forall (t :: * -> *) 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 i -> i -> i
forall a. Num a => a -> a -> a
+ i
sz, (i -> i) -> Result check i -> Result check i
forall a b. (a -> b) -> Result check a -> Result check b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i
li -> i -> i
forall a. Num a => a -> a -> a
+) (Result check i -> Result check i)
-> (ix -> Result check i) -> ix -> Result check i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> Result check i
offs)) i
0 Map k (i, ix -> Result check i)
ms
    in \(k
k,ix
ix) ->
         Result check i
-> ((ix -> Result check i) -> Result check i)
-> Maybe (ix -> Result check i)
-> Result check i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (String -> Result check i
forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.Map.sizeOffset: unknown key")
            ((ix -> Result check i) -> ix -> Result check i
forall a b. (a -> b) -> a -> b
$ix
ix)
            (k -> Map k (ix -> Result check i) -> Maybe (ix -> Result check i)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (ix -> Result check i)
mu))

instance (Ord k, InvIndexed shape) => InvIndexed (Map k shape) where
   unifiedIndexFromOffset :: 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)
Result check (Index (Map k shape))
ix
            [] -> String -> Result check (Index (Map k shape))
forall check a. Checking check => String -> Result check a
throwOrError (String -> Result check (Index (Map k shape)))
-> String -> Result check (Index (Map k shape))
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Map" Int
i) ([(Int, Result check (k, Index shape))]
 -> Result check (Index (Map k shape)))
-> [(Int, Result check (k, Index shape))]
-> Result check (Index (Map k shape))
forall a b. (a -> b) -> a -> b
$
      ((Int, Result check (k, Index shape)) -> Bool)
-> [(Int, Result check (k, Index shape))]
-> [(Int, Result check (k, Index shape))]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
u,Result check (k, Index shape)
_ix) -> Int
uInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
i) ([(Int, Result check (k, Index shape))]
 -> [(Int, Result check (k, Index shape))])
-> [(Int, Result check (k, Index shape))]
-> [(Int, Result check (k, Index shape))]
forall a b. (a -> b) -> a -> b
$ (Int, [(Int, Result check (k, Index shape))])
-> [(Int, Result check (k, Index shape))]
forall a b. (a, b) -> b
snd ((Int, [(Int, Result check (k, Index shape))])
 -> [(Int, Result check (k, Index shape))])
-> (Int, [(Int, Result check (k, Index shape))])
-> [(Int, Result check (k, Index shape))]
forall a b. (a -> b) -> a -> b
$
      (Int -> (k, shape) -> (Int, (Int, Result check (k, Index shape))))
-> Int
-> [(k, shape)]
-> (Int, [(Int, Result check (k, Index shape))])
forall (t :: * -> *) 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ shape -> Int
forall sh. C sh => sh -> Int
size shape
sh
            in (Int
u, (Int
u, (,) k
k (Index shape -> (k, Index shape))
-> Result check (Index shape) -> Result check (k, Index shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> shape -> Int -> Result check (Index shape)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
forall check.
Checking check =>
shape -> Int -> Result check (Index shape)
unifiedIndexFromOffset shape
sh (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l)))) Int
0 ([(k, shape)] -> (Int, [(Int, Result check (k, Index shape))]))
-> [(k, shape)] -> (Int, [(Int, Result check (k, Index shape))])
forall a b. (a -> b) -> a -> b
$
      Map k shape -> [(k, shape)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k shape
m



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

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

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

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

{-# INLINE intMapSizeOffset #-}
intMapSizeOffset ::
   (Checking check, Num i) =>
   IntMap (i, ix -> Result check i) -> (i, (Int, ix) -> Result check i)
intMapSizeOffset :: forall check i ix.
(Checking check, Num i) =>
IntMap (i, ix -> Result check i)
-> (i, (Int, ix) -> Result check i)
intMapSizeOffset IntMap (i, ix -> Result check i)
ms =
   (IntMap i -> i
forall a. Num a => IntMap a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum (IntMap i -> i) -> IntMap i -> i
forall a b. (a -> b) -> a -> b
$ ((i, ix -> Result check i) -> i)
-> IntMap (i, ix -> Result check i) -> IntMap i
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (i, ix -> Result check i) -> i
forall a b. (a, b) -> a
fst IntMap (i, ix -> Result check i)
ms,
    let mu :: IntMap (ix -> Result check i)
mu = (i, IntMap (ix -> Result check i)) -> IntMap (ix -> Result check i)
forall a b. (a, b) -> b
snd ((i, IntMap (ix -> Result check i))
 -> IntMap (ix -> Result check i))
-> (i, IntMap (ix -> Result check i))
-> IntMap (ix -> Result check i)
forall a b. (a -> b) -> a -> b
$
         (i -> (i, ix -> Result check i) -> (i, ix -> Result check i))
-> i
-> IntMap (i, ix -> Result check i)
-> (i, IntMap (ix -> Result check i))
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 i -> i -> i
forall a. Num a => a -> a -> a
+ i
sz, (i -> i) -> Result check i -> Result check i
forall a b. (a -> b) -> Result check a -> Result check b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i
li -> i -> i
forall a. Num a => a -> a -> a
+) (Result check i -> Result check i)
-> (ix -> Result check i) -> ix -> Result check i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> Result check i
offs)) i
0 IntMap (i, ix -> Result check i)
ms
    in \(Int
k,ix
ix) ->
         Result check i
-> ((ix -> Result check i) -> Result check i)
-> Maybe (ix -> Result check i)
-> Result check i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (String -> Result check i
forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.IntMap.sizeOffset: unknown key")
            ((ix -> Result check i) -> ix -> Result check i
forall a b. (a -> b) -> a -> b
$ix
ix)
            (Int
-> IntMap (ix -> Result check i) -> Maybe (ix -> Result check i)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap (ix -> Result check i)
mu))

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



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

Example:

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

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

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

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

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

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

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

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

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

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



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

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

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

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

instance (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) = (Index sh -> x) -> sh -> DataPattern sh x
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x. (Index sh -> x) -> sh -> DataPattern sh x
indexPattern (Tagged s (Index sh) -> x
Index (Tagged s sh) -> x
extend (Tagged s (Index sh) -> x)
-> (Index sh -> Tagged s (Index sh)) -> Index sh -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index sh -> Tagged s (Index sh)
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) = sh0 -> Int
forall sh. C sh => sh -> Int
size sh0
sh0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* sh1 -> Int
forall sh. C sh => sh -> Int
size sh1
sh1

{- |
Row-major composition of two dimensions.

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

instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0,sh1) where
   unifiedIndexFromOffset :: 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) =
            Int
-> Backwards
     (StateT Int Identity) (Result check (Index sh0), Index sh1)
-> (Result check (Index sh0), Index sh1)
forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k (Backwards
   (StateT Int Identity) (Result check (Index sh0), Index sh1)
 -> (Result check (Index sh0), Index sh1))
-> Backwards
     (StateT Int Identity) (Result check (Index sh0), Index sh1)
-> (Result check (Index sh0), Index sh1)
forall a b. (a -> b) -> a -> b
$ (Result check (Index sh0)
 -> Index sh1 -> (Result check (Index sh0), Index sh1))
-> Backwards (StateT Int Identity) (Result check (Index sh0))
-> Backwards (StateT Int Identity) (Index sh1)
-> Backwards
     (StateT Int Identity) (Result check (Index sh0), Index sh1)
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) (sh0 -> Backwards (StateT Int Identity) (Result check (Index sh0))
forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh0
sh0) (sh1 -> Backwards (StateT Int Identity) (Index sh1)
forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh1
sh1)
      Index sh0
ix0 <- Result check (Index sh0)
rix0
      (Index sh0, Index sh1) -> Result check (Index sh0, Index sh1)
forall a. a -> Result check a
forall (m :: * -> *) a. Monad m => a -> m a
return (Index sh0
ix0,Index sh1
ix1)

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

instance
   (AppendSemigroup sh0, C sh1, Eq sh1) =>
      AppendSemigroup (sh0,sh1) where
   append :: (sh0, sh1) -> (sh0, sh1) -> (sh0, sh1)
append (sh0
sh0a,sh1
sh1a) (sh0
sh0b,sh1
sh1b) =
      if sh1
sh1a sh1 -> sh1 -> Bool
forall a. Eq a => a -> a -> Bool
== sh1
sh1b
         then (sh0 -> sh0 -> sh0
forall sh. AppendSemigroup sh => sh -> sh -> sh
append sh0
sh0a sh0
sh0b, sh1
sh1a)
         else String -> (sh0, sh1)
forall a. HasCallStack => String -> a
error (String -> (sh0, sh1)) -> String -> (sh0, sh1)
forall a b. (a -> b) -> a -> b
$ String
"Shape.append: column shapes mismatch"

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) =
      DataPattern sh0 (DataPattern sh1 x)
-> PatternRecord sh0 (DataPattern sh1 x)
forall sh a. DataPattern sh a -> PatternRecord sh a
PatternRecord (DataPattern sh0 (DataPattern sh1 x)
 -> PatternRecord sh0 (DataPattern sh1 x))
-> DataPattern sh0 (DataPattern sh1 x)
-> PatternRecord sh0 (DataPattern sh1 x)
forall a b. (a -> b) -> a -> b
$
         (Index sh0 -> DataPattern sh1 x)
-> sh0 -> DataPattern sh0 (DataPattern sh1 x)
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x. (Index sh0 -> x) -> sh0 -> DataPattern sh0 x
indexPattern (\Index sh0
i -> (Index sh1 -> x) -> sh1 -> DataPattern sh1 x
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x. (Index sh1 -> x) -> sh1 -> DataPattern sh1 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) = sh0 -> Int
forall sh. C sh => sh -> Int
size sh0
sh0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* sh1 -> Int
forall sh. C sh => sh -> Int
size sh1
sh1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* sh2 -> Int
forall sh. C sh => sh -> Int
size sh2
sh2

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

instance
   (InvIndexed sh0, InvIndexed sh1, InvIndexed sh2) =>
      InvIndexed (sh0,sh1,sh2) where
   unifiedIndexFromOffset :: 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) =
            Int
-> Backwards
     (StateT Int Identity)
     (Result check (Index sh0), Index sh1, Index sh2)
-> (Result check (Index sh0), Index sh1, Index sh2)
forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k (Backwards
   (StateT Int Identity)
   (Result check (Index sh0), Index sh1, Index sh2)
 -> (Result check (Index sh0), Index sh1, Index sh2))
-> Backwards
     (StateT Int Identity)
     (Result check (Index sh0), Index sh1, Index sh2)
-> (Result check (Index sh0), Index sh1, Index sh2)
forall a b. (a -> b) -> a -> b
$
            (Result check (Index sh0)
 -> Index sh1
 -> Index sh2
 -> (Result check (Index sh0), Index sh1, Index sh2))
-> Backwards (StateT Int Identity) (Result check (Index sh0))
-> Backwards (StateT Int Identity) (Index sh1)
-> Backwards (StateT Int Identity) (Index sh2)
-> Backwards
     (StateT Int Identity)
     (Result check (Index sh0), Index sh1, Index sh2)
forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,) (sh0 -> Backwards (StateT Int Identity) (Result check (Index sh0))
forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh0
sh0) (sh1 -> Backwards (StateT Int Identity) (Index sh1)
forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh1
sh1) (sh2 -> Backwards (StateT Int Identity) (Index sh2)
forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh2
sh2)
      Index sh0
ix0 <- Result check (Index sh0)
rix0
      (Index sh0, Index sh1, Index sh2)
-> Result check (Index sh0, Index sh1, Index sh2)
forall a. a -> Result check a
forall (m :: * -> *) a. Monad m => a -> m a
return (Index sh0
ix0,Index sh1
ix1,Index sh2
ix2)

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

instance
   (AppendSemigroup sh0, C sh1, Eq sh1, C sh2, Eq sh2) =>
      AppendSemigroup (sh0,sh1,sh2) where
   append :: (sh0, sh1, sh2) -> (sh0, sh1, sh2) -> (sh0, sh1, sh2)
append (sh0
sh0a,sh1
sh1a,sh2
sh2a) (sh0
sh0b,sh1
sh1b,sh2
sh2b) =
      if sh1
sh1a sh1 -> sh1 -> Bool
forall a. Eq a => a -> a -> Bool
== sh1
sh1b Bool -> Bool -> Bool
&&  sh2
sh2a sh2 -> sh2 -> Bool
forall a. Eq a => a -> a -> Bool
== sh2
sh2b
         then (sh0 -> sh0 -> sh0
forall sh. AppendSemigroup sh => sh -> sh -> sh
append sh0
sh0a sh0
sh0b, sh1
sh1a, sh2
sh2a)
         else String -> (sh0, sh1, sh2)
forall a. HasCallStack => String -> a
error (String -> (sh0, sh1, sh2)) -> String -> (sh0, sh1, sh2)
forall a b. (a -> b) -> a -> b
$ String
"Shape.append: column shapes mismatch"

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

pickLastIndex ::
   (Checking check, InvIndexed sh) =>
   sh -> Back.Backwards (MS.State Int) (Result check (Index sh))
pickLastIndex :: forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh
sh =
   State Int (Result check (Index sh))
-> Backwards (StateT Int Identity) (Result check (Index sh))
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards (State Int (Result check (Index sh))
 -> Backwards (StateT Int Identity) (Result check (Index sh)))
-> State Int (Result check (Index sh))
-> Backwards (StateT Int Identity) (Result check (Index sh))
forall a b. (a -> b) -> a -> b
$ (Int -> Result check (Index sh))
-> State Int (Result check (Index sh))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets ((Int -> Result check (Index sh))
 -> State Int (Result check (Index sh)))
-> (Int -> Result check (Index sh))
-> State Int (Result check (Index sh))
forall a b. (a -> b) -> a -> b
$ sh -> Int -> Result check (Index sh)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
forall check.
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 =
   (Int -> Index sh)
-> Backwards (StateT Int Identity) Int
-> Backwards (StateT Int Identity) (Index sh)
forall a b.
(a -> b)
-> Backwards (StateT Int Identity) a
-> Backwards (StateT Int Identity) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (sh -> Int -> Index sh
forall sh. InvIndexed sh => sh -> Int -> Index sh
uncheckedIndexFromOffset sh
sh) (Backwards (StateT Int Identity) Int
 -> Backwards (StateT Int Identity) (Index sh))
-> Backwards (StateT Int Identity) Int
-> Backwards (StateT Int Identity) (Index sh)
forall a b. (a -> b) -> a -> b
$
   State Int Int -> Backwards (StateT Int Identity) Int
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards (State Int Int -> Backwards (StateT Int Identity) Int)
-> State Int Int -> Backwards (StateT Int Identity) Int
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Int)) -> State Int Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state ((Int -> (Int, Int)) -> State Int Int)
-> (Int -> (Int, Int)) -> State Int Int
forall a b. (a -> b) -> a -> b
$ \Int
k -> (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
k (Int -> (Int, Int)) -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
size sh
sh



infixr 7 `combineOffset`, `combineSizeOffset`

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

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



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

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

cartesianFromSquare :: Square sh -> (sh,sh)
cartesianFromSquare :: forall sh. Square sh -> (sh, sh)
cartesianFromSquare (Square sh
sh) = (sh
sh,sh
sh)

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

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

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

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

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

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

instance (InvIndexed sh) => InvIndexed (Square sh) where
   unifiedIndexFromOffset :: forall check.
Checking check =>
Square sh -> Int -> Result check (Index (Square sh))
unifiedIndexFromOffset (Square sh
sh) =
      (sh, sh) -> Int -> Result check (Index (sh, sh))
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
forall check.
Checking check =>
(sh, sh) -> Int -> Result check (Index (sh, 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) =
      DataPattern sh (DataPattern sh x)
-> PatternRecord sh (DataPattern sh x)
forall sh a. DataPattern sh a -> PatternRecord sh a
PatternRecord (DataPattern sh (DataPattern sh x)
 -> PatternRecord sh (DataPattern sh x))
-> DataPattern sh (DataPattern sh x)
-> PatternRecord sh (DataPattern sh x)
forall a b. (a -> b) -> a -> b
$
         (Index sh -> DataPattern sh x)
-> sh -> DataPattern sh (DataPattern sh x)
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x. (Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh
i -> (Index sh -> x) -> sh -> DataPattern sh x
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x. (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
(Cube sh -> Cube sh -> Bool)
-> (Cube sh -> Cube sh -> Bool) -> Eq (Cube sh)
forall sh. Eq sh => Cube sh -> Cube sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Cube sh -> Cube sh -> Bool
Eq, Int -> Cube sh -> String -> String
[Cube sh] -> String -> String
Cube sh -> String
(Int -> Cube sh -> String -> String)
-> (Cube sh -> String)
-> ([Cube sh] -> String -> String)
-> Show (Cube sh)
forall sh. Show sh => Int -> Cube sh -> String -> String
forall sh. Show sh => [Cube sh] -> String -> String
forall sh. Show sh => Cube sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall sh. Show sh => Int -> Cube sh -> String -> String
showsPrec :: Int -> Cube sh -> String -> String
$cshow :: forall sh. Show sh => Cube sh -> String
show :: Cube sh -> String
$cshowList :: forall sh. Show sh => [Cube sh] -> String -> String
showList :: [Cube sh] -> String -> String
Show)

cartesianFromCube :: Cube sh -> (sh,sh,sh)
cartesianFromCube :: forall sh. Cube sh -> (sh, sh, sh)
cartesianFromCube (Cube sh
sh) = (sh
sh,sh
sh,sh
sh)

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

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

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

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

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

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

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



data Lower = Lower deriving (Lower -> Lower -> Bool
(Lower -> Lower -> Bool) -> (Lower -> Lower -> Bool) -> Eq Lower
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lower -> Lower -> Bool
== :: Lower -> Lower -> Bool
$c/= :: Lower -> Lower -> Bool
/= :: Lower -> Lower -> Bool
Eq, Int -> Lower -> String -> String
[Lower] -> String -> String
Lower -> String
(Int -> Lower -> String -> String)
-> (Lower -> String) -> ([Lower] -> String -> String) -> Show Lower
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Lower -> String -> String
showsPrec :: Int -> Lower -> String -> String
$cshow :: Lower -> String
show :: Lower -> String
$cshowList :: [Lower] -> String -> String
showList :: [Lower] -> String -> String
Show)
data Upper = Upper deriving (Upper -> Upper -> Bool
(Upper -> Upper -> Bool) -> (Upper -> Upper -> Bool) -> Eq Upper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Upper -> Upper -> Bool
== :: Upper -> Upper -> Bool
$c/= :: Upper -> Upper -> Bool
/= :: Upper -> Upper -> Bool
Eq, Int -> Upper -> String -> String
[Upper] -> String -> String
Upper -> String
(Int -> Upper -> String -> String)
-> (Upper -> String) -> ([Upper] -> String -> String) -> Show Upper
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Upper -> String -> String
showsPrec :: Int -> Upper -> String -> String
$cshow :: Upper -> String
show :: Upper -> String
$cshowList :: [Upper] -> String -> String
showList :: [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
_ = Const a c -> a
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 =
   part -> Const a part -> a
forall c a. c -> Const a c -> a
getConstAs part
part (Const a part -> a) -> Const a part -> a
forall a b. (a -> b) -> a -> b
$ Const a Lower -> Const a Upper -> Const a part
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
forall (f :: * -> *). f Lower -> f Upper -> f part
switchTriangularPart (a -> Const a Lower
forall {k} a (b :: k). a -> Const a b
Const a
lo) (a -> Const a Upper
forall {k} a (b :: k). a -> Const a b
Const a
up)

{- |
>>> Shape.indices $ Shape.Triangular Shape.Upper $ Shape.ZeroBased (3::Int)
[(0,0),(0,1),(0,2),(1,1),(1,2),(2,2)]
>>> Shape.indices $ Shape.Triangular Shape.Lower $ Shape.ZeroBased (3::Int)
[(0,0),(1,0),(1,1),(2,0),(2,1),(2,2)]
-}
data Triangular part size =
   Triangular {
      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
[Triangular part size] -> String -> String
Triangular part size -> String
(Int -> Triangular part size -> String -> String)
-> (Triangular part size -> String)
-> ([Triangular part size] -> String -> String)
-> Show (Triangular part size)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall part size.
(Show part, Show size) =>
Int -> Triangular part size -> String -> String
forall part size.
(Show part, Show size) =>
[Triangular part size] -> String -> String
forall part size.
(Show part, Show size) =>
Triangular part size -> String
$cshowsPrec :: forall part size.
(Show part, Show size) =>
Int -> Triangular part size -> String -> String
showsPrec :: Int -> Triangular part size -> String -> String
$cshow :: forall part size.
(Show part, Show size) =>
Triangular part size -> String
show :: Triangular part size -> String
$cshowList :: forall part size.
(Show part, Show size) =>
[Triangular part size] -> String -> String
showList :: [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 = Equal part -> part -> part -> Bool
forall part. Equal part -> part -> part -> Bool
getEqual (Equal part -> part -> part -> Bool)
-> Equal part -> part -> part -> Bool
forall a b. (a -> b) -> a -> b
$ Equal Lower -> Equal Upper -> Equal part
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
forall (f :: * -> *). f Lower -> f Upper -> f part
switchTriangularPart ((Lower -> Lower -> Bool) -> Equal Lower
forall part. (part -> part -> Bool) -> Equal part
Equal Lower -> Lower -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ((Upper -> Upper -> Bool) -> Equal Upper
forall part. (part -> part -> Bool) -> Equal part
Equal Upper -> Upper -> Bool
forall a. Eq a => a -> a -> Bool
(==))

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

type LowerTriangular = Triangular Lower
type UpperTriangular = Triangular Upper

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

upperTriangular :: size -> UpperTriangular size
upperTriangular :: forall size. size -> UpperTriangular size
upperTriangular = Upper -> size -> Triangular Upper size
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) =
      ((), size) -> ()
forall a. NFData a => a -> ()
rnf
         ((Flip (->) () part -> part -> ())
-> part -> Flip (->) () part -> ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Flip (->) () part -> part -> ()
forall (f :: * -> * -> *) b a. Flip f b a -> f a b
getFlip part
part (Flip (->) () part -> ()) -> Flip (->) () part -> ()
forall a b. (a -> b) -> a -> b
$
            Flip (->) () Lower -> Flip (->) () Upper -> Flip (->) () part
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
forall (f :: * -> *). f Lower -> f Upper -> f part
switchTriangularPart ((Lower -> ()) -> Flip (->) () Lower
forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip ((Lower -> ()) -> Flip (->) () Lower)
-> (Lower -> ()) -> Flip (->) () Lower
forall a b. (a -> b) -> a -> b
$ \Lower
Lower -> ()) ((Upper -> ()) -> Flip (->) () Upper
forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip ((Upper -> ()) -> Flip (->) () Upper)
-> (Upper -> ()) -> Flip (->) () Upper
forall a b. (a -> b) -> a -> b
$ \Upper
Upper -> ()),
          size
sz)

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

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

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

   unifiedSizeOffset :: 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) = size -> (Int, Index size -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
forall check.
Checking check =>
size -> (Int, Index size -> 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
         String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Triangular.sizeOffset: wrong array part" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$
            part -> Int -> Int -> Bool
forall part a.
(TriangularPart part, Ord a) =>
part -> a -> a -> Bool
compareIndices part
part Int
r Int
c
         Int -> Result check Int
forall a. a -> Result check a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ part -> Int -> (Int, Int) -> Int
forall part.
TriangularPart part =>
part -> Int -> (Int, Int) -> Int
triangleOffset part
part Int
n (Int
r,Int
c))

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

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

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

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

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

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

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

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


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

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



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

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

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

>>> Shape.indices $ Shape.simplexDescending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int)
[[2,1,0],[3,1,0],[3,2,0],[3,2,1]]
>>> Shape.indices $ Shape.simplexDescending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int)
[[0,0,0],[1,0,0],[1,1,0],[1,1,1],[2,0,0],[2,1,0],[2,1,1],[2,2,0],[2,2,1],[2,2,2]]
>>> Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int)
[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]
>>> Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int)
[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]
-}
data Simplex order coll f size =
   Simplex {
      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 = SimplexOrder Ascending
-> f coll -> size -> Simplex Ascending coll f size
forall order coll (f :: * -> *) size.
SimplexOrder order -> f coll -> size -> Simplex order coll f size
Simplex SimplexOrder Ascending
Ascending

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

prepareSimplexIndexing ::
   (Traversable t, Num i, CollisionC coll) =>
   t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing :: 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) =
         ((Bool, (i, Int)) -> Bool -> ((Bool, (i, Int)), (Int, (i, Int))))
-> (Bool, (i, Int))
-> t Bool
-> ((Bool, (i, Int)), t (Int, (i, Int)))
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 = Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool
ciBool -> Bool -> Bool
&&Bool
c0)
                   p :: (i, Int)
p = (i
xi -> i -> i
forall a. Num a => a -> a -> a
+i
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c1)
               in ((Bool
True,(i, Int)
p),(Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c1,(i, Int)
p)))
            (Bool
False,(i
0,Int
n))
            ((coll -> Bool) -> t coll -> t Bool
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap coll -> Bool
forall coll. CollisionC coll => coll -> Bool
repetitionAllowed t coll
d)
   in (Int
nSum, t (Int, (i, Int))
deco)



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

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

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

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

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

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

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

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

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

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



infixr 5 ::+

{- |
Row-major composition of two dimensions.

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

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

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

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

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

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

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) =
      (Index sh0 -> x) -> sh0 -> DataPattern sh0 x
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x. (Index sh0 -> x) -> sh0 -> DataPattern sh0 x
indexPattern (Either (Index sh0) (Index sh1) -> x
Index (sh0 ::+ sh1) -> x
extend (Either (Index sh0) (Index sh1) -> x)
-> (Index sh0 -> Either (Index sh0) (Index sh1)) -> Index sh0 -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index sh0 -> Either (Index sh0) (Index sh1)
forall a b. a -> Either a b
Left) sh0
sh0 DataPattern sh0 x
-> DataPattern sh1 x -> DataPattern sh0 x ::+ DataPattern sh1 x
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ (Index sh1 -> x) -> sh1 -> DataPattern sh1 x
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x. (Index sh1 -> x) -> sh1 -> DataPattern sh1 x
indexPattern (Either (Index sh0) (Index sh1) -> x
Index (sh0 ::+ sh1) -> x
extend (Either (Index sh0) (Index sh1) -> x)
-> (Index sh1 -> Either (Index sh0) (Index sh1)) -> Index sh1 -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index sh1 -> Either (Index sh0) (Index sh1)
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 = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Num a => a -> a -> a
*a
a) f a
f

(|+|) :: (Applicative f, Num a) => f a -> f a -> f a
|+| :: forall (f :: * -> *) a. (Applicative f, Num a) => f a -> f a -> f a
(|+|) = (a -> a -> 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 a -> a -> a
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
(NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool)
-> (NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool)
-> Eq (NestedTuple ixtype tuple)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ixtype tuple.
Eq tuple =>
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
/= :: NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
Eq, Int -> NestedTuple ixtype tuple -> String -> String
[NestedTuple ixtype tuple] -> String -> String
NestedTuple ixtype tuple -> String
(Int -> NestedTuple ixtype tuple -> String -> String)
-> (NestedTuple ixtype tuple -> String)
-> ([NestedTuple ixtype tuple] -> String -> String)
-> Show (NestedTuple ixtype tuple)
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
$cshowsPrec :: forall ixtype tuple.
Show tuple =>
Int -> NestedTuple ixtype tuple -> String -> String
showsPrec :: Int -> NestedTuple ixtype tuple -> String -> String
$cshow :: forall ixtype tuple.
Show tuple =>
NestedTuple ixtype tuple -> String
show :: NestedTuple ixtype tuple -> String
$cshowList :: forall ixtype tuple.
Show tuple =>
[NestedTuple ixtype tuple] -> String -> String
showList :: [NestedTuple ixtype tuple] -> String -> String
Show)

data TupleAccessor
data TupleIndex

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

instance NFData Element where
   rnf :: Element -> ()
rnf (Element Int
k) = Int -> ()
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 =
   Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> (tuple -> Sum Int) -> tuple -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (Sum Int) (DataTuple tuple Element) -> Sum Int
forall w a. Writer w a -> w
MW.execWriter (Writer (Sum Int) (DataTuple tuple Element) -> Sum Int)
-> (tuple -> Writer (Sum Int) (DataTuple tuple Element))
-> tuple
-> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> WriterT (Sum Int) Identity Element)
-> tuple -> Writer (Sum Int) (DataTuple tuple Element)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA (\Element
x -> Sum Int -> WriterT (Sum Int) Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
MW.tell (Int -> Sum Int
forall a. a -> Sum a
Sum Int
1) WriterT (Sum Int) Identity ()
-> WriterT (Sum Int) Identity Element
-> WriterT (Sum Int) Identity Element
forall a b.
WriterT (Sum Int) Identity a
-> WriterT (Sum Int) Identity b -> WriterT (Sum Int) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> WriterT (Sum Int) Identity Element
forall a. a -> WriterT (Sum Int) Identity a
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 = Identity (DataTuple tuple a) -> DataTuple tuple a
forall a. Identity a -> a
runIdentity (Identity (DataTuple tuple a) -> DataTuple tuple a)
-> (tuple -> Identity (DataTuple tuple a))
-> tuple
-> DataTuple tuple a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Identity a) -> tuple -> Identity (DataTuple tuple a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (Element -> a) -> Element -> Identity a
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) =
      StrictUnitWriter (DataTuple tuple ()) -> ()
forall a. StrictUnitWriter a -> ()
execStrictUnitWriter (StrictUnitWriter (DataTuple tuple ()) -> ())
-> StrictUnitWriter (DataTuple tuple ()) -> ()
forall a b. (a -> b) -> a -> b
$ (Element -> StrictUnitWriter ())
-> tuple -> StrictUnitWriter (DataTuple tuple ())
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA ((() -> StrictUnitWriter ()
forall a. a -> StrictUnitWriter a
StrictUnitWriter(() -> StrictUnitWriter ()) -> () -> StrictUnitWriter ()
forall a b. (a -> b) -> a -> b
$!) (() -> StrictUnitWriter ())
-> (Element -> ()) -> Element -> StrictUnitWriter ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> ()
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) = b -> StrictUnitWriter b
forall a. a -> StrictUnitWriter a
StrictUnitWriter (b -> StrictUnitWriter b) -> b -> StrictUnitWriter b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

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

instance Monad StrictUnitWriter where
   return :: forall a. a -> StrictUnitWriter a
return = a -> StrictUnitWriter a
forall a. a -> StrictUnitWriter a
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
_ () = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

instance StaticTuple () where
   staticTuple :: State Element ()
staticTuple = () -> State Element ()
forall a. a -> StateT Element Identity a
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
Element -> f (DataTuple Element a)
extend

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

instance StaticTuple Element where
   staticTuple :: State Element Element
staticTuple = do
      Element
ix <- State Element Element
forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
      (Element -> Element) -> State Element ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (\(Element Int
k) -> Int -> Element
Element (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
      Element -> State Element Element
forall a. a -> StateT Element Identity a
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) =
      (DataTuple a a -> DataTuple b a -> (DataTuple a a, DataTuple b a))
-> f (DataTuple a a)
-> f (DataTuple b a)
-> f (DataTuple a a, DataTuple b a)
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) ((Element -> f a) -> a -> f (DataTuple a a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> a -> f (DataTuple a a)
indexTupleA Element -> f a
extend a
a) ((Element -> f a) -> b -> f (DataTuple b a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> b -> f (DataTuple b 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) =
      ((a -> Element) -> (a, b) -> Element)
-> [a -> Element] -> [(a, b) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Element) -> ((a, b) -> a) -> (a, b) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> a
forall a b. (a, b) -> a
fst) (a -> [a -> Element]
forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) [(a, b) -> Element] -> [(a, b) -> Element] -> [(a, b) -> Element]
forall a. [a] -> [a] -> [a]
++ ((b -> Element) -> (a, b) -> Element)
-> [b -> Element] -> [(a, b) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> Element) -> ((a, b) -> b) -> (a, b) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> b
forall a b. (a, b) -> b
snd) (b -> [b -> Element]
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 = (a -> b -> (a, b))
-> StateT Element Identity a
-> StateT Element Identity b
-> State Element (a, b)
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) StateT Element Identity a
forall tuple. StaticTuple tuple => State Element tuple
staticTuple StateT Element Identity b
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) =
      (DataTuple a a
 -> DataTuple b a
 -> DataTuple c a
 -> (DataTuple a a, DataTuple b a, DataTuple c a))
-> f (DataTuple a a)
-> f (DataTuple b a)
-> f (DataTuple c a)
-> f (DataTuple a a, DataTuple b a, DataTuple c a)
forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,)
         ((Element -> f a) -> a -> f (DataTuple a a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> a -> f (DataTuple a a)
indexTupleA Element -> f a
extend a
a) ((Element -> f a) -> b -> f (DataTuple b a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> b -> f (DataTuple b a)
indexTupleA Element -> f a
extend b
b) ((Element -> f a) -> c -> f (DataTuple c a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> c -> f (DataTuple c 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) =
      ((a -> Element) -> (a, b, c) -> Element)
-> [a -> Element] -> [(a, b, c) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Element) -> ((a, b, c) -> a) -> (a, b, c) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3) (a -> [a -> Element]
forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) [(a, b, c) -> Element]
-> [(a, b, c) -> Element] -> [(a, b, c) -> Element]
forall a. [a] -> [a] -> [a]
++
      ((b -> Element) -> (a, b, c) -> Element)
-> [b -> Element] -> [(a, b, c) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> Element) -> ((a, b, c) -> b) -> (a, b, c) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b, c) -> b
forall a b c. (a, b, c) -> b
snd3) (b -> [b -> Element]
forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b) [(a, b, c) -> Element]
-> [(a, b, c) -> Element] -> [(a, b, c) -> Element]
forall a. [a] -> [a] -> [a]
++
      ((c -> Element) -> (a, b, c) -> Element)
-> [c -> Element] -> [(a, b, c) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> Element) -> ((a, b, c) -> c) -> (a, b, c) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b, c) -> c
forall a b c. (a, b, c) -> c
thd3) (c -> [c -> Element]
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 = (a -> b -> c -> (a, b, c))
-> StateT Element Identity a
-> StateT Element Identity b
-> StateT Element Identity c
-> State Element (a, b, c)
forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,) StateT Element Identity a
forall tuple. StaticTuple tuple => State Element tuple
staticTuple StateT Element Identity b
forall tuple. StaticTuple tuple => State Element tuple
staticTuple StateT Element Identity c
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) =
      (DataTuple a a
 -> DataTuple b a
 -> DataTuple c a
 -> DataTuple d a
 -> (DataTuple a a, DataTuple b a, DataTuple c a, DataTuple d a))
-> f (DataTuple a a)
-> f (DataTuple b a)
-> f (DataTuple c a)
-> f (DataTuple d a)
-> f (DataTuple a a, DataTuple b a, DataTuple c a, DataTuple d a)
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 (,,,)
         ((Element -> f a) -> a -> f (DataTuple a a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> a -> f (DataTuple a a)
indexTupleA Element -> f a
extend a
a) ((Element -> f a) -> b -> f (DataTuple b a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> b -> f (DataTuple b a)
indexTupleA Element -> f a
extend b
b)
         ((Element -> f a) -> c -> f (DataTuple c a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> c -> f (DataTuple c a)
indexTupleA Element -> f a
extend c
c) ((Element -> f a) -> d -> f (DataTuple d a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> d -> f (DataTuple d 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) =
      ((a -> Element) -> (a, b, c, d) -> Element)
-> [a -> Element] -> [(a, b, c, d) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Element) -> ((a, b, c, d) -> a) -> (a, b, c, d) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
i,b
_,c
_,d
_) -> a
i)) (a -> [a -> Element]
forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) [(a, b, c, d) -> Element]
-> [(a, b, c, d) -> Element] -> [(a, b, c, d) -> Element]
forall a. [a] -> [a] -> [a]
++
      ((b -> Element) -> (a, b, c, d) -> Element)
-> [b -> Element] -> [(a, b, c, d) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> Element) -> ((a, b, c, d) -> b) -> (a, b, c, d) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
i,c
_,d
_) -> b
i)) (b -> [b -> Element]
forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b) [(a, b, c, d) -> Element]
-> [(a, b, c, d) -> Element] -> [(a, b, c, d) -> Element]
forall a. [a] -> [a] -> [a]
++
      ((c -> Element) -> (a, b, c, d) -> Element)
-> [c -> Element] -> [(a, b, c, d) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> Element) -> ((a, b, c, d) -> c) -> (a, b, c, d) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
_,c
i,d
_) -> c
i)) (c -> [c -> Element]
forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors c
c) [(a, b, c, d) -> Element]
-> [(a, b, c, d) -> Element] -> [(a, b, c, d) -> Element]
forall a. [a] -> [a] -> [a]
++
      ((d -> Element) -> (a, b, c, d) -> Element)
-> [d -> Element] -> [(a, b, c, d) -> Element]
forall a b. (a -> b) -> [a] -> [b]
map ((d -> Element) -> ((a, b, c, d) -> d) -> (a, b, c, d) -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
_,c
_,d
i) -> d
i)) (d -> [d -> Element]
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 = (a -> b -> c -> d -> (a, b, c, d))
-> StateT Element Identity a
-> StateT Element Identity b
-> StateT Element Identity c
-> StateT Element Identity d
-> State Element (a, b, c, 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 (,,,) StateT Element Identity a
forall tuple. StaticTuple tuple => State Element tuple
staticTuple StateT Element Identity b
forall tuple. StaticTuple tuple => State Element tuple
staticTuple StateT Element Identity c
forall tuple. StaticTuple tuple => State Element tuple
staticTuple StateT Element Identity d
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) =
      (DataTuple a a -> DataTuple a a -> Complex (DataTuple a a))
-> f (DataTuple a a)
-> f (DataTuple a a)
-> f (Complex (DataTuple a a))
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 DataTuple a a -> DataTuple a a -> Complex (DataTuple a a)
forall a. a -> a -> Complex a
(:+) ((Element -> f a) -> a -> f (DataTuple a a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> a -> f (DataTuple a a)
indexTupleA Element -> f a
extend a
a) ((Element -> f a) -> a -> f (DataTuple a a)
forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> a -> f (DataTuple a a)
indexTupleA Element -> f a
extend a
b)

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

instance (StaticTuple a) => StaticTuple (Complex a) where
   staticTuple :: State Element (Complex a)
staticTuple = (a -> a -> Complex a)
-> StateT Element Identity a
-> StateT Element Identity a
-> State Element (Complex a)
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 a -> a -> Complex a
forall a. a -> a -> Complex a
(:+) StateT Element Identity a
forall tuple. StaticTuple tuple => State Element tuple
staticTuple StateT Element Identity a
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) = tuple -> Int
forall tuple. ElementTuple tuple => tuple -> Int
tupleSize tuple
tuple

instance (StaticTuple tuple) => Static (NestedTuple ixtype tuple) where
   static :: NestedTuple ixtype tuple
static = tuple -> NestedTuple ixtype tuple
forall ixtype tuple. tuple -> NestedTuple ixtype tuple
NestedTuple (tuple -> NestedTuple ixtype tuple)
-> tuple -> NestedTuple ixtype tuple
forall a b. (a -> b) -> a -> b
$ State Element tuple -> Element -> tuple
forall s a. State s a -> s -> a
MS.evalState State Element tuple
forall tuple. StaticTuple tuple => State Element tuple
staticTuple (Element -> tuple) -> Element -> tuple
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) = tuple -> [tuple -> Element]
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)
tuple -> Element
ix tuple
tuple of Element Int
k -> Int -> Result check Int
forall a. a -> Result check a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
k



newtype ElementIndex tuple = ElementIndex Int
   deriving (ElementIndex tuple -> ElementIndex tuple -> Bool
(ElementIndex tuple -> ElementIndex tuple -> Bool)
-> (ElementIndex tuple -> ElementIndex tuple -> Bool)
-> Eq (ElementIndex tuple)
forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, Eq (ElementIndex tuple)
Eq (ElementIndex tuple) =>
(ElementIndex tuple -> ElementIndex tuple -> Ordering)
-> (ElementIndex tuple -> ElementIndex tuple -> Bool)
-> (ElementIndex tuple -> ElementIndex tuple -> Bool)
-> (ElementIndex tuple -> ElementIndex tuple -> Bool)
-> (ElementIndex tuple -> ElementIndex tuple -> Bool)
-> (ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple)
-> (ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple)
-> Ord (ElementIndex tuple)
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
$ccompare :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Ordering
compare :: ElementIndex tuple -> ElementIndex tuple -> Ordering
$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
>= :: ElementIndex tuple -> ElementIndex tuple -> Bool
$cmax :: forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
max :: ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
$cmin :: forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
min :: ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
Ord, Int -> ElementIndex tuple -> String -> String
[ElementIndex tuple] -> String -> String
ElementIndex tuple -> String
(Int -> ElementIndex tuple -> String -> String)
-> (ElementIndex tuple -> String)
-> ([ElementIndex tuple] -> String -> String)
-> Show (ElementIndex tuple)
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
$cshowsPrec :: forall tuple. Int -> ElementIndex tuple -> String -> String
showsPrec :: Int -> ElementIndex tuple -> String -> String
$cshow :: forall tuple. ElementIndex tuple -> String
show :: ElementIndex tuple -> String
$cshowList :: forall tuple. [ElementIndex tuple] -> String -> String
showList :: [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) =
      (Int -> Index (NestedTuple TupleIndex tuple))
-> [Int] -> [Index (NestedTuple TupleIndex tuple)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ElementIndex tuple
Int -> Index (NestedTuple TupleIndex tuple)
forall tuple. Int -> ElementIndex tuple
ElementIndex ([Int] -> [Index (NestedTuple TupleIndex tuple)])
-> [Int] -> [Index (NestedTuple TupleIndex tuple)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (tuple -> Int
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) = Int -> Result check Int
forall a. a -> Result check a
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) = Int -> ElementIndex tuple
forall tuple. Int -> ElementIndex tuple
ElementIndex Int
k
      in (Element -> x) -> tuple -> DataTuple tuple x
forall tuple a.
ElementTuple tuple =>
(Element -> a) -> tuple -> DataTuple tuple a
indexTuple (ElementIndex tuple -> x
Index (NestedTuple TupleIndex tuple) -> x
extend (ElementIndex tuple -> x)
-> (Element -> ElementIndex tuple) -> Element -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tuple -> Element -> ElementIndex tuple
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 = (Index (NestedTuple TupleIndex tuple) -> ElementIndex tuple)
-> NestedTuple TupleIndex tuple
-> DataPattern (NestedTuple TupleIndex tuple) (ElementIndex tuple)
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
forall x.
(Index (NestedTuple TupleIndex tuple) -> x)
-> NestedTuple TupleIndex tuple
-> DataPattern (NestedTuple TupleIndex tuple) x
indexPattern ElementIndex tuple -> ElementIndex tuple
Index (NestedTuple TupleIndex tuple) -> ElementIndex tuple
forall a. a -> a
id




nextCounter :: MS.State Int Int
nextCounter :: State Int Int
nextCounter = do Int
k <- State Int Int
forall (m :: * -> *) s. Monad m => StateT s m s
MS.get; Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1); Int -> State Int Int
forall a. a -> StateT Int Identity a
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  =  f Element -> [Element]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f Element
sh0 [Element] -> [Element] -> Bool
forall a. Eq a => a -> a -> Bool
== f Element -> [Element]
forall a. f a -> [a]
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
(FieldIndex f -> FieldIndex f -> Bool)
-> (FieldIndex f -> FieldIndex f -> Bool) -> Eq (FieldIndex f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *). 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
/= :: FieldIndex f -> FieldIndex f -> Bool
Eq, Int -> FieldIndex f -> String -> String
[FieldIndex f] -> String -> String
FieldIndex f -> String
(Int -> FieldIndex f -> String -> String)
-> (FieldIndex f -> String)
-> ([FieldIndex f] -> String -> String)
-> Show (FieldIndex f)
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
$cshowsPrec :: forall (f :: * -> *). Int -> FieldIndex f -> String -> String
showsPrec :: Int -> FieldIndex f -> String -> String
$cshow :: forall (f :: * -> *). FieldIndex f -> String
show :: FieldIndex f -> String
$cshowList :: forall (f :: * -> *). [FieldIndex f] -> String -> String
showList :: [FieldIndex f] -> String -> String
Show)

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

instance (Applicative f, Traversable f) => Static (Record f) where
   static :: Record f
static =
      f Element -> Record f
forall (f :: * -> *). f Element -> Record f
Record (f Element -> Record f) -> f Element -> Record f
forall a b. (a -> b) -> a -> b
$ (State Int (f Element) -> Int -> f Element)
-> Int -> State Int (f Element) -> f Element
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int (f Element) -> Int -> f Element
forall s a. State s a -> s -> a
MS.evalState Int
0 (State Int (f Element) -> f Element)
-> State Int (f Element) -> f Element
forall a b. (a -> b) -> a -> b
$ f (StateT Int Identity Element) -> State Int (f Element)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => f (m a) -> m (f a)
Trav.sequence (f (StateT Int Identity Element) -> State Int (f Element))
-> f (StateT Int Identity Element) -> State Int (f Element)
forall a b. (a -> b) -> a -> b
$
      StateT Int Identity Element -> f (StateT Int Identity Element)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> Element) -> State Int Int -> StateT Int Identity Element
forall a b.
(a -> b) -> StateT Int Identity a -> StateT Int Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Element
Element State Int 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) = (Int -> Index (Record f)) -> [Int] -> [Index (Record f)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FieldIndex f
Int -> Index (Record f)
forall (f :: * -> *). Int -> FieldIndex f
FieldIndex ([Int] -> [Index (Record f)]) -> [Int] -> [Index (Record f)]
forall a b. (a -> b) -> a -> b
$ [Element] -> [Int] -> [Int]
forall b a. [b] -> [a] -> [a]
Match.take (f Element -> [Element]
forall a. f a -> [a]
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) = Int -> Result check Int
forall a. a -> Result check a
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) = (Element -> FieldIndex f) -> f Element -> f (FieldIndex f)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Element Int
k) -> Int -> FieldIndex f
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
(Constructed tag -> Constructed tag -> Bool)
-> (Constructed tag -> Constructed tag -> Bool)
-> Eq (Constructed tag)
forall tag. Constructed tag -> Constructed tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tag. Constructed tag -> Constructed tag -> Bool
== :: Constructed tag -> Constructed tag -> Bool
$c/= :: forall tag. Constructed tag -> Constructed tag -> Bool
/= :: Constructed tag -> Constructed tag -> Bool
Eq, Int -> Constructed tag -> String -> String
[Constructed tag] -> String -> String
Constructed tag -> String
(Int -> Constructed tag -> String -> String)
-> (Constructed tag -> String)
-> ([Constructed tag] -> String -> String)
-> Show (Constructed tag)
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
$cshowsPrec :: forall tag. Int -> Constructed tag -> String -> String
showsPrec :: Int -> Constructed tag -> String -> String
$cshow :: forall tag. Constructed tag -> String
show :: Constructed tag -> String
$cshowList :: forall tag. [Constructed tag] -> String -> String
showList :: [Constructed tag] -> String -> String
Show)

newtype ConsIndex tag = ConsIndex Int
   deriving (ConsIndex tag -> ConsIndex tag -> Bool
(ConsIndex tag -> ConsIndex tag -> Bool)
-> (ConsIndex tag -> ConsIndex tag -> Bool) -> Eq (ConsIndex tag)
forall tag. ConsIndex tag -> ConsIndex tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tag. ConsIndex tag -> ConsIndex tag -> Bool
== :: ConsIndex tag -> ConsIndex tag -> Bool
$c/= :: forall tag. ConsIndex tag -> ConsIndex tag -> Bool
/= :: ConsIndex tag -> ConsIndex tag -> Bool
Eq, Int -> ConsIndex tag -> String -> String
[ConsIndex tag] -> String -> String
ConsIndex tag -> String
(Int -> ConsIndex tag -> String -> String)
-> (ConsIndex tag -> String)
-> ([ConsIndex tag] -> String -> String)
-> Show (ConsIndex tag)
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
$cshowsPrec :: forall tag. Int -> ConsIndex tag -> String -> String
showsPrec :: Int -> ConsIndex tag -> String -> String
$cshow :: forall tag. ConsIndex tag -> String
show :: ConsIndex tag -> String
$cshowList :: forall tag. [ConsIndex tag] -> String -> String
showList :: [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) = State Int b -> Construction tag b
forall tag a. State Int a -> Construction tag a
Construction (State Int b -> Construction tag b)
-> State Int b -> Construction tag b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> State Int a -> State Int b
forall a b.
(a -> b) -> StateT Int Identity a -> StateT Int Identity 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 = State Int a -> Construction tag a
forall tag a. State Int a -> Construction tag a
Construction (State Int a -> Construction tag a)
-> (a -> State Int a) -> a -> Construction tag a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State Int a
forall a. a -> StateT Int Identity a
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 = State Int b -> Construction tag b
forall tag a. State Int a -> Construction tag a
Construction (State Int b -> Construction tag b)
-> State Int b -> Construction tag b
forall a b. (a -> b) -> a -> b
$ State Int (a -> b)
fState Int (a -> b) -> State Int a -> State Int b
forall a b.
StateT Int Identity (a -> b)
-> StateT Int Identity a -> StateT Int Identity b
forall (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 = a -> Construction tag a
forall a. a -> Construction tag a
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  =
      State Int b -> Construction tag b
forall tag a. State Int a -> Construction tag a
Construction (State Int b -> Construction tag b)
-> State Int b -> Construction tag b
forall a b. (a -> b) -> a -> b
$ State Int a
am State Int a -> (a -> State Int b) -> State Int b
forall a b.
StateT Int Identity a
-> (a -> StateT Int Identity b) -> StateT Int Identity b
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 State Int b
bm -> State Int 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 State Int a -> Int -> (a, Int)
forall s a. State s a -> s -> (a, s)
MS.runState State Int a
m Int
0 of (a
a, Int
sz) -> (Int -> Constructed tag
forall tag. Int -> Constructed tag
Constructed Int
sz, a
a)

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


instance C (Constructed tag) where
   size :: Constructed tag -> Int
size = Constructed tag -> Int
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) = (Int -> Index (Constructed tag))
-> [Int] -> [Index (Constructed tag)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ConsIndex tag
Int -> Index (Constructed tag)
forall tag. Int -> ConsIndex tag
ConsIndex ([Int] -> [Index (Constructed tag)])
-> [Int] -> [Index (Constructed tag)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
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 = ZeroBased Int -> Index (ZeroBased Int) -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
forall check.
Checking check =>
ZeroBased Int -> Index (ZeroBased Int) -> Result check Int
unifiedOffset (Int -> ZeroBased Int
forall n. n -> ZeroBased n
ZeroBased Int
len) in \(ConsIndex Int
k) -> Index (ZeroBased Int) -> Result check Int
f Int
Index (ZeroBased Int)
k
   inBounds :: Constructed tag -> Index (Constructed tag) -> Bool
inBounds (Constructed Int
len) (ConsIndex Int
ix) = ZeroBased Int -> Index (ZeroBased Int) -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (Int -> ZeroBased Int
forall n. n -> ZeroBased n
ZeroBased Int
len) Int
Index (ZeroBased Int)
ix

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