{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE GADTs #-}
module Data.Array.Comfort.Shape (
C(..),
Indexed(..),
InvIndexed(..), messageIndexFromOffset, assertIndexFromOffset,
Static(..),
Pattern(..),
requireCheck,
CheckSingleton(..),
Checking(..),
Result(..),
runChecked,
runUnchecked,
assert,
throwOrError,
Zero(Zero),
ZeroBased(..), zeroBasedSplit,
OneBased(..),
Range(..),
Shifted(..),
Enumeration(..),
Deferred(..), DeferredIndex(..), deferIndex, revealIndex,
(::+)(..),
Square(..),
Cube(..),
Triangular(..), Lower(Lower), Upper(Upper),
LowerTriangular, UpperTriangular,
lowerTriangular, upperTriangular,
triangleSize, triangleRoot,
Simplex(..),
SimplexAscending, simplexAscending,
SimplexDescending, simplexDescending,
Ascending,
Descending,
SimplexOrder(..),
SimplexOrderC,
AllDistinct(..),
SomeRepetitive(..),
Collision(..),
CollisionC,
Cyclic(..),
NestedTuple(..),
AccessorTuple(..),
StaticTuple(..),
Element(..),
TupleAccessor,
TupleIndex,
ElementIndex,
ElementTuple(..),
indexTupleFromShape,
Record(..),
FieldIndex,
indexRecordFromShape,
Constructed,
ConsIndex,
Construction,
construct,
consIndex,
) where
import qualified Data.Array.Comfort.Shape.Set as ShapeSet
import Data.Array.Comfort.Shape.Utility (messageIndexFromOffset, isRight)
import qualified Foreign.Storable.Newtype as Store
import Foreign.Storable
(Storable, sizeOf, alignment, poke, peek, pokeElemOff, peekElemOff)
import Foreign.Ptr (Ptr, castPtr)
import qualified GHC.Arr as Ix
import qualified Control.Monad.Trans.Writer as MW
import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.HT as Monad
import qualified Control.Applicative.HT as App
import qualified Control.Applicative.Backwards as Back
import Control.DeepSeq (NFData, rnf)
import Control.Monad (liftM)
import Control.Applicative (Applicative, pure, (<*>), (<$>))
import Control.Applicative (Const(Const, getConst))
import Control.Functor.HT (void)
import qualified Data.Functor.Classes as FunctorC
import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.NonEmpty as NonEmpty
import qualified Data.List.Match as Match
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Traversable (Traversable)
import Data.Foldable (Foldable)
import Data.Functor.Identity (Identity(Identity), runIdentity)
import Data.Monoid (Sum(Sum, getSum))
import Data.Function.HT (compose2)
import Data.Tagged (Tagged(Tagged, unTagged))
import Data.Complex (Complex((:+)), realPart, imagPart)
import Data.Map (Map)
import Data.Set (Set)
import Data.List.HT (tails)
import Data.Tuple.HT (mapFst, mapSnd, swap, fst3, snd3, thd3)
import Data.Eq.HT (equating)
import Text.Printf (printf)
data Checked
data Unchecked
class Checking check where
data Result check a
switchCheck :: f Checked -> f Unchecked -> f check
data CheckSingleton check where
Checked :: CheckSingleton Checked
Unchecked :: CheckSingleton Unchecked
autoCheck :: (Checking check) => CheckSingleton check
autoCheck :: forall check. Checking check => CheckSingleton check
autoCheck = forall check (f :: * -> *).
Checking check =>
f Checked -> f Unchecked -> f check
switchCheck CheckSingleton Checked
Checked CheckSingleton Unchecked
Unchecked
checkFromResult :: (Checking check) => Result check a -> CheckSingleton check
checkFromResult :: forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
_ = forall check. Checking check => CheckSingleton check
autoCheck
withCheck ::
(Checking check) =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck :: forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck CheckSingleton check -> Result check a
f = CheckSingleton check -> Result check a
f forall check. Checking check => CheckSingleton check
autoCheck
requireCheck :: CheckSingleton check -> Result check a -> Result check a
requireCheck :: forall check a.
CheckSingleton check -> Result check a -> Result check a
requireCheck CheckSingleton check
_ = forall a. a -> a
id
instance Checking Checked where
newtype Result Checked a = CheckedResult {forall a. Result Checked a -> Either String a
getChecked :: Either String a}
switchCheck :: forall (f :: * -> *). f Checked -> f Unchecked -> f Checked
switchCheck f Checked
f f Unchecked
_ = f Checked
f
runChecked :: String -> Result Checked a -> a
runChecked :: forall a. String -> Result Checked a -> a
runChecked String
name (CheckedResult Either String a
m) =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
"Shape." forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
": ") forall a. [a] -> [a] -> [a]
++)) forall a. a -> a
id Either String a
m
instance Checking Unchecked where
newtype Result Unchecked a = UncheckedResult {forall a. Result Unchecked a -> a
getUnchecked :: a}
switchCheck :: forall (f :: * -> *). f Checked -> f Unchecked -> f Unchecked
switchCheck f Checked
_ f Unchecked
f = f Unchecked
f
runUnchecked :: Result Unchecked a -> a
runUnchecked :: forall a. Result Unchecked a -> a
runUnchecked = forall a. Result Unchecked a -> a
getUnchecked
throw :: String -> Result Checked a
throw :: forall a. String -> Result Checked a
throw = forall a. Either String a -> Result Checked a
CheckedResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
throwOrError :: (Checking check) => String -> Result check a
throwOrError :: forall check a. Checking check => String -> Result check a
throwOrError String
msg = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
case CheckSingleton check
check of
CheckSingleton check
Checked -> forall a. String -> Result Checked a
throw String
msg
CheckSingleton check
Unchecked -> forall a. HasCallStack => String -> a
error String
msg
assert :: (Checking check) => String -> Bool -> Result check ()
assert :: forall check. Checking check => String -> Bool -> Result check ()
assert String
msg Bool
cond = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
case CheckSingleton check
check of
CheckSingleton check
Unchecked -> forall a. a -> Result Unchecked a
UncheckedResult ()
CheckSingleton check
Checked -> if Bool
cond then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else forall a. String -> Result Checked a
throw String
msg
instance (Checking check, Eq a) => Eq (Result check a) where
Result check a
a0 == :: Result check a -> Result check a -> Bool
== Result check a
b0 =
case (forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a0, Result check a
a0, Result check a
b0) of
(CheckSingleton check
Checked, CheckedResult Either String a
a, CheckedResult Either String a
b) -> Either String a
aforall a. Eq a => a -> a -> Bool
==Either String a
b
(CheckSingleton check
Unchecked, UncheckedResult a
a, UncheckedResult a
b) -> a
aforall a. Eq a => a -> a -> Bool
==a
b
instance (Checking check) => Functor (Result check) where
fmap :: forall a b. (a -> b) -> Result check a -> Result check b
fmap a -> b
f Result check a
m =
case (forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
m, Result check a
m) of
(CheckSingleton check
Checked, CheckedResult Either String a
e) -> forall a. Either String a -> Result Checked a
CheckedResult forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either String a
e
(CheckSingleton check
Unchecked, UncheckedResult a
a) -> forall a. a -> Result Unchecked a
UncheckedResult forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
instance (Checking check) => Applicative (Result check) where
pure :: forall a. a -> Result check a
pure a
a = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
case CheckSingleton check
check of
CheckSingleton check
Checked -> forall a. Either String a -> Result Checked a
CheckedResult forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
a
CheckSingleton check
Unchecked -> forall a. a -> Result Unchecked a
UncheckedResult a
a
Result check (a -> b)
f<*> :: forall a b.
Result check (a -> b) -> Result check a -> Result check b
<*>Result check a
a =
case (forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a, Result check (a -> b)
f, Result check a
a) of
(CheckSingleton check
Checked, CheckedResult Either String (a -> b)
ff, CheckedResult Either String a
fa) ->
forall a. Either String a -> Result Checked a
CheckedResult forall a b. (a -> b) -> a -> b
$ Either String (a -> b)
ffforall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>Either String a
fa
(CheckSingleton check
Unchecked, UncheckedResult a -> b
xf, UncheckedResult a
xa) ->
forall a. a -> Result Unchecked a
UncheckedResult forall a b. (a -> b) -> a -> b
$ a -> b
xf a
xa
instance (Checking check) => Monad (Result check) where
return :: forall a. a -> Result check a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Result check a
a >>= :: forall a b.
Result check a -> (a -> Result check b) -> Result check b
>>= a -> Result check b
b =
case (forall check a.
Checking check =>
Result check a -> CheckSingleton check
checkFromResult Result check a
a, Result check a
a) of
(CheckSingleton check
Checked, CheckedResult Either String a
e) -> forall a. Either String a -> Result Checked a
CheckedResult forall a b. (a -> b) -> a -> b
$ forall a. Result Checked a -> Either String a
getChecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result check b
b forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String a
e
(CheckSingleton check
Unchecked, UncheckedResult a
x) -> a -> Result check b
b a
x
class C sh where
size :: sh -> Int
class C sh => Indexed sh where
{-# MINIMAL indices, (unifiedOffset|unifiedSizeOffset) #-}
type Index sh
indices :: sh -> [Index sh]
offset :: sh -> Index sh -> Int
offset sh
sh = forall a. String -> Result Checked a -> a
runChecked String
"offset" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh
uncheckedOffset :: sh -> Index sh -> Int
uncheckedOffset sh
sh = forall a. Result Unchecked a -> a
getUnchecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh
unifiedOffset :: (Checking check) => sh -> Index sh -> Result check Int
unifiedOffset sh
sh = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
inBounds :: sh -> Index sh -> Bool
inBounds sh
sh = forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Result Checked a -> Either String a
getChecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh
sizeOffset :: sh -> (Int, Index sh -> Int)
sizeOffset sh
sh = (forall sh. C sh => sh -> Int
size sh
sh, forall sh. Indexed sh => sh -> Index sh -> Int
offset sh
sh)
uncheckedSizeOffset :: sh -> (Int, Index sh -> Int)
uncheckedSizeOffset sh
sh = (forall sh. C sh => sh -> Int
size sh
sh, forall sh. Indexed sh => sh -> Index sh -> Int
uncheckedOffset sh
sh)
unifiedSizeOffset ::
(Checking check) => sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh = (forall sh. C sh => sh -> Int
size sh
sh, forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh)
class Indexed sh => InvIndexed sh where
{-# MINIMAL unifiedIndexFromOffset #-}
indexFromOffset :: sh -> Int -> Index sh
indexFromOffset sh
sh = forall a. String -> Result Checked a -> a
runChecked String
"indexFromOffset" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh
uncheckedIndexFromOffset :: sh -> Int -> Index sh
uncheckedIndexFromOffset sh
sh = forall a. Result Unchecked a -> a
getUnchecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh
unifiedIndexFromOffset ::
(Checking check) => sh -> Int -> Result check (Index sh)
assertIndexFromOffset ::
(Checking check) => String -> Int -> Bool -> Result check ()
assertIndexFromOffset :: forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
name Int
k Bool
cond = forall check. Checking check => String -> Bool -> Result check ()
assert (String -> Int -> String
messageIndexFromOffset String
name Int
k) Bool
cond
class (C sh, Eq sh) => Static sh where
static :: sh
class (Indexed sh) => Pattern sh where
type DataPattern sh x
indexPattern :: (Index sh -> x) -> sh -> DataPattern sh x
data Zero = Zero
deriving (Zero -> Zero -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Zero -> Zero -> Bool
$c/= :: Zero -> Zero -> Bool
== :: Zero -> Zero -> Bool
$c== :: Zero -> Zero -> Bool
Eq, Eq Zero
Zero -> Zero -> Bool
Zero -> Zero -> Ordering
Zero -> Zero -> Zero
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Zero -> Zero -> Zero
$cmin :: Zero -> Zero -> Zero
max :: Zero -> Zero -> Zero
$cmax :: Zero -> Zero -> Zero
>= :: Zero -> Zero -> Bool
$c>= :: Zero -> Zero -> Bool
> :: Zero -> Zero -> Bool
$c> :: Zero -> Zero -> Bool
<= :: Zero -> Zero -> Bool
$c<= :: Zero -> Zero -> Bool
< :: Zero -> Zero -> Bool
$c< :: Zero -> Zero -> Bool
compare :: Zero -> Zero -> Ordering
$ccompare :: Zero -> Zero -> Ordering
Ord, Int -> Zero -> String -> String
[Zero] -> String -> String
Zero -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Zero] -> String -> String
$cshowList :: [Zero] -> String -> String
show :: Zero -> String
$cshow :: Zero -> String
showsPrec :: Int -> Zero -> String -> String
$cshowsPrec :: Int -> Zero -> String -> String
Show)
instance C Zero where
size :: Zero -> Int
size Zero
Zero = Int
0
instance Static Zero where
static :: Zero
static = Zero
Zero
instance C () where
size :: () -> Int
size () = Int
1
instance Indexed () where
type Index () = ()
indices :: () -> [Index ()]
indices () = [()]
unifiedOffset :: forall check. Checking check => () -> Index () -> Result check Int
unifiedOffset () () = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
inBounds :: () -> Index () -> Bool
inBounds () () = Bool
True
instance InvIndexed () where
unifiedIndexFromOffset :: forall check.
Checking check =>
() -> Int -> Result check (Index ())
unifiedIndexFromOffset () Int
k = forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"()" Int
k (Int
kforall a. Eq a => a -> a -> Bool
==Int
0)
instance Static () where
static :: ()
static = ()
instance Pattern () where
type DataPattern () x = x
indexPattern :: forall x. (Index () -> x) -> () -> DataPattern () x
indexPattern Index () -> x
extend = Index () -> x
extend
newtype ZeroBased n = ZeroBased {forall n. ZeroBased n -> n
zeroBasedSize :: n}
deriving (ZeroBased n -> ZeroBased n -> Bool
forall n. Eq n => ZeroBased n -> ZeroBased n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZeroBased n -> ZeroBased n -> Bool
$c/= :: forall n. Eq n => ZeroBased n -> ZeroBased n -> Bool
== :: ZeroBased n -> ZeroBased n -> Bool
$c== :: forall n. Eq n => ZeroBased n -> ZeroBased n -> Bool
Eq, Int -> ZeroBased n -> String -> String
forall n. Show n => Int -> ZeroBased n -> String -> String
forall n. Show n => [ZeroBased n] -> String -> String
forall n. Show n => ZeroBased n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ZeroBased n] -> String -> String
$cshowList :: forall n. Show n => [ZeroBased n] -> String -> String
show :: ZeroBased n -> String
$cshow :: forall n. Show n => ZeroBased n -> String
showsPrec :: Int -> ZeroBased n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> ZeroBased n -> String -> String
Show)
instance Functor ZeroBased where
fmap :: forall a b. (a -> b) -> ZeroBased a -> ZeroBased b
fmap a -> b
f (ZeroBased a
n) = forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ a -> b
f a
n
instance Applicative ZeroBased where
pure :: forall n. n -> ZeroBased n
pure = forall n. n -> ZeroBased n
ZeroBased
ZeroBased a -> b
f <*> :: forall a b. ZeroBased (a -> b) -> ZeroBased a -> ZeroBased b
<*> ZeroBased a
n = forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ a -> b
f a
n
instance (NFData n) => NFData (ZeroBased n) where
rnf :: ZeroBased n -> ()
rnf (ZeroBased n
n) = forall a. NFData a => a -> ()
rnf n
n
instance (Storable n) => Storable (ZeroBased n) where
sizeOf :: ZeroBased n -> Int
sizeOf = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf forall n. ZeroBased n -> n
zeroBasedSize
alignment :: ZeroBased n -> Int
alignment = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment forall n. ZeroBased n -> n
zeroBasedSize
peek :: Ptr (ZeroBased n) -> IO (ZeroBased n)
peek = forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek forall n. n -> ZeroBased n
ZeroBased
poke :: Ptr (ZeroBased n) -> ZeroBased n -> IO ()
poke = forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke forall n. ZeroBased n -> n
zeroBasedSize
instance (Integral n) => C (ZeroBased n) where
size :: ZeroBased n -> Int
size (ZeroBased n
len) = forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len
instance (Integral n) => Indexed (ZeroBased n) where
type Index (ZeroBased n) = n
indices :: ZeroBased n -> [Index (ZeroBased n)]
indices (ZeroBased n
len) = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<n
len) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+n
1) n
0
unifiedOffset :: forall check.
Checking check =>
ZeroBased n -> Index (ZeroBased n) -> Result check Int
unifiedOffset (ZeroBased n
len) = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset forall a b. (a -> b) -> a -> b
$ forall n. n -> n -> Shifted n
Shifted n
0 n
len
inBounds :: ZeroBased n -> Index (ZeroBased n) -> Bool
inBounds (ZeroBased n
len) Index (ZeroBased n)
ix = n
0forall a. Ord a => a -> a -> Bool
<=Index (ZeroBased n)
ix Bool -> Bool -> Bool
&& Index (ZeroBased n)
ixforall a. Ord a => a -> a -> Bool
<n
len
instance (Integral n) => InvIndexed (ZeroBased n) where
unifiedIndexFromOffset :: forall check.
Checking check =>
ZeroBased n -> Int -> Result check (Index (ZeroBased n))
unifiedIndexFromOffset (ZeroBased n
len) Int
k0 = do
let k :: n
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"ZeroBased" Int
k0 forall a b. (a -> b) -> a -> b
$ n
0forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kforall a. Ord a => a -> a -> Bool
<n
len
forall (f :: * -> *) a. Applicative f => a -> f a
pure n
k
zeroBasedSplit :: (Real n) => n -> ZeroBased n -> ZeroBased n ::+ ZeroBased n
zeroBasedSplit :: forall n. Real n => n -> ZeroBased n -> ZeroBased n ::+ ZeroBased n
zeroBasedSplit n
n (ZeroBased n
m) =
if n
nforall a. Ord a => a -> a -> Bool
<n
0
then forall a. HasCallStack => String -> a
error String
"Shape.zeroBasedSplit: negative number of elements"
else let k :: n
k = forall a. Ord a => a -> a -> a
min n
n n
m in forall n. n -> ZeroBased n
ZeroBased n
k forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ forall n. n -> ZeroBased n
ZeroBased (n
mforall a. Num a => a -> a -> a
-n
k)
instance (Integral n) => Pattern (ZeroBased n) where
type DataPattern (ZeroBased n) x = n -> x
indexPattern :: forall x.
(Index (ZeroBased n) -> x)
-> ZeroBased n -> DataPattern (ZeroBased n) x
indexPattern Index (ZeroBased n) -> x
extend (ZeroBased n
_n) = Index (ZeroBased n) -> x
extend
newtype OneBased n = OneBased {forall n. OneBased n -> n
oneBasedSize :: n}
deriving (OneBased n -> OneBased n -> Bool
forall n. Eq n => OneBased n -> OneBased n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OneBased n -> OneBased n -> Bool
$c/= :: forall n. Eq n => OneBased n -> OneBased n -> Bool
== :: OneBased n -> OneBased n -> Bool
$c== :: forall n. Eq n => OneBased n -> OneBased n -> Bool
Eq, Int -> OneBased n -> String -> String
forall n. Show n => Int -> OneBased n -> String -> String
forall n. Show n => [OneBased n] -> String -> String
forall n. Show n => OneBased n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OneBased n] -> String -> String
$cshowList :: forall n. Show n => [OneBased n] -> String -> String
show :: OneBased n -> String
$cshow :: forall n. Show n => OneBased n -> String
showsPrec :: Int -> OneBased n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> OneBased n -> String -> String
Show)
instance Functor OneBased where
fmap :: forall a b. (a -> b) -> OneBased a -> OneBased b
fmap a -> b
f (OneBased a
n) = forall n. n -> OneBased n
OneBased forall a b. (a -> b) -> a -> b
$ a -> b
f a
n
instance Applicative OneBased where
pure :: forall n. n -> OneBased n
pure = forall n. n -> OneBased n
OneBased
OneBased a -> b
f <*> :: forall a b. OneBased (a -> b) -> OneBased a -> OneBased b
<*> OneBased a
n = forall n. n -> OneBased n
OneBased forall a b. (a -> b) -> a -> b
$ a -> b
f a
n
instance (NFData n) => NFData (OneBased n) where
rnf :: OneBased n -> ()
rnf (OneBased n
n) = forall a. NFData a => a -> ()
rnf n
n
instance (Storable n) => Storable (OneBased n) where
sizeOf :: OneBased n -> Int
sizeOf = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf forall n. OneBased n -> n
oneBasedSize
alignment :: OneBased n -> Int
alignment = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment forall n. OneBased n -> n
oneBasedSize
peek :: Ptr (OneBased n) -> IO (OneBased n)
peek = forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek forall n. n -> OneBased n
OneBased
poke :: Ptr (OneBased n) -> OneBased n -> IO ()
poke = forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke forall n. OneBased n -> n
oneBasedSize
instance (Integral n) => C (OneBased n) where
size :: OneBased n -> Int
size (OneBased n
len) = forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len
instance (Integral n) => Indexed (OneBased n) where
type Index (OneBased n) = n
indices :: OneBased n -> [Index (OneBased n)]
indices (OneBased n
len) = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<=n
len) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+n
1) n
1
unifiedOffset :: forall check.
Checking check =>
OneBased n -> Index (OneBased n) -> Result check Int
unifiedOffset (OneBased n
len) = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset forall a b. (a -> b) -> a -> b
$ forall n. n -> n -> Shifted n
Shifted n
1 n
len
inBounds :: OneBased n -> Index (OneBased n) -> Bool
inBounds (OneBased n
len) Index (OneBased n)
ix = n
0forall a. Ord a => a -> a -> Bool
<Index (OneBased n)
ix Bool -> Bool -> Bool
&& Index (OneBased n)
ixforall a. Ord a => a -> a -> Bool
<=n
len
instance (Integral n) => InvIndexed (OneBased n) where
unifiedIndexFromOffset :: forall check.
Checking check =>
OneBased n -> Int -> Result check (Index (OneBased n))
unifiedIndexFromOffset (OneBased n
len) Int
k0 = do
let k :: n
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"OneBased" Int
k0 forall a b. (a -> b) -> a -> b
$ n
0forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kforall a. Ord a => a -> a -> Bool
<n
len
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ n
1forall a. Num a => a -> a -> a
+n
k
data Range n = Range {forall n. Range n -> n
rangeFrom, forall n. Range n -> n
rangeTo :: n}
deriving (Range n -> Range n -> Bool
forall n. Eq n => Range n -> Range n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range n -> Range n -> Bool
$c/= :: forall n. Eq n => Range n -> Range n -> Bool
== :: Range n -> Range n -> Bool
$c== :: forall n. Eq n => Range n -> Range n -> Bool
Eq, Int -> Range n -> String -> String
forall n. Show n => Int -> Range n -> String -> String
forall n. Show n => [Range n] -> String -> String
forall n. Show n => Range n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Range n] -> String -> String
$cshowList :: forall n. Show n => [Range n] -> String -> String
show :: Range n -> String
$cshow :: forall n. Show n => Range n -> String
showsPrec :: Int -> Range n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> Range n -> String -> String
Show)
instance Functor Range where
fmap :: forall a b. (a -> b) -> Range a -> Range b
fmap a -> b
f (Range a
from a
to) = forall n. n -> n -> Range n
Range (a -> b
f a
from) (a -> b
f a
to)
instance (NFData n) => NFData (Range n) where
rnf :: Range n -> ()
rnf (Range n
from n
to) = forall a. NFData a => a -> ()
rnf (n
from,n
to)
instance (Ix.Ix n) => C (Range n) where
size :: Range n -> Int
size (Range n
from n
to) = forall a. Ix a => (a, a) -> Int
Ix.rangeSize (n
from,n
to)
instance (Ix.Ix n) => Indexed (Range n) where
type Index (Range n) = n
indices :: Range n -> [Index (Range n)]
indices (Range n
from n
to) = forall a. Ix a => (a, a) -> [a]
Ix.range (n
from,n
to)
offset :: Range n -> Index (Range n) -> Int
offset (Range n
from n
to) Index (Range n)
ix = forall a. Ix a => (a, a) -> a -> Int
Ix.index (n
from,n
to) Index (Range n)
ix
uncheckedOffset :: Range n -> Index (Range n) -> Int
uncheckedOffset (Range n
from n
to) Index (Range n)
ix = forall a. Ix a => (a, a) -> a -> Int
Ix.unsafeIndex (n
from,n
to) Index (Range n)
ix
unifiedOffset :: forall check.
Checking check =>
Range n -> Index (Range n) -> Result check Int
unifiedOffset (Range n
from n
to) Index (Range n)
ix = do
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Range: index out of range" forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (n
from,n
to) Index (Range n)
ix
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> a -> Int
Ix.unsafeIndex (n
from,n
to) Index (Range n)
ix
inBounds :: Range n -> Index (Range n) -> Bool
inBounds (Range n
from n
to) Index (Range n)
ix = forall a. Ix a => (a, a) -> a -> Bool
Ix.inRange (n
from,n
to) Index (Range n)
ix
instance (Ix.Ix n) => InvIndexed (Range n) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Range n -> Int -> Result check (Index (Range n))
unifiedIndexFromOffset (Range n
from n
to) Int
k = do
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Range" Int
k forall a b. (a -> b) -> a -> b
$ Int
0forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
k forall a. Ord a => a -> a -> Bool
< forall a. Ix a => (a, a) -> Int
Ix.rangeSize (n
from,n
to)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> [a]
Ix.range (n
from,n
to) forall a. [a] -> Int -> a
!! Int
k
instance Storable n => Storable (Range n) where
{-# INLINE sizeOf #-}
{-# INLINE alignment #-}
{-# INLINE peek #-}
{-# INLINE poke #-}
sizeOf :: Range n -> Int
sizeOf ~(Range n
l n
r) = forall a. Storable a => a -> Int
sizeOf n
l forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod (- forall a. Storable a => a -> Int
sizeOf n
l) (forall a. Storable a => a -> Int
alignment n
r) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf n
r
alignment :: Range n -> Int
alignment ~(Range n
l n
_) = forall a. Storable a => a -> Int
alignment n
l
poke :: Ptr (Range n) -> Range n -> IO ()
poke Ptr (Range n)
p (Range n
l n
r) =
let q :: Ptr n
q = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Range n)
p
in forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr n
q n
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr n
q Int
1 n
r
peek :: Ptr (Range n) -> IO (Range n)
peek Ptr (Range n)
p =
let q :: Ptr n
q = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Range n)
p
in forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 forall n. n -> n -> Range n
Range (forall a. Storable a => Ptr a -> IO a
peek Ptr n
q) (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr n
q Int
1)
data Shifted n = Shifted {forall n. Shifted n -> n
shiftedOffset, forall n. Shifted n -> n
shiftedSize :: n}
deriving (Shifted n -> Shifted n -> Bool
forall n. Eq n => Shifted n -> Shifted n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shifted n -> Shifted n -> Bool
$c/= :: forall n. Eq n => Shifted n -> Shifted n -> Bool
== :: Shifted n -> Shifted n -> Bool
$c== :: forall n. Eq n => Shifted n -> Shifted n -> Bool
Eq, Int -> Shifted n -> String -> String
forall n. Show n => Int -> Shifted n -> String -> String
forall n. Show n => [Shifted n] -> String -> String
forall n. Show n => Shifted n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Shifted n] -> String -> String
$cshowList :: forall n. Show n => [Shifted n] -> String -> String
show :: Shifted n -> String
$cshow :: forall n. Show n => Shifted n -> String
showsPrec :: Int -> Shifted n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> Shifted n -> String -> String
Show)
instance Functor Shifted where
fmap :: forall a b. (a -> b) -> Shifted a -> Shifted b
fmap a -> b
f (Shifted a
from a
to) = forall n. n -> n -> Shifted n
Shifted (a -> b
f a
from) (a -> b
f a
to)
instance (NFData n) => NFData (Shifted n) where
rnf :: Shifted n -> ()
rnf (Shifted n
from n
to) = forall a. NFData a => a -> ()
rnf (n
from,n
to)
instance (Integral n) => C (Shifted n) where
size :: Shifted n -> Int
size (Shifted n
_offs n
len) = forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len
instance (Integral n) => Indexed (Shifted n) where
type Index (Shifted n) = n
indices :: Shifted n -> [Index (Shifted n)]
indices (Shifted n
offs n
len) =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
>n
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> [b] -> [(a, b)]
zip
(forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
subtract n
1) n
len)
(forall a. (a -> a) -> a -> [a]
iterate (n
1forall a. Num a => a -> a -> a
+) n
offs)
unifiedOffset :: forall check.
Checking check =>
Shifted n -> Index (Shifted n) -> Result check Int
unifiedOffset (Shifted n
offs n
len) Index (Shifted n)
ix = do
forall check. Checking check => String -> Bool -> Result check ()
assert (forall r. PrintfType r => String -> r
printf String
"Shape.Shifted: array index too small (%d vs %d)" (forall a. Integral a => a -> Integer
toInteger n
offs) (forall a. Integral a => a -> Integer
toInteger Index (Shifted n)
ix)) forall a b. (a -> b) -> a -> b
$ Index (Shifted n)
ixforall a. Ord a => a -> a -> Bool
>=n
offs
let k :: n
k = Index (Shifted n)
ixforall a. Num a => a -> a -> a
-n
offs
forall check. Checking check => String -> Bool -> Result check ()
assert (forall r. PrintfType r => String -> r
printf String
"Shape.Shifted: array index too big (%d vs %d)" (forall a. Integral a => a -> Integer
toInteger n
k) (forall a. Integral a => a -> Integer
toInteger n
len)) forall a b. (a -> b) -> a -> b
$ n
kforall a. Ord a => a -> a -> Bool
<n
len
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral n
k
inBounds :: Shifted n -> Index (Shifted n) -> Bool
inBounds (Shifted n
offs n
len) Index (Shifted n)
ix = n
offs forall a. Ord a => a -> a -> Bool
<= Index (Shifted n)
ix Bool -> Bool -> Bool
&& Index (Shifted n)
ix forall a. Ord a => a -> a -> Bool
< n
offsforall a. Num a => a -> a -> a
+n
len
instance (Integral n) => InvIndexed (Shifted n) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Shifted n -> Int -> Result check (Index (Shifted n))
unifiedIndexFromOffset (Shifted n
offs n
len) Int
k0 = do
let k :: n
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Shifted" Int
k0 forall a b. (a -> b) -> a -> b
$ n
0forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kforall a. Ord a => a -> a -> Bool
<n
len
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ n
offsforall a. Num a => a -> a -> a
+n
k
instance Storable n => Storable (Shifted n) where
{-# INLINE sizeOf #-}
{-# INLINE alignment #-}
{-# INLINE peek #-}
{-# INLINE poke #-}
sizeOf :: Shifted n -> Int
sizeOf ~(Shifted n
l n
n) = forall a. Storable a => a -> Int
sizeOf n
l forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod (- forall a. Storable a => a -> Int
sizeOf n
l) (forall a. Storable a => a -> Int
alignment n
n) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf n
n
alignment :: Shifted n -> Int
alignment ~(Shifted n
l n
_) = forall a. Storable a => a -> Int
alignment n
l
poke :: Ptr (Shifted n) -> Shifted n -> IO ()
poke Ptr (Shifted n)
p (Shifted n
l n
n) =
let q :: Ptr n
q = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Shifted n)
p
in forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr n
q n
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr n
q Int
1 n
n
peek :: Ptr (Shifted n) -> IO (Shifted n)
peek Ptr (Shifted n)
p =
let q :: Ptr n
q = forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr Ptr (Shifted n)
p
in forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 forall n. n -> n -> Shifted n
Shifted (forall a. Storable a => Ptr a -> IO a
peek Ptr n
q) (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr n
q Int
1)
{-# INLINE castToElemPtr #-}
castToElemPtr :: Ptr (f a) -> Ptr a
castToElemPtr :: forall (f :: * -> *) a. Ptr (f a) -> Ptr a
castToElemPtr = forall a b. Ptr a -> Ptr b
castPtr
data Enumeration n = Enumeration
deriving (Enumeration n -> Enumeration n -> Bool
forall n. Enumeration n -> Enumeration n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Enumeration n -> Enumeration n -> Bool
$c/= :: forall n. Enumeration n -> Enumeration n -> Bool
== :: Enumeration n -> Enumeration n -> Bool
$c== :: forall n. Enumeration n -> Enumeration n -> Bool
Eq, Int -> Enumeration n -> String -> String
forall n. Int -> Enumeration n -> String -> String
forall n. [Enumeration n] -> String -> String
forall n. Enumeration n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Enumeration n] -> String -> String
$cshowList :: forall n. [Enumeration n] -> String -> String
show :: Enumeration n -> String
$cshow :: forall n. Enumeration n -> String
showsPrec :: Int -> Enumeration n -> String -> String
$cshowsPrec :: forall n. Int -> Enumeration n -> String -> String
Show)
instance NFData (Enumeration n) where
rnf :: Enumeration n -> ()
rnf Enumeration n
Enumeration = ()
instance (Enum n, Bounded n) => C (Enumeration n) where
size :: Enumeration n -> Int
size Enumeration n
sh = forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
minBound forall a. Num a => a -> a -> a
+ Int
1
instance (Enum n, Bounded n) => Indexed (Enumeration n) where
type Index (Enumeration n) = n
indices :: Enumeration n -> [Index (Enumeration n)]
indices Enumeration n
sh = [forall n. Enumeration n -> n -> n
asEnumType Enumeration n
sh forall a. Bounded a => a
minBound .. forall n. Enumeration n -> n -> n
asEnumType Enumeration n
sh forall a. Bounded a => a
maxBound]
unifiedOffset :: forall check.
Checking check =>
Enumeration n -> Index (Enumeration n) -> Result check Int
unifiedOffset Enumeration n
sh Index (Enumeration n)
ix = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Index (Enumeration n)
ix forall a. Num a => a -> a -> a
- forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
minBound
inBounds :: Enumeration n -> Index (Enumeration n) -> Bool
inBounds Enumeration n
_sh Index (Enumeration n)
_ix = Bool
True
instance (Enum n, Bounded n) => InvIndexed (Enumeration n) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Enumeration n -> Int -> Result check (Index (Enumeration n))
unifiedIndexFromOffset Enumeration n
sh Int
k = do
let minBnd :: Int
minBnd = forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
minBound
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Enumeration" Int
k forall a b. (a -> b) -> a -> b
$
Int
0forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
k forall a. Ord a => a -> a -> Bool
<= forall n. Enum n => Enumeration n -> n -> Int
intFromEnum Enumeration n
sh forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- Int
minBnd
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int
minBnd forall a. Num a => a -> a -> a
+ Int
k
asEnumType :: Enumeration n -> n -> n
asEnumType :: forall n. Enumeration n -> n -> n
asEnumType Enumeration n
Enumeration = forall a. a -> a
id
intFromEnum :: (Enum n) => Enumeration n -> n -> Int
Enumeration n
Enumeration = forall a. Enum a => a -> Int
fromEnum
instance (Enum n, Bounded n) => Static (Enumeration n) where
static :: Enumeration n
static = forall n. Enumeration n
Enumeration
instance Storable (Enumeration n) where
{-# INLINE sizeOf #-}
{-# INLINE alignment #-}
{-# INLINE peek #-}
{-# INLINE poke #-}
sizeOf :: Enumeration n -> Int
sizeOf ~Enumeration n
Enumeration = Int
0
alignment :: Enumeration n -> Int
alignment ~Enumeration n
Enumeration = Int
1
poke :: Ptr (Enumeration n) -> Enumeration n -> IO ()
poke Ptr (Enumeration n)
_p Enumeration n
Enumeration = forall (m :: * -> *) a. Monad m => a -> m a
return ()
peek :: Ptr (Enumeration n) -> IO (Enumeration n)
peek Ptr (Enumeration n)
_p = forall (m :: * -> *) a. Monad m => a -> m a
return forall n. Enumeration n
Enumeration
instance (Ord n) => C (Set n) where
size :: Set n -> Int
size = forall a. Set a -> Int
Set.size
instance (Ord n) => Indexed (Set n) where
type Index (Set n) = n
indices :: Set n -> [Index (Set n)]
indices = forall a. Set a -> [a]
Set.toAscList
unifiedOffset :: forall check.
Checking check =>
Set n -> Index (Set n) -> Result check Int
unifiedOffset Set n
sh Index (Set n)
ix = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
case CheckSingleton check
check of
CheckSingleton check
Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> a -> Int
ShapeSet.uncheckedOffset Set n
sh Index (Set n)
ix
CheckSingleton check
Checked ->
case forall a. Ord a => Set a -> a -> Maybe Int
ShapeSet.offset Set n
sh Index (Set n)
ix of
Just Int
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
k
Maybe Int
Nothing ->
forall a. String -> Result Checked a
throw String
"Shape.Set: array index not member of the index set"
inBounds :: Set n -> Index (Set n) -> Bool
inBounds = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Bool
Set.member
instance (Ord n) => InvIndexed (Set n) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Set n -> Int -> Result check (Index (Set n))
unifiedIndexFromOffset Set n
sh Int
k = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
case CheckSingleton check
check of
CheckSingleton check
Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Int -> a
ShapeSet.uncheckedIndexFromOffset Set n
sh Int
k
CheckSingleton check
Checked ->
case forall a. Set a -> Int -> Maybe a
ShapeSet.indexFromOffset Set n
sh Int
k of
Just n
ix -> forall (f :: * -> *) a. Applicative f => a -> f a
pure n
ix
Maybe n
Nothing -> forall a. String -> Result Checked a
throw forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Set" Int
k
instance (Ord k, C shape) => C (Map k shape) where
size :: Map k shape -> Int
size = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall sh. C sh => sh -> Int
size
instance (Ord k, Indexed shape) => Indexed (Map k shape) where
type Index (Map k shape) = (k, Index shape)
indices :: Map k shape -> [Index (Map k shape)]
indices =
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Fold.fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\k
k shape
shape -> forall a b. (a -> b) -> [a] -> [b]
map ((,) k
k) forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> [Index sh]
indices shape
shape)
unifiedOffset :: forall check.
Checking check =>
Map k shape -> Index (Map k shape) -> Result check Int
unifiedOffset Map k shape
m =
let ms :: Map k (Int, Index shape -> Result check Int)
ms = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset Map k shape
m
mu :: Map k (Int, Index shape -> Result check Int)
mu = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
Trav.mapAccumL (\Int
l (Int
sz,Index shape -> Result check Int
getOffset) -> (Int
l forall a. Num a => a -> a -> a
+ Int
sz, (Int
l,Index shape -> Result check Int
getOffset))) Int
0 Map k (Int, Index shape -> Result check Int)
ms
in \(k
k,Index shape
ix) ->
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Int, Index shape -> Result check Int)
mu of
Maybe (Int, Index shape -> Result check Int)
Nothing -> forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.Map.offset: unknown key"
Just (Int
l,Index shape -> Result check Int
getOffset) -> (Int
lforall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index shape -> Result check Int
getOffset Index shape
ix
inBounds :: Map k shape -> Index (Map k shape) -> Bool
inBounds Map k shape
m (k
k,Index shape
ix) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Fold.any (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds Index shape
ix) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k shape
m
unifiedSizeOffset :: forall check.
Checking check =>
Map k shape -> (Int, Index (Map k shape) -> Result check Int)
unifiedSizeOffset = forall check k i ix.
(Checking check, Ord k, Num i) =>
Map k (i, ix -> Result check i) -> (i, (k, ix) -> Result check i)
mapSizeOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset
{-# INLINE mapSizeOffset #-}
mapSizeOffset ::
(Checking check, Ord k, Num i) =>
Map k (i, ix -> Result check i) -> (i, (k, ix) -> Result check i)
mapSizeOffset :: forall check k i ix.
(Checking check, Ord k, Num i) =>
Map k (i, ix -> Result check i) -> (i, (k, ix) -> Result check i)
mapSizeOffset Map k (i, ix -> Result check i)
ms =
(forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Fold.sum forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a, b) -> a
fst Map k (i, ix -> Result check i)
ms,
let mu :: Map k (ix -> Result check i)
mu = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
Trav.mapAccumL (\i
l (i
sz,ix -> Result check i
offs) -> (i
l forall a. Num a => a -> a -> a
+ i
sz, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i
lforall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> Result check i
offs)) i
0 Map k (i, ix -> Result check i)
ms
in \(k
k,ix
ix) ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall check a. Checking check => String -> Result check a
throwOrError String
"Shape.Map.sizeOffset: unknown key")
(forall a b. (a -> b) -> a -> b
$ix
ix)
(forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (ix -> Result check i)
mu))
instance (Ord k, InvIndexed shape) => InvIndexed (Map k shape) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Map k shape -> Int -> Result check (Index (Map k shape))
unifiedIndexFromOffset Map k shape
m Int
i =
(\[(Int, Result check (k, Index shape))]
xs ->
case [(Int, Result check (k, Index shape))]
xs of
(Int
_u,Result check (k, Index shape)
ix):[(Int, Result check (k, Index shape))]
_ -> Result check (k, Index shape)
ix
[] -> forall check a. Checking check => String -> Result check a
throwOrError forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Map" Int
i) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
u,Result check (k, Index shape)
_ix) -> Int
uforall a. Ord a => a -> a -> Bool
<=Int
i) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
(\Int
l (k
k,shape
sh) ->
let u :: Int
u = Int
l forall a. Num a => a -> a -> a
+ forall sh. C sh => sh -> Int
size shape
sh
in (Int
u, (Int
u, (,) k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset shape
sh (Int
iforall a. Num a => a -> a -> a
-Int
l)))) Int
0 forall a b. (a -> b) -> a -> b
$
forall k a. Map k a -> [(k, a)]
Map.toAscList Map k shape
m
newtype Deferred sh = Deferred sh
deriving (Deferred sh -> Deferred sh -> Bool
forall sh. Eq sh => Deferred sh -> Deferred sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Deferred sh -> Deferred sh -> Bool
$c/= :: forall sh. Eq sh => Deferred sh -> Deferred sh -> Bool
== :: Deferred sh -> Deferred sh -> Bool
$c== :: forall sh. Eq sh => Deferred sh -> Deferred sh -> Bool
Eq, Int -> Deferred sh -> String -> String
forall sh. Show sh => Int -> Deferred sh -> String -> String
forall sh. Show sh => [Deferred sh] -> String -> String
forall sh. Show sh => Deferred sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Deferred sh] -> String -> String
$cshowList :: forall sh. Show sh => [Deferred sh] -> String -> String
show :: Deferred sh -> String
$cshow :: forall sh. Show sh => Deferred sh -> String
showsPrec :: Int -> Deferred sh -> String -> String
$cshowsPrec :: forall sh. Show sh => Int -> Deferred sh -> String -> String
Show)
newtype DeferredIndex sh = DeferredIndex Int
deriving (DeferredIndex sh -> DeferredIndex sh -> Bool
forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c/= :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
== :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c== :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
Eq, DeferredIndex sh -> DeferredIndex sh -> Bool
DeferredIndex sh -> DeferredIndex sh -> Ordering
DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
forall sh. Eq (DeferredIndex sh)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
forall sh. DeferredIndex sh -> DeferredIndex sh -> Ordering
forall sh. DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
min :: DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
$cmin :: forall sh. DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
max :: DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
$cmax :: forall sh. DeferredIndex sh -> DeferredIndex sh -> DeferredIndex sh
>= :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c>= :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
> :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c> :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
<= :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c<= :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
< :: DeferredIndex sh -> DeferredIndex sh -> Bool
$c< :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Bool
compare :: DeferredIndex sh -> DeferredIndex sh -> Ordering
$ccompare :: forall sh. DeferredIndex sh -> DeferredIndex sh -> Ordering
Ord, Int -> DeferredIndex sh -> String -> String
forall sh. Int -> DeferredIndex sh -> String -> String
forall sh. [DeferredIndex sh] -> String -> String
forall sh. DeferredIndex sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DeferredIndex sh] -> String -> String
$cshowList :: forall sh. [DeferredIndex sh] -> String -> String
show :: DeferredIndex sh -> String
$cshow :: forall sh. DeferredIndex sh -> String
showsPrec :: Int -> DeferredIndex sh -> String -> String
$cshowsPrec :: forall sh. Int -> DeferredIndex sh -> String -> String
Show)
instance (NFData sh) => NFData (Deferred sh) where
rnf :: Deferred sh -> ()
rnf (Deferred sh
sh) = forall a. NFData a => a -> ()
rnf sh
sh
instance (C sh) => C (Deferred sh) where
size :: Deferred sh -> Int
size (Deferred sh
sh) = forall sh. C sh => sh -> Int
size sh
sh
instance (C sh) => Indexed (Deferred sh) where
type Index (Deferred sh) = DeferredIndex sh
indices :: Deferred sh -> [Index (Deferred sh)]
indices (Deferred sh
sh) = forall a b. (a -> b) -> [a] -> [b]
map forall sh. Int -> DeferredIndex sh
DeferredIndex forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall sh. C sh => sh -> Int
size sh
sh) [Int
0 ..]
unifiedOffset :: forall check.
Checking check =>
Deferred sh -> Index (Deferred sh) -> Result check Int
unifiedOffset (Deferred sh
sh) (DeferredIndex Int
k) = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
case CheckSingleton check
check of
CheckSingleton check
Checked -> forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset (forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ forall sh. C sh => sh -> Int
size sh
sh) Int
k
CheckSingleton check
Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
k
unifiedSizeOffset :: forall check.
Checking check =>
Deferred sh -> (Int, Index (Deferred sh) -> Result check Int)
unifiedSizeOffset (Deferred sh
sh) =
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\Int -> Result check Int
offs (DeferredIndex Int
k) -> Int -> Result check Int
offs Int
k) forall a b. (a -> b) -> a -> b
$
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset (forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ forall sh. C sh => sh -> Int
size sh
sh)
inBounds :: Deferred sh -> Index (Deferred sh) -> Bool
inBounds (Deferred sh
sh) (DeferredIndex Int
k) =
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ forall sh. C sh => sh -> Int
size sh
sh) Int
k
instance (C sh) => InvIndexed (Deferred sh) where
indexFromOffset :: Deferred sh -> Int -> Index (Deferred sh)
indexFromOffset (Deferred sh
sh) Int
k =
forall sh. Int -> DeferredIndex sh
DeferredIndex forall a b. (a -> b) -> a -> b
$ forall sh. InvIndexed sh => sh -> Int -> Index sh
indexFromOffset (forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ forall sh. C sh => sh -> Int
size sh
sh) Int
k
uncheckedIndexFromOffset :: Deferred sh -> Int -> Index (Deferred sh)
uncheckedIndexFromOffset Deferred sh
_sh = forall sh. Int -> DeferredIndex sh
DeferredIndex
unifiedIndexFromOffset :: forall check.
Checking check =>
Deferred sh -> Int -> Result check (Index (Deferred sh))
unifiedIndexFromOffset (Deferred sh
sh) Int
k = forall check a.
Checking check =>
(CheckSingleton check -> Result check a) -> Result check a
withCheck forall a b. (a -> b) -> a -> b
$ \CheckSingleton check
check ->
case CheckSingleton check
check of
CheckSingleton check
Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall sh. Int -> DeferredIndex sh
DeferredIndex Int
k
CheckSingleton check
Checked ->
forall sh. Int -> DeferredIndex sh
DeferredIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (forall n. n -> ZeroBased n
ZeroBased forall a b. (a -> b) -> a -> b
$ forall sh. C sh => sh -> Int
size sh
sh) Int
k
deferIndex :: (Indexed sh, Index sh ~ ix) => sh -> ix -> DeferredIndex sh
deferIndex :: forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh -> ix -> DeferredIndex sh
deferIndex sh
sh ix
ix = forall sh. Int -> DeferredIndex sh
DeferredIndex forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> Index sh -> Int
offset sh
sh ix
ix
revealIndex :: (InvIndexed sh, Index sh ~ ix) => sh -> DeferredIndex sh -> ix
revealIndex :: forall sh ix.
(InvIndexed sh, Index sh ~ ix) =>
sh -> DeferredIndex sh -> ix
revealIndex sh
sh (DeferredIndex Int
ix) = forall sh. InvIndexed sh => sh -> Int -> Index sh
indexFromOffset sh
sh Int
ix
instance (Static sh) => Static (Deferred sh) where
static :: Deferred sh
static = forall sh. sh -> Deferred sh
Deferred forall sh. Static sh => sh
static
instance Storable (DeferredIndex sh) where
{-# INLINE sizeOf #-}
{-# INLINE alignment #-}
{-# INLINE peek #-}
{-# INLINE poke #-}
sizeOf :: DeferredIndex sh -> Int
sizeOf (DeferredIndex Int
k) = forall a. Storable a => a -> Int
sizeOf Int
k
alignment :: DeferredIndex sh -> Int
alignment (DeferredIndex Int
k) = forall a. Storable a => a -> Int
alignment Int
k
poke :: Ptr (DeferredIndex sh) -> DeferredIndex sh -> IO ()
poke Ptr (DeferredIndex sh)
p (DeferredIndex Int
k) = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr (DeferredIndex sh)
p) Int
k
peek :: Ptr (DeferredIndex sh) -> IO (DeferredIndex sh)
peek Ptr (DeferredIndex sh)
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall sh. Int -> DeferredIndex sh
DeferredIndex forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (DeferredIndex sh)
p)
instance (C sh) => C (Tagged s sh) where
size :: Tagged s sh -> Int
size (Tagged sh
sh) = forall sh. C sh => sh -> Int
size sh
sh
instance (Indexed sh) => Indexed (Tagged s sh) where
type Index (Tagged s sh) = Tagged s (Index sh)
indices :: Tagged s sh -> [Index (Tagged s sh)]
indices (Tagged sh
sh) = forall a b. (a -> b) -> [a] -> [b]
map forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> [Index sh]
indices sh
sh
unifiedOffset :: forall check.
Checking check =>
Tagged s sh -> Index (Tagged s sh) -> Result check Int
unifiedOffset (Tagged sh
sh) = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh
sh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged
unifiedSizeOffset :: forall check.
Checking check =>
Tagged s sh -> (Int, Index (Tagged s sh) -> Result check Int)
unifiedSizeOffset (Tagged sh
sh) =
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
inBounds :: Tagged s sh -> Index (Tagged s sh) -> Bool
inBounds (Tagged sh
sh) (Tagged Index sh
k) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh
sh Index sh
k
instance (InvIndexed sh) => InvIndexed (Tagged s sh) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Tagged s sh -> Int -> Result check (Index (Tagged s sh))
unifiedIndexFromOffset (Tagged sh
sh) Int
k =
forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh Int
k
instance (Static sh) => Static (Tagged s sh) where
static :: Tagged s sh
static = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall sh. Static sh => sh
static
instance (Pattern sh) => Pattern (Tagged s sh) where
type DataPattern (Tagged s sh) x = DataPattern sh x
indexPattern :: forall x.
(Index (Tagged s sh) -> x)
-> Tagged s sh -> DataPattern (Tagged s sh) x
indexPattern Index (Tagged s sh) -> x
extend (Tagged sh
sh) = forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (Index (Tagged s sh) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. b -> Tagged s b
Tagged) sh
sh
instance (C sh0, C sh1) => C (sh0,sh1) where
size :: (sh0, sh1) -> Int
size (sh0
sh0,sh1
sh1) = forall sh. C sh => sh -> Int
size sh0
sh0 forall a. Num a => a -> a -> a
* forall sh. C sh => sh -> Int
size sh1
sh1
instance (Indexed sh0, Indexed sh1) => Indexed (sh0,sh1) where
type Index (sh0,sh1) = (Index sh0, Index sh1)
indices :: (sh0, sh1) -> [Index (sh0, sh1)]
indices (sh0
sh0,sh1
sh1) = forall (m :: * -> *) a b r.
Monad m =>
(a -> b -> r) -> m a -> m b -> m r
Monad.lift2 (,) (forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) (forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1)
unifiedOffset :: forall check.
Checking check =>
(sh0, sh1) -> Index (sh0, sh1) -> Result check Int
unifiedOffset (sh0
sh0,sh1
sh1) =
(forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh0
sh0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> ix -> f a
`combineOffset`
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
unifiedSizeOffset :: forall check.
Checking check =>
(sh0, sh1) -> (Int, Index (sh0, sh1) -> Result check Int)
unifiedSizeOffset (sh0
sh0,sh1
sh1) =
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
inBounds :: (sh0, sh1) -> Index (sh0, sh1) -> Bool
inBounds (sh0
sh0,sh1
sh1) (Index sh0
ix0,Index sh1
ix1) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0 Index sh0
ix0 Bool -> Bool -> Bool
&& forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1 Index sh1
ix1
instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0,sh1) where
unifiedIndexFromOffset :: forall check.
Checking check =>
(sh0, sh1) -> Int -> Result check (Index (sh0, sh1))
unifiedIndexFromOffset (sh0
sh0,sh1
sh1) Int
k = do
let (Result check (Index sh0)
rix0,Index sh1
ix1) =
forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) (forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh0
sh0) (forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh1
sh1)
Index sh0
ix0 <- Result check (Index sh0)
rix0
forall (m :: * -> *) a. Monad m => a -> m a
return (Index sh0
ix0,Index sh1
ix1)
instance (Static sh0, Static sh1) => Static (sh0,sh1) where
static :: (sh0, sh1)
static = (forall sh. Static sh => sh
static, forall sh. Static sh => sh
static)
instance (Pattern sh0, Pattern sh1) => Pattern (sh0,sh1) where
type DataPattern (sh0,sh1) x = PatternRecord sh0 (DataPattern sh1 x)
indexPattern :: forall x.
(Index (sh0, sh1) -> x) -> (sh0, sh1) -> DataPattern (sh0, sh1) x
indexPattern Index (sh0, sh1) -> x
extend (sh0
sh0,sh1
sh1) =
forall sh a. DataPattern sh a -> PatternRecord sh a
PatternRecord forall a b. (a -> b) -> a -> b
$
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh0
i -> forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh1
j -> Index (sh0, sh1) -> x
extend (Index sh0
i,Index sh1
j)) sh1
sh1) sh0
sh0
instance (C sh0, C sh1, C sh2) => C (sh0,sh1,sh2) where
size :: (sh0, sh1, sh2) -> Int
size (sh0
sh0,sh1
sh1,sh2
sh2) = forall sh. C sh => sh -> Int
size sh0
sh0 forall a. Num a => a -> a -> a
* forall sh. C sh => sh -> Int
size sh1
sh1 forall a. Num a => a -> a -> a
* forall sh. C sh => sh -> Int
size sh2
sh2
instance (Indexed sh0, Indexed sh1, Indexed sh2) => Indexed (sh0,sh1,sh2) where
type Index (sh0,sh1,sh2) = (Index sh0, Index sh1, Index sh2)
indices :: (sh0, sh1, sh2) -> [Index (sh0, sh1, sh2)]
indices (sh0
sh0,sh1
sh1,sh2
sh2) =
forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
Monad.lift3 (,,) (forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) (forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1) (forall sh. Indexed sh => sh -> [Index sh]
indices sh2
sh2)
unifiedOffset :: forall check.
Checking check =>
(sh0, sh1, sh2) -> Index (sh0, sh1, sh2) -> Result check Int
unifiedOffset (sh0
sh0,sh1
sh1,sh2
sh2) =
(forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh0
sh0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> a
fst3)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> ix -> f a
`combineOffset`
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> b
snd3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> c
thd3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh2
sh2)
unifiedSizeOffset :: forall check.
Checking check =>
(sh0, sh1, sh2) -> (Int, Index (sh0, sh1, sh2) -> Result check Int)
unifiedSizeOffset (sh0
sh0,sh1
sh1,sh2
sh2) =
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> a
fst3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> b
snd3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1)
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> c
thd3) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh2
sh2)
inBounds :: (sh0, sh1, sh2) -> Index (sh0, sh1, sh2) -> Bool
inBounds (sh0
sh0,sh1
sh1,sh2
sh2) (Index sh0
ix0,Index sh1
ix1,Index sh2
ix2) =
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0 Index sh0
ix0 Bool -> Bool -> Bool
&& forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1 Index sh1
ix1 Bool -> Bool -> Bool
&& forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh2
sh2 Index sh2
ix2
instance
(InvIndexed sh0, InvIndexed sh1, InvIndexed sh2) =>
InvIndexed (sh0,sh1,sh2) where
unifiedIndexFromOffset :: forall check.
Checking check =>
(sh0, sh1, sh2) -> Int -> Result check (Index (sh0, sh1, sh2))
unifiedIndexFromOffset (sh0
sh0,sh1
sh1,sh2
sh2) Int
k = do
let (Result check (Index sh0)
rix0,Index sh1
ix1,Index sh2
ix2) =
forall s a. s -> Backwards (State s) a -> a
runInvIndex Int
k forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,) (forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh0
sh0) (forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh1
sh1) (forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh2
sh2)
Index sh0
ix0 <- Result check (Index sh0)
rix0
forall (m :: * -> *) a. Monad m => a -> m a
return (Index sh0
ix0,Index sh1
ix1,Index sh2
ix2)
instance (Static sh0, Static sh1, Static sh2) => Static (sh0,sh1,sh2) where
static :: (sh0, sh1, sh2)
static = (forall sh. Static sh => sh
static, forall sh. Static sh => sh
static, forall sh. Static sh => sh
static)
runInvIndex :: s -> Back.Backwards (MS.State s) a -> a
runInvIndex :: forall s a. s -> Backwards (State s) a -> a
runInvIndex s
k = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
MS.evalState s
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
Back.forwards
pickLastIndex ::
(Checking check, InvIndexed sh) =>
sh -> Back.Backwards (MS.State Int) (Result check (Index sh))
pickLastIndex :: forall check sh.
(Checking check, InvIndexed sh) =>
sh -> Backwards (StateT Int Identity) (Result check (Index sh))
pickLastIndex sh
sh =
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets forall a b. (a -> b) -> a -> b
$ forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh
sh
pickIndex :: (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)
pickIndex :: forall sh.
InvIndexed sh =>
sh -> Backwards (StateT Int Identity) (Index sh)
pickIndex sh
sh =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall sh. InvIndexed sh => sh -> Int -> Index sh
uncheckedIndexFromOffset sh
sh) forall a b. (a -> b) -> a -> b
$
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Back.Backwards forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state forall a b. (a -> b) -> a -> b
$ \Int
k -> forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> (a, a)
divMod Int
k forall a b. (a -> b) -> a -> b
$ forall sh. C sh => sh -> Int
size sh
sh
infixr 7 `combineOffset`, `combineSizeOffset`
{-# INLINE combineOffset #-}
combineOffset ::
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> (ix -> f a)
combineOffset :: forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(ix -> f a) -> (a, ix -> f a) -> ix -> f a
combineOffset ix -> f a
offset0 (a
size1,ix -> f a
offset1) ix
ix =
ix -> f a
offset0 ix
ix forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
|* a
size1 forall (f :: * -> *) a. (Applicative f, Num a) => f a -> f a -> f a
|+| ix -> f a
offset1 ix
ix
{-# INLINE combineSizeOffset #-}
combineSizeOffset ::
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
combineSizeOffset :: forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
combineSizeOffset (a
size0,ix -> f a
offset0) (a
size1,ix -> f a
offset1) =
(a
size0forall a. Num a => a -> a -> a
*a
size1, \ix
ix -> ix -> f a
offset0 ix
ix forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
|* a
size1 forall (f :: * -> *) a. (Applicative f, Num a) => f a -> f a -> f a
|+| ix -> f a
offset1 ix
ix)
newtype Square sh = Square {forall sh. Square sh -> sh
squareSize :: sh}
deriving (Square sh -> Square sh -> Bool
forall sh. Eq sh => Square sh -> Square sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Square sh -> Square sh -> Bool
$c/= :: forall sh. Eq sh => Square sh -> Square sh -> Bool
== :: Square sh -> Square sh -> Bool
$c== :: forall sh. Eq sh => Square sh -> Square sh -> Bool
Eq, Int -> Square sh -> String -> String
forall sh. Show sh => Int -> Square sh -> String -> String
forall sh. Show sh => [Square sh] -> String -> String
forall sh. Show sh => Square sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Square sh] -> String -> String
$cshowList :: forall sh. Show sh => [Square sh] -> String -> String
show :: Square sh -> String
$cshow :: forall sh. Show sh => Square sh -> String
showsPrec :: Int -> Square sh -> String -> String
$cshowsPrec :: forall sh. Show sh => Int -> Square sh -> String -> String
Show)
instance Functor Square where
fmap :: forall a b. (a -> b) -> Square a -> Square b
fmap a -> b
f (Square a
sh) = forall sh. sh -> Square sh
Square forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh
instance Applicative Square where
pure :: forall sh. sh -> Square sh
pure = forall sh. sh -> Square sh
Square
Square a -> b
f <*> :: forall a b. Square (a -> b) -> Square a -> Square b
<*> Square a
sh = forall sh. sh -> Square sh
Square forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh
instance (NFData sh) => NFData (Square sh) where
rnf :: Square sh -> ()
rnf (Square sh
sh) = forall a. NFData a => a -> ()
rnf sh
sh
instance (Storable sh) => Storable (Square sh) where
sizeOf :: Square sh -> Int
sizeOf = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf forall sh. Square sh -> sh
squareSize
alignment :: Square sh -> Int
alignment = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment forall sh. Square sh -> sh
squareSize
peek :: Ptr (Square sh) -> IO (Square sh)
peek = forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek forall sh. sh -> Square sh
Square
poke :: Ptr (Square sh) -> Square sh -> IO ()
poke = forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke forall sh. Square sh -> sh
squareSize
instance (C sh) => C (Square sh) where
size :: Square sh -> Int
size (Square sh
sh) = forall sh. C sh => sh -> Int
size sh
sh forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2::Int)
instance (Indexed sh) => Indexed (Square sh) where
type Index (Square sh) = (Index sh, Index sh)
indices :: Square sh -> [Index (Square sh)]
indices (Square sh
sh) = forall sh. Indexed sh => sh -> [Index sh]
indices (sh
sh,sh
sh)
unifiedSizeOffset :: forall check.
Checking check =>
Square sh -> (Int, Index (Square sh) -> Result check Int)
unifiedSizeOffset (Square sh
sh) =
let szo :: (Int, Index sh -> Result check Int)
szo = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
in forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (Int, Index sh -> Result check Int)
szo forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset` forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) (Int, Index sh -> Result check Int)
szo
inBounds :: Square sh -> Index (Square sh) -> Bool
inBounds (Square sh
sh) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (sh
sh,sh
sh)
instance (InvIndexed sh) => InvIndexed (Square sh) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Square sh -> Int -> Result check (Index (Square sh))
unifiedIndexFromOffset (Square sh
sh) =
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (sh
sh,sh
sh)
newtype PatternRecord sh a = PatternRecord (DataPattern sh a)
instance (Pattern sh) => Pattern (Square sh) where
type DataPattern (Square sh) x = PatternRecord sh (DataPattern sh x)
indexPattern :: forall x.
(Index (Square sh) -> x) -> Square sh -> DataPattern (Square sh) x
indexPattern Index (Square sh) -> x
extend (Square sh
sh) =
forall sh a. DataPattern sh a -> PatternRecord sh a
PatternRecord forall a b. (a -> b) -> a -> b
$
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh
i -> forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (\Index sh
j -> Index (Square sh) -> x
extend (Index sh
i,Index sh
j)) sh
sh) sh
sh
newtype Cube sh = Cube {forall sh. Cube sh -> sh
cubeSize :: sh}
deriving (Cube sh -> Cube sh -> Bool
forall sh. Eq sh => Cube sh -> Cube sh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cube sh -> Cube sh -> Bool
$c/= :: forall sh. Eq sh => Cube sh -> Cube sh -> Bool
== :: Cube sh -> Cube sh -> Bool
$c== :: forall sh. Eq sh => Cube sh -> Cube sh -> Bool
Eq, Int -> Cube sh -> String -> String
forall sh. Show sh => Int -> Cube sh -> String -> String
forall sh. Show sh => [Cube sh] -> String -> String
forall sh. Show sh => Cube sh -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cube sh] -> String -> String
$cshowList :: forall sh. Show sh => [Cube sh] -> String -> String
show :: Cube sh -> String
$cshow :: forall sh. Show sh => Cube sh -> String
showsPrec :: Int -> Cube sh -> String -> String
$cshowsPrec :: forall sh. Show sh => Int -> Cube sh -> String -> String
Show)
instance Functor Cube where
fmap :: forall a b. (a -> b) -> Cube a -> Cube b
fmap a -> b
f (Cube a
sh) = forall sh. sh -> Cube sh
Cube forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh
instance Applicative Cube where
pure :: forall sh. sh -> Cube sh
pure = forall sh. sh -> Cube sh
Cube
Cube a -> b
f <*> :: forall a b. Cube (a -> b) -> Cube a -> Cube b
<*> Cube a
sh = forall sh. sh -> Cube sh
Cube forall a b. (a -> b) -> a -> b
$ a -> b
f a
sh
instance (NFData sh) => NFData (Cube sh) where
rnf :: Cube sh -> ()
rnf (Cube sh
sh) = forall a. NFData a => a -> ()
rnf sh
sh
instance (Storable sh) => Storable (Cube sh) where
sizeOf :: Cube sh -> Int
sizeOf = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf forall sh. Cube sh -> sh
cubeSize
alignment :: Cube sh -> Int
alignment = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment forall sh. Cube sh -> sh
cubeSize
peek :: Ptr (Cube sh) -> IO (Cube sh)
peek = forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek forall sh. sh -> Cube sh
Cube
poke :: Ptr (Cube sh) -> Cube sh -> IO ()
poke = forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke forall sh. Cube sh -> sh
cubeSize
instance (C sh) => C (Cube sh) where
size :: Cube sh -> Int
size (Cube sh
sh) = forall sh. C sh => sh -> Int
size sh
sh forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3::Int)
instance (Indexed sh) => Indexed (Cube sh) where
type Index (Cube sh) = (Index sh, Index sh, Index sh)
indices :: Cube sh -> [Index (Cube sh)]
indices (Cube sh
sh) = forall sh. Indexed sh => sh -> [Index sh]
indices (sh
sh,sh
sh,sh
sh)
unifiedSizeOffset :: forall check.
Checking check =>
Cube sh -> (Int, Index (Cube sh) -> Result check Int)
unifiedSizeOffset (Cube sh
sh) =
let szo :: (Int, Index sh -> Result check Int)
szo = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh
sh
in forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> a
fst3) (Int, Index sh -> Result check Int)
szo
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> b
snd3) (Int, Index sh -> Result check Int)
szo
forall (f :: * -> *) a ix.
(Applicative f, Num a) =>
(a, ix -> f a) -> (a, ix -> f a) -> (a, ix -> f a)
`combineSizeOffset`
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> c
thd3) (Int, Index sh -> Result check Int)
szo
inBounds :: Cube sh -> Index (Cube sh) -> Bool
inBounds (Cube sh
sh) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (sh
sh,sh
sh,sh
sh)
instance (InvIndexed sh) => InvIndexed (Cube sh) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Cube sh -> Int -> Result check (Index (Cube sh))
unifiedIndexFromOffset (Cube sh
sh) =
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (sh
sh,sh
sh,sh
sh)
data Lower = Lower deriving (Lower -> Lower -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lower -> Lower -> Bool
$c/= :: Lower -> Lower -> Bool
== :: Lower -> Lower -> Bool
$c== :: Lower -> Lower -> Bool
Eq, Int -> Lower -> String -> String
[Lower] -> String -> String
Lower -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Lower] -> String -> String
$cshowList :: [Lower] -> String -> String
show :: Lower -> String
$cshow :: Lower -> String
showsPrec :: Int -> Lower -> String -> String
$cshowsPrec :: Int -> Lower -> String -> String
Show)
data Upper = Upper deriving (Upper -> Upper -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Upper -> Upper -> Bool
$c/= :: Upper -> Upper -> Bool
== :: Upper -> Upper -> Bool
$c== :: Upper -> Upper -> Bool
Eq, Int -> Upper -> String -> String
[Upper] -> String -> String
Upper -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Upper] -> String -> String
$cshowList :: [Upper] -> String -> String
show :: Upper -> String
$cshow :: Upper -> String
showsPrec :: Int -> Upper -> String -> String
$cshowsPrec :: Int -> Upper -> String -> String
Show)
class TriangularPart part where
switchTriangularPart :: f Lower -> f Upper -> f part
instance TriangularPart Lower where switchTriangularPart :: forall (f :: * -> *). f Lower -> f Upper -> f Lower
switchTriangularPart f Lower
f f Upper
_ = f Lower
f
instance TriangularPart Upper where switchTriangularPart :: forall (f :: * -> *). f Lower -> f Upper -> f Upper
switchTriangularPart f Lower
_ f Upper
f = f Upper
f
getConstAs :: c -> Const a c -> a
getConstAs :: forall c a. c -> Const a c -> a
getConstAs c
_ = forall {k} a (b :: k). Const a b -> a
getConst
caseTriangularPart :: (TriangularPart part) => part -> a -> a -> a
caseTriangularPart :: forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part a
lo a
up =
forall c a. c -> Const a c -> a
getConstAs part
part forall a b. (a -> b) -> a -> b
$ forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall {k} a (b :: k). a -> Const a b
Const a
lo) (forall {k} a (b :: k). a -> Const a b
Const a
up)
data Triangular part size =
Triangular {
forall part size. Triangular part size -> part
triangularPart :: part,
forall part size. Triangular part size -> size
triangularSize :: size
} deriving (Int -> Triangular part size -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall part size.
(Show part, Show size) =>
Int -> Triangular part size -> String -> String
forall part size.
(Show part, Show size) =>
[Triangular part size] -> String -> String
forall part size.
(Show part, Show size) =>
Triangular part size -> String
showList :: [Triangular part size] -> String -> String
$cshowList :: forall part size.
(Show part, Show size) =>
[Triangular part size] -> String -> String
show :: Triangular part size -> String
$cshow :: forall part size.
(Show part, Show size) =>
Triangular part size -> String
showsPrec :: Int -> Triangular part size -> String -> String
$cshowsPrec :: forall part size.
(Show part, Show size) =>
Int -> Triangular part size -> String -> String
Show)
newtype Equal part = Equal {forall part. Equal part -> part -> part -> Bool
getEqual :: part -> part -> Bool}
equalPart :: (TriangularPart part) => part -> part -> Bool
equalPart :: forall part. TriangularPart part => part -> part -> Bool
equalPart = forall part. Equal part -> part -> part -> Bool
getEqual forall a b. (a -> b) -> a -> b
$ forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall part. (part -> part -> Bool) -> Equal part
Equal forall a. Eq a => a -> a -> Bool
(==)) (forall part. (part -> part -> Bool) -> Equal part
Equal forall a. Eq a => a -> a -> Bool
(==))
instance (TriangularPart part, Eq size) => Eq (Triangular part size) where
Triangular part size
x== :: Triangular part size -> Triangular part size -> Bool
==Triangular part size
y = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 forall part. TriangularPart part => part -> part -> Bool
equalPart forall part size. Triangular part size -> part
triangularPart Triangular part size
x Triangular part size
y Bool -> Bool -> Bool
&& forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating forall part size. Triangular part size -> size
triangularSize Triangular part size
x Triangular part size
y
type LowerTriangular = Triangular Lower
type UpperTriangular = Triangular Upper
lowerTriangular :: size -> LowerTriangular size
lowerTriangular :: forall size. size -> LowerTriangular size
lowerTriangular = forall part size. part -> size -> Triangular part size
Triangular Lower
Lower
upperTriangular :: size -> UpperTriangular size
upperTriangular :: forall size. size -> UpperTriangular size
upperTriangular = forall part size. part -> size -> Triangular part size
Triangular Upper
Upper
newtype Flip f b a = Flip {forall (f :: * -> * -> *) b a. Flip f b a -> f a b
getFlip :: f a b}
instance
(TriangularPart part, NFData size) => NFData (Triangular part size) where
rnf :: Triangular part size -> ()
rnf (Triangular part
part size
sz) =
forall a. NFData a => a -> ()
rnf
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> * -> *) b a. Flip f b a -> f a b
getFlip part
part forall a b. (a -> b) -> a -> b
$
forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip forall a b. (a -> b) -> a -> b
$ \Lower
Lower -> ()) (forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip forall a b. (a -> b) -> a -> b
$ \Upper
Upper -> ()),
size
sz)
instance (TriangularPart part, C size) => C (Triangular part size) where
size :: Triangular part size -> Int
size (Triangular part
_part size
sz) = Int -> Int
triangleSize forall a b. (a -> b) -> a -> b
$ forall sh. C sh => sh -> Int
size size
sz
instance
(TriangularPart part, Indexed size) =>
Indexed (Triangular part size) where
type Index (Triangular part size) = (Index size, Index size)
indices :: Triangular part size -> [Index (Triangular part size)]
indices (Triangular part
part size
sz) =
let ixs :: [Index size]
ixs = forall sh. Indexed sh => sh -> [Index sh]
indices size
sz
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Index size]
cs Index size
r -> forall a b. (a -> b) -> [a] -> [b]
map ((,) Index size
r) [Index size]
cs)
(forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Snoc g, Empty g) =>
f a -> T f (g a)
NonEmpty.inits [Index size]
ixs) [Index size]
ixs)
(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Index size
r [Index size]
cs -> forall a b. (a -> b) -> [a] -> [b]
map ((,) Index size
r) [Index size]
cs) [Index size]
ixs forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
tails [Index size]
ixs)
unifiedSizeOffset :: forall check.
Checking check =>
Triangular part size
-> (Int, Index (Triangular part size) -> Result check Int)
unifiedSizeOffset (Triangular part
part size
sz) =
let (Int
n, Index size -> Result check Int
getOffset) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset size
sz
in (Int -> Int
triangleSize Int
n, \(Index size
rs,Index size
cs) -> do
Int
r <- Index size -> Result check Int
getOffset Index size
rs
Int
c <- Index size -> Result check Int
getOffset Index size
cs
forall check. Checking check => String -> Bool -> Result check ()
assert String
"Shape.Triangular.sizeOffset: wrong array part" forall a b. (a -> b) -> a -> b
$
forall part a.
(TriangularPart part, Ord a) =>
part -> a -> a -> Bool
compareIndices part
part Int
r Int
c
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall part.
TriangularPart part =>
part -> Int -> (Int, Int) -> Int
triangleOffset part
part Int
n (Int
r,Int
c))
inBounds :: Triangular part size -> Index (Triangular part size) -> Bool
inBounds (Triangular part
part size
sz) ix :: Index (Triangular part size)
ix@(Index size
r,Index size
c) =
forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (size
sz,size
sz) Index (Triangular part size)
ix
Bool -> Bool -> Bool
&&
let getOffset :: Index size -> Int
getOffset = forall sh. Indexed sh => sh -> Index sh -> Int
offset size
sz
in forall part a.
(TriangularPart part, Ord a) =>
part -> a -> a -> Bool
compareIndices part
part (Index size -> Int
getOffset Index size
r) (Index size -> Int
getOffset Index size
c)
triangleOffset :: TriangularPart part => part -> Int -> (Int, Int) -> Int
triangleOffset :: forall part.
TriangularPart part =>
part -> Int -> (Int, Int) -> Int
triangleOffset part
part Int
n (Int
r,Int
c) =
forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
(Int -> Int
triangleSize Int
r forall a. Num a => a -> a -> a
+ Int
c)
(Int -> Int
triangleSize Int
n forall a. Num a => a -> a -> a
- Int -> Int
triangleSize (Int
nforall a. Num a => a -> a -> a
-Int
r) forall a. Num a => a -> a -> a
+ Int
cforall a. Num a => a -> a -> a
-Int
r)
compareIndices :: (TriangularPart part, Ord a) => part -> a -> a -> Bool
compareIndices :: forall part a.
(TriangularPart part, Ord a) =>
part -> a -> a -> Bool
compareIndices part
part = forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part forall a. Ord a => a -> a -> Bool
(>=) forall a. Ord a => a -> a -> Bool
(<=)
instance
(TriangularPart part, InvIndexed size) =>
InvIndexed (Triangular part size) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Triangular part size
-> Int -> Result check (Index (Triangular part size))
unifiedIndexFromOffset (Triangular part
part size
sz) Int
k =
let n :: Int
n = forall sh. C sh => sh -> Int
size size
sz in
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c, b -> f d) -> (a, b) -> f (c, d)
App.mapPair (forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset size
sz, forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset size
sz) forall a b. (a -> b) -> a -> b
$
forall part a. TriangularPart part => part -> a -> a -> a
caseTriangularPart part
part
(let r :: Int
r = forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Double
triangleRootDouble Int
k)
in (Int
r, Int
k forall a. Num a => a -> a -> a
- Int -> Int
triangleSize Int
r))
(let triSize :: Int
triSize = Int -> Int
triangleSize Int
n
rr :: Int
rr = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
triangleRootDouble (Int
triSizeforall a. Num a => a -> a -> a
-Int
k))
r :: Int
r = Int
n forall a. Num a => a -> a -> a
- Int
rr
in (Int
r, Int
kforall a. Num a => a -> a -> a
+Int
r forall a. Num a => a -> a -> a
- (Int
triSize forall a. Num a => a -> a -> a
- Int -> Int
triangleSize Int
rr)))
triangleSize :: Int -> Int
triangleSize :: Int -> Int
triangleSize Int
n = forall a. Integral a => a -> a -> a
div (Int
nforall a. Num a => a -> a -> a
*(Int
nforall a. Num a => a -> a -> a
+Int
1)) Int
2
triangleRoot :: Floating a => a -> a
triangleRoot :: forall a. Floating a => a -> a
triangleRoot a
sz = (forall a. Floating a => a -> a
sqrt (a
8forall a. Num a => a -> a -> a
*a
szforall a. Num a => a -> a -> a
+a
1)forall a. Num a => a -> a -> a
-a
1)forall a. Fractional a => a -> a -> a
/a
2
triangleRootDouble :: Int -> Double
triangleRootDouble :: Int -> Double
triangleRootDouble = forall a. Floating a => a -> a
triangleRoot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance
(TriangularPart part, Static size) =>
Static (Triangular part size) where
static :: Triangular part size
static = forall part size. part -> size -> Triangular part size
Triangular forall part. TriangularPart part => part
autoPart forall sh. Static sh => sh
static
autoPart :: (TriangularPart part) => part
autoPart :: forall part. TriangularPart part => part
autoPart = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall part (f :: * -> *).
TriangularPart part =>
f Lower -> f Upper -> f part
switchTriangularPart (forall a. a -> Identity a
Identity Lower
Lower) (forall a. a -> Identity a
Identity Upper
Upper)
data Simplex order coll f size =
Simplex {
forall order coll (f :: * -> *) size.
Simplex order coll f size -> SimplexOrder order
simplexOrder :: SimplexOrder order,
forall order coll (f :: * -> *) size.
Simplex order coll f size -> f coll
simplexDimension :: f coll,
forall order coll (f :: * -> *) size.
Simplex order coll f size -> size
simplexSize :: size
}
data Ascending
data Descending
data SimplexOrder order where
Ascending :: SimplexOrder Ascending
Descending :: SimplexOrder Descending
instance Eq (SimplexOrder order) where
SimplexOrder order
Ascending == :: SimplexOrder order -> SimplexOrder order -> Bool
== SimplexOrder order
Ascending = Bool
True
SimplexOrder order
Descending == SimplexOrder order
Descending = Bool
True
instance Show (SimplexOrder order) where
show :: SimplexOrder order -> String
show SimplexOrder order
Ascending = String
"Ascending"
show SimplexOrder order
Descending = String
"Descending"
type SimplexAscending = Simplex Ascending
type SimplexDescending = Simplex Descending
simplexAscending :: f coll -> size -> SimplexAscending coll f size
simplexAscending :: forall (f :: * -> *) coll size.
f coll -> size -> SimplexAscending coll f size
simplexAscending = forall order coll (f :: * -> *) size.
SimplexOrder order -> f coll -> size -> Simplex order coll f size
Simplex SimplexOrder Ascending
Ascending
simplexDescending :: f coll -> size -> SimplexDescending coll f size
simplexDescending :: forall (f :: * -> *) coll size.
f coll -> size -> SimplexDescending coll f size
simplexDescending = forall order coll (f :: * -> *) size.
SimplexOrder order -> f coll -> size -> Simplex order coll f size
Simplex SimplexOrder Descending
Descending
isAscending :: SimplexOrder order -> Bool
isAscending :: forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
Ascending = Bool
True
isAscending SimplexOrder order
Descending = Bool
False
class SimplexOrderC order where
instance SimplexOrderC Ascending where
instance SimplexOrderC Descending where
data AllDistinct = AllDistinct deriving (Int -> AllDistinct -> String -> String
[AllDistinct] -> String -> String
AllDistinct -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AllDistinct] -> String -> String
$cshowList :: [AllDistinct] -> String -> String
show :: AllDistinct -> String
$cshow :: AllDistinct -> String
showsPrec :: Int -> AllDistinct -> String -> String
$cshowsPrec :: Int -> AllDistinct -> String -> String
Show, AllDistinct -> AllDistinct -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllDistinct -> AllDistinct -> Bool
$c/= :: AllDistinct -> AllDistinct -> Bool
== :: AllDistinct -> AllDistinct -> Bool
$c== :: AllDistinct -> AllDistinct -> Bool
Eq)
data SomeRepetitive = SomeRepetitive deriving (Int -> SomeRepetitive -> String -> String
[SomeRepetitive] -> String -> String
SomeRepetitive -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SomeRepetitive] -> String -> String
$cshowList :: [SomeRepetitive] -> String -> String
show :: SomeRepetitive -> String
$cshow :: SomeRepetitive -> String
showsPrec :: Int -> SomeRepetitive -> String -> String
$cshowsPrec :: Int -> SomeRepetitive -> String -> String
Show, SomeRepetitive -> SomeRepetitive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeRepetitive -> SomeRepetitive -> Bool
$c/= :: SomeRepetitive -> SomeRepetitive -> Bool
== :: SomeRepetitive -> SomeRepetitive -> Bool
$c== :: SomeRepetitive -> SomeRepetitive -> Bool
Eq)
data Collision = Distinct | Repetitive deriving (Int -> Collision -> String -> String
[Collision] -> String -> String
Collision -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Collision] -> String -> String
$cshowList :: [Collision] -> String -> String
show :: Collision -> String
$cshow :: Collision -> String
showsPrec :: Int -> Collision -> String -> String
$cshowsPrec :: Int -> Collision -> String -> String
Show, Collision -> Collision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Collision -> Collision -> Bool
$c/= :: Collision -> Collision -> Bool
== :: Collision -> Collision -> Bool
$c== :: Collision -> Collision -> Bool
Eq, Eq Collision
Collision -> Collision -> Bool
Collision -> Collision -> Ordering
Collision -> Collision -> Collision
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Collision -> Collision -> Collision
$cmin :: Collision -> Collision -> Collision
max :: Collision -> Collision -> Collision
$cmax :: Collision -> Collision -> Collision
>= :: Collision -> Collision -> Bool
$c>= :: Collision -> Collision -> Bool
> :: Collision -> Collision -> Bool
$c> :: Collision -> Collision -> Bool
<= :: Collision -> Collision -> Bool
$c<= :: Collision -> Collision -> Bool
< :: Collision -> Collision -> Bool
$c< :: Collision -> Collision -> Bool
compare :: Collision -> Collision -> Ordering
$ccompare :: Collision -> Collision -> Ordering
Ord, Int -> Collision
Collision -> Int
Collision -> [Collision]
Collision -> Collision
Collision -> Collision -> [Collision]
Collision -> Collision -> Collision -> [Collision]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Collision -> Collision -> Collision -> [Collision]
$cenumFromThenTo :: Collision -> Collision -> Collision -> [Collision]
enumFromTo :: Collision -> Collision -> [Collision]
$cenumFromTo :: Collision -> Collision -> [Collision]
enumFromThen :: Collision -> Collision -> [Collision]
$cenumFromThen :: Collision -> Collision -> [Collision]
enumFrom :: Collision -> [Collision]
$cenumFrom :: Collision -> [Collision]
fromEnum :: Collision -> Int
$cfromEnum :: Collision -> Int
toEnum :: Int -> Collision
$ctoEnum :: Int -> Collision
pred :: Collision -> Collision
$cpred :: Collision -> Collision
succ :: Collision -> Collision
$csucc :: Collision -> Collision
Enum)
class CollisionC coll where repetitionAllowed :: coll -> Bool
instance CollisionC AllDistinct where repetitionAllowed :: AllDistinct -> Bool
repetitionAllowed AllDistinct
AllDistinct = Bool
False
instance CollisionC SomeRepetitive where repetitionAllowed :: SomeRepetitive -> Bool
repetitionAllowed SomeRepetitive
SomeRepetitive = Bool
True
instance CollisionC Collision where
repetitionAllowed :: Collision -> Bool
repetitionAllowed Collision
Distinct = Bool
False
repetitionAllowed Collision
Repetitive = Bool
True
instance
(SimplexOrderC order, Show coll, FunctorC.Show1 f, Show size) =>
Show (Simplex order coll f size) where
showsPrec :: Int -> Simplex order coll f size -> String -> String
showsPrec Int
p (Simplex SimplexOrder order
order f coll
d size
sz) =
Bool -> (String -> String) -> String -> String
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
String -> String -> String
showString String
"Simplex " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => a -> String -> String
shows SimplexOrder order
order forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a.
(Show1 f, Show a) =>
Int -> f a -> String -> String
FunctorC.showsPrec1 Int
11 f coll
d forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 size
sz
instance
(SimplexOrderC order, CollisionC coll, Traversable f, C size) =>
C (Simplex order coll f size) where
size :: Simplex order coll f size -> Int
size (Simplex SimplexOrder order
_order f coll
d size
sz) =
let ds :: [coll]
ds = forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d
rep :: Int
rep = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall coll. CollisionC coll => coll -> Bool
repetitionAllowed forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
laxInit [coll]
ds
in forall i. Integral i => Int -> i -> i
simplexLayoutSize (forall (t :: * -> *) a. Foldable t => t a -> Int
length [coll]
ds) (forall sh. C sh => sh -> Int
size size
sz forall a. Num a => a -> a -> a
+ Int
rep)
laxInit :: [a] -> [a]
laxInit :: forall a. [a] -> [a]
laxInit [a]
xs = forall b a. [b] -> [a] -> [a]
Match.take (forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs) [a]
xs
simplexLayoutSize :: Integral i => Int -> i -> i
simplexLayoutSize :: forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
d i
n =
case forall a. Int -> [a] -> [a]
drop Int
d forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> [a]
binomials i
n of
[] -> i
0
i
m:[i]
_ -> i
m
binomials :: Integral a => a -> [a]
binomials :: forall a. Integral a => a -> [a]
binomials a
n =
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\a
acc (a
num,a
den) -> forall a. Integral a => a -> a -> a
div (a
accforall a. Num a => a -> a -> a
*a
num) a
den) a
1
(forall a b. [a] -> [b] -> [(a, b)]
zip [a
n, forall a. Enum a => a -> a
pred a
n ..] [a
1..a
n])
foldLength :: (Foldable f) => f a -> Int
foldLength :: forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList
instance
(SimplexOrderC order, CollisionC coll,
Traversable f, FunctorC.Eq1 f, Indexed size) =>
Indexed (Simplex order coll f size) where
type Index (Simplex order coll f size) = f (Index size)
indices :: Simplex order coll f size -> [Index (Simplex order coll f size)]
indices (Simplex SimplexOrder order
order f coll
d size
sz) =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT (forall sh. Indexed sh => sh -> [Index sh]
indices size
sz) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse
(if forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
then forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexAscending
else forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexDescending)
f coll
d
inBounds :: Simplex order coll f size
-> Index (Simplex order coll f size) -> Bool
inBounds (Simplex SimplexOrder order
order f coll
d size
sz) =
let getOffset :: Index size -> Int
getOffset = forall sh. Indexed sh => sh -> Index sh -> Int
offset size
sz in \Index (Simplex order coll f size)
ix ->
let ixs :: [Index size]
ixs = forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList Index (Simplex order coll f size)
ix in
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds size
sz) [Index size]
ixs Bool -> Bool -> Bool
&&
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
FunctorC.eq1 (forall (f :: * -> *) a. Functor f => f a -> f ()
void f coll
d) (forall (f :: * -> *) a. Functor f => f a -> f ()
void Index (Simplex order coll f size)
ix) Bool -> Bool -> Bool
&&
forall coll order.
CollisionC coll =>
SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order (forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d) (forall a b. (a -> b) -> [a] -> [b]
map Index size -> Int
getOffset [Index size]
ixs)
unifiedSizeOffset :: forall check.
Checking check =>
Simplex order coll f size
-> (Int, Index (Simplex order coll f size) -> Result check Int)
unifiedSizeOffset (Simplex SimplexOrder order
order f coll
d size
sz) =
let (Int
n, Index size -> Result check Int
getOffset) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset size
sz in
let dInt :: Int
dInt = forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength f coll
d
prep :: (Int, f (Int, (Int, Int)))
prep = forall (t :: * -> *) i coll order.
(Traversable t, Num i, CollisionC coll) =>
SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder SimplexOrder order
order f coll
d Int
n in
(forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
dInt (forall a b. (a, b) -> a
fst (Int, f (Int, (Int, Int)))
prep),
\Index (Simplex order coll f size)
ixf -> do
[Int]
ks <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse Index size -> Result check Int
getOffset forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList Index (Simplex order coll f size)
ixf
forall check. Checking check => String -> Bool -> Result check ()
assert
String
"Shape.Simplex.offset: simplex and index structure mismatch"
(forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
FunctorC.eq1 (forall (f :: * -> *) a. Functor f => f a -> f ()
void f coll
d) (forall (f :: * -> *) a. Functor f => f a -> f ()
void Index (Simplex order coll f size)
ixf))
forall check. Checking check => String -> Bool -> Result check ()
assert
String
"Shape.Simplex.offset: index elements not monotonic"
(forall coll order.
CollisionC coll =>
SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order (forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f coll
d) [Int]
ks)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall i order.
Integral i =>
SimplexOrder order -> Int -> (i, [(Int, i)]) -> [i] -> i
simplexOffset SimplexOrder order
order Int
dInt
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList) (Int, f (Int, (Int, Int)))
prep) [Int]
ks)
simplexOffset ::
(Integral i) => SimplexOrder order -> Int -> (i, [(Int, i)]) -> [i] -> i
simplexOffset :: forall i order.
Integral i =>
SimplexOrder order -> Int -> (i, [(Int, i)]) -> [i] -> i
simplexOffset SimplexOrder order
order Int
d (i
nsum,[(Int, i)]
cis) [i]
ks =
case SimplexOrder order
order of
SimplexOrder order
Ascending ->
forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
d i
nsum forall a. Num a => a -> a -> a
- i
1
forall a. Num a => a -> a -> a
-
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i
k (Int
x,i
y) -> forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (i
yforall a. Num a => a -> a -> a
-i
k)) [i]
ks [(Int, i)]
cis)
SimplexOrder order
Descending ->
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i
k (Int
x,i
y) -> forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (i
yforall a. Num a => a -> a -> a
+i
k)) [i]
ks [(Int, i)]
cis)
isMonotonic ::
(CollisionC coll) => SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic :: forall coll order.
CollisionC coll =>
SimplexOrder order -> [coll] -> [Int] -> Bool
isMonotonic SimplexOrder order
order [coll]
cs =
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
then
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent
(\(coll
c,Int
x) (coll
_,Int
y) -> if forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
c then Int
xforall a. Ord a => a -> a -> Bool
<=Int
y else Int
xforall a. Ord a => a -> a -> Bool
<Int
y)
else
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent
(\(coll
c,Int
x) (coll
_,Int
y) -> if forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
c then Int
xforall a. Ord a => a -> a -> Bool
>=Int
y else Int
xforall a. Ord a => a -> a -> Bool
>Int
y))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. [a] -> [b] -> [(a, b)]
zip [coll]
cs
chooseIndexAscending, chooseIndexDescending ::
(CollisionC coll) => coll -> MS.StateT [a] [] a
chooseIndexAscending :: forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexAscending coll
coll =
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ \[a]
as -> forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as forall a b. (a -> b) -> a -> b
$
(if forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
coll then forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten else forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Cons g, Empty g) =>
f a -> T f (g a)
NonEmpty.tails [a]
as
chooseIndexDescending :: forall coll a. CollisionC coll => coll -> StateT [a] [] a
chooseIndexDescending coll
coll =
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ \[a]
as -> forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as forall a b. (a -> b) -> a -> b
$
(if forall coll. CollisionC coll => coll -> Bool
repetitionAllowed coll
coll then forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail else forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) (g :: * -> *) a.
(Traversable f, Snoc g, Empty g) =>
f a -> T f (g a)
NonEmpty.inits [a]
as
instance
(SimplexOrderC order, CollisionC coll,
Traversable f, FunctorC.Eq1 f, InvIndexed size) =>
InvIndexed (Simplex order coll f size) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Simplex order coll f size
-> Int -> Result check (Index (Simplex order coll f size))
unifiedIndexFromOffset (Simplex SimplexOrder order
order f coll
d size
sh) =
let n :: Int
n = forall sh. C sh => sh -> Int
size size
sh in
let (Int
nSum,f (Int, (Int, Int))
deco) = forall (t :: * -> *) i coll order.
(Traversable t, Num i, CollisionC coll) =>
SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder SimplexOrder order
order f coll
d Int
n in
let dInt :: Int
dInt = forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength f coll
d in \Int
k ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall check a. Checking check => String -> Result check a
throwOrError forall a b. (a -> b) -> a -> b
$ String -> Int -> String
messageIndexFromOffset String
"Simplex" Int
k)
(forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse (forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset size
sh) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
if forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
then
forall (t :: * -> *) (m :: * -> *) a b c.
(Traversable t, Monad m) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM
(\(Int
a,Int
k0) (Int
db,(Int
x,Int
y)) ->
case forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Ord a => a -> a -> Bool
<Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\Int
bi -> (Int
bi, Int
k0 forall a. Num a => a -> a -> a
- forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (Int
yforall a. Num a => a -> a -> a
-Int
bi))) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<Int
n) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Int
1forall a. Num a => a -> a -> a
+) Int
a of
[] -> forall a. Maybe a
Nothing
(Int
b,Int
k1):[(Int, Int)]
_ -> forall a. a -> Maybe a
Just ((Int
bforall a. Num a => a -> a -> a
+Int
db, Int
k1), Int
b))
(Int
0, forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
dInt Int
nSum forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
k)
f (Int, (Int, Int))
deco
else
forall (t :: * -> *) (m :: * -> *) a b c.
(Traversable t, Monad m) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM
(\(Int
a,Int
k0) (Int
db,(Int
x,Int
y)) ->
case forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Ord a => a -> a -> Bool
<Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\Int
bi -> (Int
bi, Int
k0 forall a. Num a => a -> a -> a
- forall i. Integral i => Int -> i -> i
simplexLayoutSize Int
x (Int
yforall a. Num a => a -> a -> a
+Int
bi))) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
>=Int
0) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
subtract Int
1) Int
a of
[] -> forall a. Maybe a
Nothing
(Int
b,Int
k1):[(Int, Int)]
_ -> forall a. a -> Maybe a
Just ((Int
bforall a. Num a => a -> a -> a
-Int
db, Int
k1), Int
b))
(Int
n,Int
k)
f (Int, (Int, Int))
deco
mapAccumLM ::
(Traversable t, Monad m) => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM :: forall (t :: * -> *) (m :: * -> *) a b c.
(Traversable t, Monad m) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumLM a -> b -> m (a, c)
f a
a0 t b
xs =
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT
(forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Trav.mapM (\b
b -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ \a
a -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ a -> b -> m (a, c)
f a
a b
b) t b
xs) a
a0
prepareSimplexIndexingOrder ::
(Traversable t, Num i, CollisionC coll) =>
SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder :: forall (t :: * -> *) i coll order.
(Traversable t, Num i, CollisionC coll) =>
SimplexOrder order -> t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexingOrder SimplexOrder order
order t coll
d Int
n =
if forall order. SimplexOrder order -> Bool
isAscending SimplexOrder order
order
then forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int
1forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) i coll.
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d (Int
nforall a. Num a => a -> a -> a
-Int
1)
else forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int
nforall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) i coll.
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d Int
0
prepareSimplexIndexing ::
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing :: forall (t :: * -> *) i coll.
(Traversable t, Num i, CollisionC coll) =>
t coll -> Int -> (Int, t (Int, (i, Int)))
prepareSimplexIndexing t coll
d Int
n =
let ((Bool
_,(i
_,Int
nSum)), t (Int, (i, Int))
deco) =
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
Trav.mapAccumR
(\(Bool
c0,(i
x,Int
y)) Bool
ci ->
let c1 :: Int
c1 = forall a. Enum a => a -> Int
fromEnum (Bool
ciBool -> Bool -> Bool
&&Bool
c0)
p :: (i, Int)
p = (i
xforall a. Num a => a -> a -> a
+i
1,Int
yforall a. Num a => a -> a -> a
+Int
c1)
in ((Bool
True,(i, Int)
p),(Int
1forall a. Num a => a -> a -> a
-Int
c1,(i, Int)
p)))
(Bool
False,(i
0,Int
n))
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall coll. CollisionC coll => coll -> Bool
repetitionAllowed t coll
d)
in (Int
nSum, t (Int, (i, Int))
deco)
newtype Cyclic n = Cyclic {forall n. Cyclic n -> n
cyclicSize :: n}
deriving (Cyclic n -> Cyclic n -> Bool
forall n. Eq n => Cyclic n -> Cyclic n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cyclic n -> Cyclic n -> Bool
$c/= :: forall n. Eq n => Cyclic n -> Cyclic n -> Bool
== :: Cyclic n -> Cyclic n -> Bool
$c== :: forall n. Eq n => Cyclic n -> Cyclic n -> Bool
Eq, Int -> Cyclic n -> String -> String
forall n. Show n => Int -> Cyclic n -> String -> String
forall n. Show n => [Cyclic n] -> String -> String
forall n. Show n => Cyclic n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cyclic n] -> String -> String
$cshowList :: forall n. Show n => [Cyclic n] -> String -> String
show :: Cyclic n -> String
$cshow :: forall n. Show n => Cyclic n -> String
showsPrec :: Int -> Cyclic n -> String -> String
$cshowsPrec :: forall n. Show n => Int -> Cyclic n -> String -> String
Show)
instance Functor Cyclic where
fmap :: forall a b. (a -> b) -> Cyclic a -> Cyclic b
fmap a -> b
f (Cyclic a
n) = forall n. n -> Cyclic n
Cyclic forall a b. (a -> b) -> a -> b
$ a -> b
f a
n
instance Applicative Cyclic where
pure :: forall n. n -> Cyclic n
pure = forall n. n -> Cyclic n
Cyclic
Cyclic a -> b
f <*> :: forall a b. Cyclic (a -> b) -> Cyclic a -> Cyclic b
<*> Cyclic a
n = forall n. n -> Cyclic n
Cyclic forall a b. (a -> b) -> a -> b
$ a -> b
f a
n
instance (NFData n) => NFData (Cyclic n) where
rnf :: Cyclic n -> ()
rnf (Cyclic n
n) = forall a. NFData a => a -> ()
rnf n
n
instance (Storable n) => Storable (Cyclic n) where
sizeOf :: Cyclic n -> Int
sizeOf = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf forall n. Cyclic n -> n
cyclicSize
alignment :: Cyclic n -> Int
alignment = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment forall n. Cyclic n -> n
cyclicSize
peek :: Ptr (Cyclic n) -> IO (Cyclic n)
peek = forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek forall n. n -> Cyclic n
Cyclic
poke :: Ptr (Cyclic n) -> Cyclic n -> IO ()
poke = forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke forall n. Cyclic n -> n
cyclicSize
instance (Integral n) => C (Cyclic n) where
size :: Cyclic n -> Int
size (Cyclic n
len) = forall a b. (Integral a, Num b) => a -> b
fromIntegral n
len
instance (Integral n) => Indexed (Cyclic n) where
type Index (Cyclic n) = n
indices :: Cyclic n -> [Index (Cyclic n)]
indices (Cyclic n
len) = forall sh. Indexed sh => sh -> [Index sh]
indices forall a b. (a -> b) -> a -> b
$ forall n. n -> ZeroBased n
ZeroBased n
len
unifiedOffset :: forall check.
Checking check =>
Cyclic n -> Index (Cyclic n) -> Result check Int
unifiedOffset (Cyclic n
len) Index (Cyclic n)
ix = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
mod Index (Cyclic n)
ix n
len
inBounds :: Cyclic n -> Index (Cyclic n) -> Bool
inBounds (Cyclic n
len) Index (Cyclic n)
_ix = n
lenforall a. Ord a => a -> a -> Bool
>n
0
instance (Integral n) => InvIndexed (Cyclic n) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Cyclic n -> Int -> Result check (Index (Cyclic n))
unifiedIndexFromOffset (Cyclic n
len) Int
k0 = do
let k :: n
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0
forall check.
Checking check =>
String -> Int -> Bool -> Result check ()
assertIndexFromOffset String
"Cyclic" Int
k0 forall a b. (a -> b) -> a -> b
$ n
0forall a. Ord a => a -> a -> Bool
<=n
k Bool -> Bool -> Bool
&& n
kforall a. Ord a => a -> a -> Bool
<n
len
forall (m :: * -> *) a. Monad m => a -> m a
return n
k
infixr 5 ::+
data sh0::+sh1 = sh0::+sh1
deriving ((sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall sh0 sh1.
(Eq sh0, Eq sh1) =>
(sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
/= :: (sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
$c/= :: forall sh0 sh1.
(Eq sh0, Eq sh1) =>
(sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
== :: (sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
$c== :: forall sh0 sh1.
(Eq sh0, Eq sh1) =>
(sh0 ::+ sh1) -> (sh0 ::+ sh1) -> Bool
Eq, Int -> (sh0 ::+ sh1) -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall sh0 sh1.
(Show sh0, Show sh1) =>
Int -> (sh0 ::+ sh1) -> String -> String
forall sh0 sh1.
(Show sh0, Show sh1) =>
[sh0 ::+ sh1] -> String -> String
forall sh0 sh1. (Show sh0, Show sh1) => (sh0 ::+ sh1) -> String
showList :: [sh0 ::+ sh1] -> String -> String
$cshowList :: forall sh0 sh1.
(Show sh0, Show sh1) =>
[sh0 ::+ sh1] -> String -> String
show :: (sh0 ::+ sh1) -> String
$cshow :: forall sh0 sh1. (Show sh0, Show sh1) => (sh0 ::+ sh1) -> String
showsPrec :: Int -> (sh0 ::+ sh1) -> String -> String
$cshowsPrec :: forall sh0 sh1.
(Show sh0, Show sh1) =>
Int -> (sh0 ::+ sh1) -> String -> String
Show)
instance (NFData sh0, NFData sh1) => NFData (sh0::+sh1) where
rnf :: (sh0 ::+ sh1) -> ()
rnf (sh0
sh0::+sh1
sh1) = forall a. NFData a => a -> ()
rnf (sh0
sh0,sh1
sh1)
instance (C sh0, C sh1) => C (sh0::+sh1) where
size :: (sh0 ::+ sh1) -> Int
size (sh0
sh0::+sh1
sh1) = forall sh. C sh => sh -> Int
size sh0
sh0 forall a. Num a => a -> a -> a
+ forall sh. C sh => sh -> Int
size sh1
sh1
instance (Indexed sh0, Indexed sh1) => Indexed (sh0::+sh1) where
type Index (sh0::+sh1) = Either (Index sh0) (Index sh1)
indices :: (sh0 ::+ sh1) -> [Index (sh0 ::+ sh1)]
indices (sh0
sh0::+sh1
sh1) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left (forall sh. Indexed sh => sh -> [Index sh]
indices sh0
sh0) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right (forall sh. Indexed sh => sh -> [Index sh]
indices sh1
sh1)
unifiedOffset :: forall check.
Checking check =>
(sh0 ::+ sh1) -> Index (sh0 ::+ sh1) -> Result check Int
unifiedOffset (sh0
sh0::+sh1
sh1) =
let (Int
n0,Index sh0 -> Result check Int
getOffset0) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0
getOffset1 :: Index sh1 -> Result check Int
getOffset1 = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset sh1
sh1
in \Index (sh0 ::+ sh1)
ix ->
case Index (sh0 ::+ sh1)
ix of
Left Index sh0
ix0 -> Index sh0 -> Result check Int
getOffset0 Index sh0
ix0
Right Index sh1
ix1 -> (Int
n0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index sh1 -> Result check Int
getOffset1 Index sh1
ix1
unifiedSizeOffset :: forall check.
Checking check =>
(sh0 ::+ sh1) -> (Int, Index (sh0 ::+ sh1) -> Result check Int)
unifiedSizeOffset (sh0
sh0::+sh1
sh1) =
let (Int
n0, Index sh0 -> Result check Int
getOffset0) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh0
sh0
(Int
n1, Index sh1 -> Result check Int
getOffset1) = forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
unifiedSizeOffset sh1
sh1
in (Int
n0forall a. Num a => a -> a -> a
+Int
n1, forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Index sh0 -> Result check Int
getOffset0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
n0forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index sh1 -> Result check Int
getOffset1))
inBounds :: (sh0 ::+ sh1) -> Index (sh0 ::+ sh1) -> Bool
inBounds (sh0
sh0::+sh1
sh1) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh0
sh0) (forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds sh1
sh1)
instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0::+sh1) where
unifiedIndexFromOffset :: forall check.
Checking check =>
(sh0 ::+ sh1) -> Int -> Result check (Index (sh0 ::+ sh1))
unifiedIndexFromOffset (sh0
sh0::+sh1
sh1) =
let pivot :: Int
pivot = forall sh. C sh => sh -> Int
size sh0
sh0
in \Int
k ->
if Int
k forall a. Ord a => a -> a -> Bool
< Int
pivot
then forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh0
sh0 Int
k
else forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset sh1
sh1 (Int
kforall a. Num a => a -> a -> a
-Int
pivot)
instance (Static sh0, Static sh1) => Static (sh0::+sh1) where
static :: sh0 ::+ sh1
static = forall sh. Static sh => sh
staticforall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+forall sh. Static sh => sh
static
instance (Pattern sh0, Pattern sh1) => Pattern (sh0::+sh1) where
type DataPattern (sh0::+sh1) x = DataPattern sh0 x ::+ DataPattern sh1 x
indexPattern :: forall x.
(Index (sh0 ::+ sh1) -> x)
-> (sh0 ::+ sh1) -> DataPattern (sh0 ::+ sh1) x
indexPattern Index (sh0 ::+ sh1) -> x
extend (sh0
sh0::+sh1
sh1) =
forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (Index (sh0 ::+ sh1) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) sh0
sh0 forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern (Index (sh0 ::+ sh1) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) sh1
sh1
infixl 7 |*
infixl 6 |+|
(|*) :: (Functor f, Num a) => f a -> a -> f a
f a
f|* :: forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
|*a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
*a
a) f a
f
(|+|) :: (Applicative f, Num a) => f a -> f a -> f a
|+| :: forall (f :: * -> *) a. (Applicative f, Num a) => f a -> f a -> f a
(|+|) = forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 forall a. Num a => a -> a -> a
(+)
newtype NestedTuple ixtype tuple = NestedTuple {forall ixtype tuple. NestedTuple ixtype tuple -> tuple
getNestedTuple :: tuple}
deriving (NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ixtype tuple.
Eq tuple =>
NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
/= :: NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
$c/= :: forall ixtype tuple.
Eq tuple =>
NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
== :: NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
$c== :: forall ixtype tuple.
Eq tuple =>
NestedTuple ixtype tuple -> NestedTuple ixtype tuple -> Bool
Eq, Int -> NestedTuple ixtype tuple -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall ixtype tuple.
Show tuple =>
Int -> NestedTuple ixtype tuple -> String -> String
forall ixtype tuple.
Show tuple =>
[NestedTuple ixtype tuple] -> String -> String
forall ixtype tuple.
Show tuple =>
NestedTuple ixtype tuple -> String
showList :: [NestedTuple ixtype tuple] -> String -> String
$cshowList :: forall ixtype tuple.
Show tuple =>
[NestedTuple ixtype tuple] -> String -> String
show :: NestedTuple ixtype tuple -> String
$cshow :: forall ixtype tuple.
Show tuple =>
NestedTuple ixtype tuple -> String
showsPrec :: Int -> NestedTuple ixtype tuple -> String -> String
$cshowsPrec :: forall ixtype tuple.
Show tuple =>
Int -> NestedTuple ixtype tuple -> String -> String
Show)
data TupleAccessor
data TupleIndex
newtype Element = Element Int
deriving (Element -> Element -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Int -> Element -> String -> String
[Element] -> String -> String
Element -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Element] -> String -> String
$cshowList :: [Element] -> String -> String
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> String -> String
$cshowsPrec :: Int -> Element -> String -> String
Show)
instance NFData Element where
rnf :: Element -> ()
rnf (Element Int
k) = forall a. NFData a => a -> ()
rnf Int
k
class ElementTuple tuple where
type DataTuple tuple x
indexTupleA ::
(Applicative f) => (Element -> f a) -> tuple -> f (DataTuple tuple a)
tupleSize :: (ElementTuple tuple) => tuple -> Int
tupleSize :: forall tuple. ElementTuple tuple => tuple -> Int
tupleSize =
forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> w
MW.execWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA (\Element
x -> forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
MW.tell (forall a. a -> Sum a
Sum Int
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Element
x)
indexTuple ::
(ElementTuple tuple) => (Element -> a) -> tuple -> DataTuple tuple a
indexTuple :: forall tuple a.
ElementTuple tuple =>
(Element -> a) -> tuple -> DataTuple tuple a
indexTuple Element -> a
extend = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> a
extend)
instance (ElementTuple tuple) => NFData (NestedTuple ixtype tuple) where
rnf :: NestedTuple ixtype tuple -> ()
rnf (NestedTuple tuple
tuple) =
forall a. StrictUnitWriter a -> ()
execStrictUnitWriter forall a b. (a -> b) -> a -> b
$ forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA ((forall a. a -> StrictUnitWriter a
StrictUnitWriterforall a b. (a -> b) -> a -> b
$!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> ()
rnf) tuple
tuple
data StrictUnitWriter a = StrictUnitWriter a
execStrictUnitWriter :: StrictUnitWriter a -> ()
execStrictUnitWriter :: forall a. StrictUnitWriter a -> ()
execStrictUnitWriter (StrictUnitWriter a
_) = ()
instance Functor StrictUnitWriter where
fmap :: forall a b. (a -> b) -> StrictUnitWriter a -> StrictUnitWriter b
fmap a -> b
f (StrictUnitWriter a
a) = forall a. a -> StrictUnitWriter a
StrictUnitWriter forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
instance Applicative StrictUnitWriter where
pure :: forall a. a -> StrictUnitWriter a
pure = forall a. a -> StrictUnitWriter a
StrictUnitWriter
StrictUnitWriter a -> b
f <*> :: forall a b.
StrictUnitWriter (a -> b)
-> StrictUnitWriter a -> StrictUnitWriter b
<*> StrictUnitWriter a
a = forall a. a -> StrictUnitWriter a
StrictUnitWriter forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
instance Monad StrictUnitWriter where
return :: forall a. a -> StrictUnitWriter a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
StrictUnitWriter a
a >>= :: forall a b.
StrictUnitWriter a
-> (a -> StrictUnitWriter b) -> StrictUnitWriter b
>>= a -> StrictUnitWriter b
k = a -> StrictUnitWriter b
k a
a
class (ElementTuple tuple) => AccessorTuple tuple where
tupleAccessors :: tuple -> [tuple -> Element]
class (ElementTuple tuple, Eq tuple) => StaticTuple tuple where
staticTuple :: MS.State Element tuple
instance ElementTuple () where
type DataTuple () x = ()
indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> () -> f (DataTuple () a)
indexTupleA Element -> f a
_ () = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance AccessorTuple () where
tupleAccessors :: () -> [() -> Element]
tupleAccessors () = []
instance StaticTuple () where
staticTuple :: State Element ()
staticTuple = forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance ElementTuple Element where
type DataTuple Element x = x
indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> Element -> f (DataTuple Element a)
indexTupleA Element -> f a
extend = Element -> f a
extend
instance AccessorTuple Element where
tupleAccessors :: Element -> [Element -> Element]
tupleAccessors Element
_ = [forall a. a -> a
id]
instance StaticTuple Element where
staticTuple :: State Element Element
staticTuple = do
Element
ix <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (\(Element Int
k) -> Int -> Element
Element (Int
kforall a. Num a => a -> a -> a
+Int
1))
forall (m :: * -> *) a. Monad m => a -> m a
return Element
ix
instance (ElementTuple a, ElementTuple b) => ElementTuple (a,b) where
type DataTuple (a,b) x = (DataTuple a x, DataTuple b x)
indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> (a, b) -> f (DataTuple (a, b) a)
indexTupleA Element -> f a
extend (a
a,b
b) =
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend b
b)
instance (AccessorTuple a, AccessorTuple b) => AccessorTuple (a,b) where
tupleAccessors :: (a, b) -> [(a, b) -> Element]
tupleAccessors (a
a,b
b) =
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b)
instance (StaticTuple a, StaticTuple b) => StaticTuple (a,b) where
staticTuple :: State Element (a, b)
staticTuple = forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple
instance
(ElementTuple a, ElementTuple b, ElementTuple c) =>
ElementTuple (a,b,c) where
type DataTuple (a,b,c) x = (DataTuple a x, DataTuple b x, DataTuple c x)
indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> (a, b, c) -> f (DataTuple (a, b, c) a)
indexTupleA Element -> f a
extend (a
a,b
b,c
c) =
forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,)
(forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend b
b) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend c
c)
instance
(AccessorTuple a, AccessorTuple b, AccessorTuple c) =>
AccessorTuple (a,b,c) where
tupleAccessors :: (a, b, c) -> [(a, b, c) -> Element]
tupleAccessors (a
a,b
b,c
c) =
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> a
fst3) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> b
snd3) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b c. (a, b, c) -> c
thd3) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors c
c)
instance
(StaticTuple a, StaticTuple b, StaticTuple c) =>
StaticTuple (a,b,c) where
staticTuple :: State Element (a, b, c)
staticTuple = forall (m :: * -> *) a b c r.
Applicative m =>
(a -> b -> c -> r) -> m a -> m b -> m c -> m r
App.lift3 (,,) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple
instance
(ElementTuple a, ElementTuple b, ElementTuple c, ElementTuple d) =>
ElementTuple (a,b,c,d) where
type DataTuple (a,b,c,d) x =
(DataTuple a x, DataTuple b x, DataTuple c x, DataTuple d x)
indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> (a, b, c, d) -> f (DataTuple (a, b, c, d) a)
indexTupleA Element -> f a
extend (a
a,b
b,c
c,d
d) =
forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 (,,,)
(forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend b
b)
(forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend c
c) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend d
d)
instance
(AccessorTuple a, AccessorTuple b, AccessorTuple c, AccessorTuple d) =>
AccessorTuple (a,b,c,d) where
tupleAccessors :: (a, b, c, d) -> [(a, b, c, d) -> Element]
tupleAccessors (a
a,b
b,c
c,d
d) =
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
i,b
_,c
_,d
_) -> a
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
i,c
_,d
_) -> b
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors b
b) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
_,c
i,d
_) -> c
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors c
c) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(a
_,b
_,c
_,d
i) -> d
i)) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors d
d)
instance
(StaticTuple a, StaticTuple b, StaticTuple c, StaticTuple d) =>
StaticTuple (a,b,c,d) where
staticTuple :: State Element (a, b, c, d)
staticTuple = forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 (,,,) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple
instance (ElementTuple a) => ElementTuple (Complex a) where
type DataTuple (Complex a) x = Complex (DataTuple a x)
indexTupleA :: forall (f :: * -> *) a.
Applicative f =>
(Element -> f a) -> Complex a -> f (DataTuple (Complex a) a)
indexTupleA Element -> f a
extend (a
a:+a
b) =
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 forall a. a -> a -> Complex a
(:+) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
a) (forall tuple (f :: * -> *) a.
(ElementTuple tuple, Applicative f) =>
(Element -> f a) -> tuple -> f (DataTuple tuple a)
indexTupleA Element -> f a
extend a
b)
instance (AccessorTuple a) => AccessorTuple (Complex a) where
tupleAccessors :: Complex a -> [Complex a -> Element]
tupleAccessors (a
a:+a
b) =
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Complex a -> a
realPart) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
a) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Complex a -> a
imagPart) (forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors a
b)
instance (StaticTuple a) => StaticTuple (Complex a) where
staticTuple :: State Element (Complex a)
staticTuple = forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 forall a. a -> a -> Complex a
(:+) forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall tuple. StaticTuple tuple => State Element tuple
staticTuple
instance (ElementTuple tuple) => C (NestedTuple ixtype tuple) where
size :: NestedTuple ixtype tuple -> Int
size (NestedTuple tuple
tuple) = forall tuple. ElementTuple tuple => tuple -> Int
tupleSize tuple
tuple
instance (StaticTuple tuple) => Static (NestedTuple ixtype tuple) where
static :: NestedTuple ixtype tuple
static = forall ixtype tuple. tuple -> NestedTuple ixtype tuple
NestedTuple forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> a
MS.evalState forall tuple. StaticTuple tuple => State Element tuple
staticTuple forall a b. (a -> b) -> a -> b
$ Int -> Element
Element Int
0
instance (AccessorTuple tuple) => Indexed (NestedTuple TupleAccessor tuple) where
type Index (NestedTuple TupleAccessor tuple) = tuple -> Element
indices :: NestedTuple TupleAccessor tuple
-> [Index (NestedTuple TupleAccessor tuple)]
indices (NestedTuple tuple
tuple) = forall tuple. AccessorTuple tuple => tuple -> [tuple -> Element]
tupleAccessors tuple
tuple
unifiedOffset :: forall check.
Checking check =>
NestedTuple TupleAccessor tuple
-> Index (NestedTuple TupleAccessor tuple) -> Result check Int
unifiedOffset (NestedTuple tuple
tuple) Index (NestedTuple TupleAccessor tuple)
ix =
case Index (NestedTuple TupleAccessor tuple)
ix tuple
tuple of Element Int
k -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
newtype ElementIndex tuple = ElementIndex Int
deriving (ElementIndex tuple -> ElementIndex tuple -> Bool
forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c/= :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
== :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c== :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
Eq, ElementIndex tuple -> ElementIndex tuple -> Bool
ElementIndex tuple -> ElementIndex tuple -> Ordering
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
forall tuple. Eq (ElementIndex tuple)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
forall tuple. ElementIndex tuple -> ElementIndex tuple -> Ordering
forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
min :: ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
$cmin :: forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
max :: ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
$cmax :: forall tuple.
ElementIndex tuple -> ElementIndex tuple -> ElementIndex tuple
>= :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c>= :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
> :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c> :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
<= :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c<= :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
< :: ElementIndex tuple -> ElementIndex tuple -> Bool
$c< :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Bool
compare :: ElementIndex tuple -> ElementIndex tuple -> Ordering
$ccompare :: forall tuple. ElementIndex tuple -> ElementIndex tuple -> Ordering
Ord, Int -> ElementIndex tuple -> String -> String
forall tuple. Int -> ElementIndex tuple -> String -> String
forall tuple. [ElementIndex tuple] -> String -> String
forall tuple. ElementIndex tuple -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ElementIndex tuple] -> String -> String
$cshowList :: forall tuple. [ElementIndex tuple] -> String -> String
show :: ElementIndex tuple -> String
$cshow :: forall tuple. ElementIndex tuple -> String
showsPrec :: Int -> ElementIndex tuple -> String -> String
$cshowsPrec :: forall tuple. Int -> ElementIndex tuple -> String -> String
Show)
instance (ElementTuple tuple) => Indexed (NestedTuple TupleIndex tuple) where
type Index (NestedTuple TupleIndex tuple) = ElementIndex tuple
indices :: NestedTuple TupleIndex tuple
-> [Index (NestedTuple TupleIndex tuple)]
indices (NestedTuple tuple
tuple) =
forall a b. (a -> b) -> [a] -> [b]
map forall tuple. Int -> ElementIndex tuple
ElementIndex forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall tuple. ElementTuple tuple => tuple -> Int
tupleSize tuple
tuple) [Int
0..]
unifiedOffset :: forall check.
Checking check =>
NestedTuple TupleIndex tuple
-> Index (NestedTuple TupleIndex tuple) -> Result check Int
unifiedOffset (NestedTuple tuple
_tuple) (ElementIndex Int
k) = forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
instance (ElementTuple tuple) => Pattern (NestedTuple TupleIndex tuple) where
type DataPattern (NestedTuple TupleIndex tuple) x = DataTuple tuple x
indexPattern :: forall x.
(Index (NestedTuple TupleIndex tuple) -> x)
-> NestedTuple TupleIndex tuple
-> DataPattern (NestedTuple TupleIndex tuple) x
indexPattern Index (NestedTuple TupleIndex tuple) -> x
extend (NestedTuple tuple
tuple) =
let elemIx :: tuple -> Element -> ElementIndex tuple
elemIx :: forall tuple. tuple -> Element -> ElementIndex tuple
elemIx tuple
_ (Element Int
k) = forall tuple. Int -> ElementIndex tuple
ElementIndex Int
k
in forall tuple a.
ElementTuple tuple =>
(Element -> a) -> tuple -> DataTuple tuple a
indexTuple (Index (NestedTuple TupleIndex tuple) -> x
extend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tuple. tuple -> Element -> ElementIndex tuple
elemIx tuple
tuple) tuple
tuple
indexTupleFromShape ::
(ElementTuple tuple) =>
NestedTuple TupleIndex tuple -> DataTuple tuple (ElementIndex tuple)
indexTupleFromShape :: forall tuple.
ElementTuple tuple =>
NestedTuple TupleIndex tuple
-> DataTuple tuple (ElementIndex tuple)
indexTupleFromShape = forall sh x.
Pattern sh =>
(Index sh -> x) -> sh -> DataPattern sh x
indexPattern forall a. a -> a
id
nextCounter :: MS.State Int Int
nextCounter :: StateT Int Identity Int
nextCounter = do Int
k <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get; forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put (Int
kforall a. Num a => a -> a -> a
+Int
1); forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
newtype Record f = Record {forall (f :: * -> *). Record f -> f Element
getRecord :: f Element}
instance (Foldable f) => Eq (Record f) where
Record f Element
sh0 == :: Record f -> Record f -> Bool
== Record f Element
sh1 = forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f Element
sh0 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f Element
sh1
newtype FieldIndex (f :: * -> *) = FieldIndex Int
deriving (FieldIndex f -> FieldIndex f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *). FieldIndex f -> FieldIndex f -> Bool
/= :: FieldIndex f -> FieldIndex f -> Bool
$c/= :: forall (f :: * -> *). FieldIndex f -> FieldIndex f -> Bool
== :: FieldIndex f -> FieldIndex f -> Bool
$c== :: forall (f :: * -> *). FieldIndex f -> FieldIndex f -> Bool
Eq, Int -> FieldIndex f -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (f :: * -> *). Int -> FieldIndex f -> String -> String
forall (f :: * -> *). [FieldIndex f] -> String -> String
forall (f :: * -> *). FieldIndex f -> String
showList :: [FieldIndex f] -> String -> String
$cshowList :: forall (f :: * -> *). [FieldIndex f] -> String -> String
show :: FieldIndex f -> String
$cshow :: forall (f :: * -> *). FieldIndex f -> String
showsPrec :: Int -> FieldIndex f -> String -> String
$cshowsPrec :: forall (f :: * -> *). Int -> FieldIndex f -> String -> String
Show)
instance (Foldable f) => C (Record f) where
size :: Record f -> Int
size = forall (f :: * -> *) a. Foldable f => f a -> Int
foldLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Record f -> f Element
getRecord
instance (Applicative f, Traversable f) => Static (Record f) where
static :: Record f
static =
forall (f :: * -> *). f Element -> Record f
Record forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
MS.evalState Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Trav.sequence forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Element
Element StateT Int Identity Int
nextCounter)
instance (Foldable f) => Indexed (Record f) where
type Index (Record f) = FieldIndex f
indices :: Record f -> [Index (Record f)]
indices (Record f Element
xs) = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). Int -> FieldIndex f
FieldIndex forall a b. (a -> b) -> a -> b
$ forall b a. [b] -> [a] -> [a]
Match.take (forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f Element
xs) [Int
0..]
unifiedOffset :: forall check.
Checking check =>
Record f -> Index (Record f) -> Result check Int
unifiedOffset (Record f Element
_xs) (FieldIndex Int
k) = forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
indexRecordFromShape ::
(Traversable f) =>
Record f -> f (FieldIndex f)
indexRecordFromShape :: forall (f :: * -> *). Traversable f => Record f -> f (FieldIndex f)
indexRecordFromShape (Record f Element
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Element Int
k) -> forall (f :: * -> *). Int -> FieldIndex f
FieldIndex Int
k) f Element
xs
newtype Constructed tag = Constructed {forall tag. Constructed tag -> Int
constructedSize :: Int}
deriving (Constructed tag -> Constructed tag -> Bool
forall tag. Constructed tag -> Constructed tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructed tag -> Constructed tag -> Bool
$c/= :: forall tag. Constructed tag -> Constructed tag -> Bool
== :: Constructed tag -> Constructed tag -> Bool
$c== :: forall tag. Constructed tag -> Constructed tag -> Bool
Eq, Int -> Constructed tag -> String -> String
forall tag. Int -> Constructed tag -> String -> String
forall tag. [Constructed tag] -> String -> String
forall tag. Constructed tag -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Constructed tag] -> String -> String
$cshowList :: forall tag. [Constructed tag] -> String -> String
show :: Constructed tag -> String
$cshow :: forall tag. Constructed tag -> String
showsPrec :: Int -> Constructed tag -> String -> String
$cshowsPrec :: forall tag. Int -> Constructed tag -> String -> String
Show)
newtype ConsIndex tag = ConsIndex Int
deriving (ConsIndex tag -> ConsIndex tag -> Bool
forall tag. ConsIndex tag -> ConsIndex tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsIndex tag -> ConsIndex tag -> Bool
$c/= :: forall tag. ConsIndex tag -> ConsIndex tag -> Bool
== :: ConsIndex tag -> ConsIndex tag -> Bool
$c== :: forall tag. ConsIndex tag -> ConsIndex tag -> Bool
Eq, Int -> ConsIndex tag -> String -> String
forall tag. Int -> ConsIndex tag -> String -> String
forall tag. [ConsIndex tag] -> String -> String
forall tag. ConsIndex tag -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ConsIndex tag] -> String -> String
$cshowList :: forall tag. [ConsIndex tag] -> String -> String
show :: ConsIndex tag -> String
$cshow :: forall tag. ConsIndex tag -> String
showsPrec :: Int -> ConsIndex tag -> String -> String
$cshowsPrec :: forall tag. Int -> ConsIndex tag -> String -> String
Show)
newtype Construction tag a = Construction (MS.State Int a)
instance Functor (Construction tag) where
fmap :: forall a b. (a -> b) -> Construction tag a -> Construction tag b
fmap a -> b
f (Construction State Int a
m) = forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f State Int a
m
instance Applicative (Construction tag) where
pure :: forall a. a -> Construction tag a
pure = forall tag a. State Int a -> Construction tag a
Construction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
Construction State Int (a -> b)
f <*> :: forall a b.
Construction tag (a -> b)
-> Construction tag a -> Construction tag b
<*> Construction State Int a
a = forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ State Int (a -> b)
fforall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>State Int a
a
instance Monad (Construction tag) where
return :: forall a. a -> Construction tag a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Construction State Int a
am >>= :: forall a b.
Construction tag a
-> (a -> Construction tag b) -> Construction tag b
>>= a -> Construction tag b
k =
forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ State Int a
am forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> case a -> Construction tag b
k a
a of Construction StateT Int Identity b
bm -> StateT Int Identity b
bm
construct :: Construction tag a -> (Constructed tag, a)
construct :: forall tag a. Construction tag a -> (Constructed tag, a)
construct (Construction State Int a
m) =
case forall s a. State s a -> s -> (a, s)
MS.runState State Int a
m Int
0 of (a
a, Int
sz) -> (forall tag. Int -> Constructed tag
Constructed Int
sz, a
a)
consIndex :: Construction tag (ConsIndex tag)
consIndex :: forall tag. Construction tag (ConsIndex tag)
consIndex = forall tag a. State Int a -> Construction tag a
Construction forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall tag. Int -> ConsIndex tag
ConsIndex StateT Int Identity Int
nextCounter
instance C (Constructed tag) where
size :: Constructed tag -> Int
size = forall tag. Constructed tag -> Int
constructedSize
instance Indexed (Constructed tag) where
type Index (Constructed tag) = ConsIndex tag
indices :: Constructed tag -> [Index (Constructed tag)]
indices (Constructed Int
len) = forall a b. (a -> b) -> [a] -> [b]
map forall tag. Int -> ConsIndex tag
ConsIndex forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
len [Int
0..]
unifiedOffset :: forall check.
Checking check =>
Constructed tag -> Index (Constructed tag) -> Result check Int
unifiedOffset (Constructed Int
len) =
let f :: Index (ZeroBased Int) -> Result check Int
f = forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
unifiedOffset (forall n. n -> ZeroBased n
ZeroBased Int
len) in \(ConsIndex Int
k) -> Index (ZeroBased Int) -> Result check Int
f Int
k
inBounds :: Constructed tag -> Index (Constructed tag) -> Bool
inBounds (Constructed Int
len) (ConsIndex Int
ix) = forall sh. Indexed sh => sh -> Index sh -> Bool
inBounds (forall n. n -> ZeroBased n
ZeroBased Int
len) Int
ix
instance InvIndexed (Constructed tag) where
unifiedIndexFromOffset :: forall check.
Checking check =>
Constructed tag -> Int -> Result check (Index (Constructed tag))
unifiedIndexFromOffset (Constructed Int
len) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall tag. Int -> ConsIndex tag
ConsIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
unifiedIndexFromOffset (forall n. n -> ZeroBased n
ZeroBased Int
len)