module Data.PrimitiveArray.Index.Class where

import           Control.Applicative
import           Control.DeepSeq (NFData(..))
import           Control.Lens hiding (Index, (:>))
import           Control.Monad.Except
import           Control.Monad (liftM2)
import           Data.Aeson
import           Data.Binary
import           Data.Data
import           Data.Hashable (Hashable)
import           Data.Proxy
import           Data.Serialize
import           Data.Typeable
import           Data.Vector.Fusion.Stream.Monadic (Stream)
import           Data.Vector.Unboxed.Deriving
import           Data.Vector.Unboxed (Unbox(..))
import           GHC.Base (quotRemInt)
import           GHC.Generics
import           GHC.TypeNats
import qualified Data.Vector.Fusion.Stream.Monadic as SM
import           Test.QuickCheck
import           Text.Printf
import           Data.Type.Equality



infixl 3 :.

-- | Strict pairs -- as in @repa@.

data a :. b = !a :. !b
  deriving ((a :. b) -> (a :. b) -> Bool
((a :. b) -> (a :. b) -> Bool)
-> ((a :. b) -> (a :. b) -> Bool) -> Eq (a :. b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :. b) -> (a :. b) -> Bool
/= :: (a :. b) -> (a :. b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :. b) -> (a :. b) -> Bool
== :: (a :. b) -> (a :. b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :. b) -> (a :. b) -> Bool
Eq,Eq (a :. b)
Eq (a :. b)
-> ((a :. b) -> (a :. b) -> Ordering)
-> ((a :. b) -> (a :. b) -> Bool)
-> ((a :. b) -> (a :. b) -> Bool)
-> ((a :. b) -> (a :. b) -> Bool)
-> ((a :. b) -> (a :. b) -> Bool)
-> ((a :. b) -> (a :. b) -> a :. b)
-> ((a :. b) -> (a :. b) -> a :. b)
-> Ord (a :. b)
(a :. b) -> (a :. b) -> Bool
(a :. b) -> (a :. b) -> Ordering
(a :. b) -> (a :. b) -> a :. b
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 a b. (Ord a, Ord b) => Eq (a :. b)
forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> Bool
forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> Ordering
forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> a :. b
min :: (a :. b) -> (a :. b) -> a :. b
$cmin :: forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> a :. b
max :: (a :. b) -> (a :. b) -> a :. b
$cmax :: forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> a :. b
>= :: (a :. b) -> (a :. b) -> Bool
$c>= :: forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> Bool
> :: (a :. b) -> (a :. b) -> Bool
$c> :: forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> Bool
<= :: (a :. b) -> (a :. b) -> Bool
$c<= :: forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> Bool
< :: (a :. b) -> (a :. b) -> Bool
$c< :: forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> Bool
compare :: (a :. b) -> (a :. b) -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => (a :. b) -> (a :. b) -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (a :. b)
Ord,Int -> (a :. b) -> ShowS
[a :. b] -> ShowS
(a :. b) -> String
(Int -> (a :. b) -> ShowS)
-> ((a :. b) -> String) -> ([a :. b] -> ShowS) -> Show (a :. b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a :. b) -> ShowS
forall a b. (Show a, Show b) => [a :. b] -> ShowS
forall a b. (Show a, Show b) => (a :. b) -> String
showList :: [a :. b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [a :. b] -> ShowS
show :: (a :. b) -> String
$cshow :: forall a b. (Show a, Show b) => (a :. b) -> String
showsPrec :: Int -> (a :. b) -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a :. b) -> ShowS
Show,(forall x. (a :. b) -> Rep (a :. b) x)
-> (forall x. Rep (a :. b) x -> a :. b) -> Generic (a :. b)
forall x. Rep (a :. b) x -> a :. b
forall x. (a :. b) -> Rep (a :. b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (a :. b) x -> a :. b
forall a b x. (a :. b) -> Rep (a :. b) x
$cto :: forall a b x. Rep (a :. b) x -> a :. b
$cfrom :: forall a b x. (a :. b) -> Rep (a :. b) x
Generic,Typeable (a :. b)
DataType
Constr
Typeable (a :. b)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> (a :. b) -> c (a :. b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (a :. b))
-> ((a :. b) -> Constr)
-> ((a :. b) -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (a :. b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :. b)))
-> ((forall b. Data b => b -> b) -> (a :. b) -> a :. b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> (a :. b) -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> (a :. b) -> r)
-> (forall u. (forall d. Data d => d -> u) -> (a :. b) -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> (a :. b) -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b))
-> Data (a :. b)
(a :. b) -> DataType
(a :. b) -> Constr
(forall b. Data b => b -> b) -> (a :. b) -> a :. b
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :. b) -> c (a :. b)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :. b)
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :. b))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> (a :. b) -> u
forall u. (forall d. Data d => d -> u) -> (a :. b) -> [u]
forall a b. (Data a, Data b) => Typeable (a :. b)
forall a b. (Data a, Data b) => (a :. b) -> DataType
forall a b. (Data a, Data b) => (a :. b) -> Constr
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> (a :. b) -> a :. b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> (a :. b) -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> (a :. b) -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :. b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :. b) -> c (a :. b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (a :. b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :. b))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :. b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :. b) -> c (a :. b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (a :. b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :. b))
$c:. :: Constr
$t:. :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
gmapMp :: (forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
gmapM :: (forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> (a :. b) -> m (a :. b)
gmapQi :: Int -> (forall d. Data d => d -> u) -> (a :. b) -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> (a :. b) -> u
gmapQ :: (forall d. Data d => d -> u) -> (a :. b) -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> (a :. b) -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :. b) -> r
gmapT :: (forall b. Data b => b -> b) -> (a :. b) -> a :. b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> (a :. b) -> a :. b
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :. b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :. b))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (a :. b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (a :. b))
dataTypeOf :: (a :. b) -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => (a :. b) -> DataType
toConstr :: (a :. b) -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => (a :. b) -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :. b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :. b)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :. b) -> c (a :. b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :. b) -> c (a :. b)
$cp1Data :: forall a b. (Data a, Data b) => Typeable (a :. b)
Data,Typeable)

derivingUnbox "StrictPair"
  [t| forall a b . (Unbox a, Unbox b) => (a:.b) -> (a,b) |]
  [| \(a:.b) -> (a, b) |]
  [| \(a,b)  -> (a:.b) |]

instance (Binary    a, Binary    b) => Binary    (a:.b)
instance (Serialize a, Serialize b) => Serialize (a:.b)
instance (ToJSON    a, ToJSON    b) => ToJSON    (a:.b)
instance (FromJSON  a, FromJSON  b) => FromJSON  (a:.b)
instance (Hashable  a, Hashable  b) => Hashable  (a:.b)

instance (ToJSON a  , ToJSONKey   a, ToJSON b  , ToJSONKey   b) => ToJSONKey   (a:.b)
instance (FromJSON a, FromJSONKey a, FromJSON b, FromJSONKey b) => FromJSONKey (a:.b)

deriving instance (Read a, Read b) => Read (a:.b)

instance (NFData a, NFData b) => NFData (a:.b) where
  rnf :: (a :. b) -> ()
rnf (a
a:.b
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` b -> ()
forall a. NFData a => a -> ()
rnf b
b
  {-# Inline rnf #-}

instance (Arbitrary a, Arbitrary b) => Arbitrary (a :. b) where
  arbitrary :: Gen (a :. b)
arbitrary     = (a -> b -> a :. b) -> Gen a -> Gen b -> Gen (a :. b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> a :. b
forall a b. a -> b -> a :. b
(:.) Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: (a :. b) -> [a :. b]
shrink (a
a:.b
b) = [ (a
a'a -> b -> a :. b
forall a b. a -> b -> a :. b
:.b
b) | a
a' <- a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
a ] [a :. b] -> [a :. b] -> [a :. b]
forall a. [a] -> [a] -> [a]
++ [ (a
aa -> b -> a :. b
forall a b. a -> b -> a :. b
:.b
b') | b
b' <- b -> [b]
forall a. Arbitrary a => a -> [a]
shrink b
b ]

infixr 3 :>

-- | A different version of strict pairs. Makes for simpler type inference in
-- multi-tape grammars. We use @:>@ when we have special needs, like
-- non-recursive instances on inductives tuples, as used for set indices.
--
-- This one is @infixr@ so that in @a :> b@ we can have the main type in
-- @a@ and the specializing types in @b@ and then dispatch on @a :> ts@
-- with @ts@ maybe a chain of @:>@.

data a :> b = !a :> !b
  deriving ((a :> b) -> (a :> b) -> Bool
((a :> b) -> (a :> b) -> Bool)
-> ((a :> b) -> (a :> b) -> Bool) -> Eq (a :> b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :> b) -> (a :> b) -> Bool
/= :: (a :> b) -> (a :> b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :> b) -> (a :> b) -> Bool
== :: (a :> b) -> (a :> b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :> b) -> (a :> b) -> Bool
Eq,Eq (a :> b)
Eq (a :> b)
-> ((a :> b) -> (a :> b) -> Ordering)
-> ((a :> b) -> (a :> b) -> Bool)
-> ((a :> b) -> (a :> b) -> Bool)
-> ((a :> b) -> (a :> b) -> Bool)
-> ((a :> b) -> (a :> b) -> Bool)
-> ((a :> b) -> (a :> b) -> a :> b)
-> ((a :> b) -> (a :> b) -> a :> b)
-> Ord (a :> b)
(a :> b) -> (a :> b) -> Bool
(a :> b) -> (a :> b) -> Ordering
(a :> b) -> (a :> b) -> a :> b
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 a b. (Ord a, Ord b) => Eq (a :> b)
forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> Bool
forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> Ordering
forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> a :> b
min :: (a :> b) -> (a :> b) -> a :> b
$cmin :: forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> a :> b
max :: (a :> b) -> (a :> b) -> a :> b
$cmax :: forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> a :> b
>= :: (a :> b) -> (a :> b) -> Bool
$c>= :: forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> Bool
> :: (a :> b) -> (a :> b) -> Bool
$c> :: forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> Bool
<= :: (a :> b) -> (a :> b) -> Bool
$c<= :: forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> Bool
< :: (a :> b) -> (a :> b) -> Bool
$c< :: forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> Bool
compare :: (a :> b) -> (a :> b) -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => (a :> b) -> (a :> b) -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (a :> b)
Ord,Int -> (a :> b) -> ShowS
[a :> b] -> ShowS
(a :> b) -> String
(Int -> (a :> b) -> ShowS)
-> ((a :> b) -> String) -> ([a :> b] -> ShowS) -> Show (a :> b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a :> b) -> ShowS
forall a b. (Show a, Show b) => [a :> b] -> ShowS
forall a b. (Show a, Show b) => (a :> b) -> String
showList :: [a :> b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [a :> b] -> ShowS
show :: (a :> b) -> String
$cshow :: forall a b. (Show a, Show b) => (a :> b) -> String
showsPrec :: Int -> (a :> b) -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a :> b) -> ShowS
Show,(forall x. (a :> b) -> Rep (a :> b) x)
-> (forall x. Rep (a :> b) x -> a :> b) -> Generic (a :> b)
forall x. Rep (a :> b) x -> a :> b
forall x. (a :> b) -> Rep (a :> b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (a :> b) x -> a :> b
forall a b x. (a :> b) -> Rep (a :> b) x
$cto :: forall a b x. Rep (a :> b) x -> a :> b
$cfrom :: forall a b x. (a :> b) -> Rep (a :> b) x
Generic,Typeable (a :> b)
DataType
Constr
Typeable (a :> b)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> (a :> b) -> c (a :> b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (a :> b))
-> ((a :> b) -> Constr)
-> ((a :> b) -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (a :> b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :> b)))
-> ((forall b. Data b => b -> b) -> (a :> b) -> a :> b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> (a :> b) -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> (a :> b) -> r)
-> (forall u. (forall d. Data d => d -> u) -> (a :> b) -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> (a :> b) -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b))
-> Data (a :> b)
(a :> b) -> DataType
(a :> b) -> Constr
(forall b. Data b => b -> b) -> (a :> b) -> a :> b
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :> b) -> c (a :> b)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :> b)
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :> b))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> (a :> b) -> u
forall u. (forall d. Data d => d -> u) -> (a :> b) -> [u]
forall a b. (Data a, Data b) => Typeable (a :> b)
forall a b. (Data a, Data b) => (a :> b) -> DataType
forall a b. (Data a, Data b) => (a :> b) -> Constr
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> (a :> b) -> a :> b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> (a :> b) -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> (a :> b) -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :> b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :> b) -> c (a :> b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (a :> b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :> b))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :> b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :> b) -> c (a :> b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (a :> b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :> b))
$c:> :: Constr
$t:> :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
gmapMp :: (forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
gmapM :: (forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> (a :> b) -> m (a :> b)
gmapQi :: Int -> (forall d. Data d => d -> u) -> (a :> b) -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> (a :> b) -> u
gmapQ :: (forall d. Data d => d -> u) -> (a :> b) -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> (a :> b) -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> (a :> b) -> r
gmapT :: (forall b. Data b => b -> b) -> (a :> b) -> a :> b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> (a :> b) -> a :> b
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :> b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (a :> b))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (a :> b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (a :> b))
dataTypeOf :: (a :> b) -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => (a :> b) -> DataType
toConstr :: (a :> b) -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => (a :> b) -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :> b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (a :> b)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :> b) -> c (a :> b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> (a :> b) -> c (a :> b)
$cp1Data :: forall a b. (Data a, Data b) => Typeable (a :> b)
Data,Typeable)

derivingUnbox "StrictIxPair"
  [t| forall a b . (Unbox a, Unbox b) => (a:>b) -> (a,b) |]
  [| \(a:>b) -> (a, b) |]
  [| \(a,b)  -> (a:>b) |]

instance (Binary    a, Binary    b) => Binary    (a:>b)
instance (Serialize a, Serialize b) => Serialize (a:>b)
instance (ToJSON    a, ToJSON    b) => ToJSON    (a:>b)
instance (FromJSON  a, FromJSON  b) => FromJSON  (a:>b)
instance (Hashable  a, Hashable  b) => Hashable  (a:>b)

deriving instance (Read a, Read b) => Read (a:>b)

instance (NFData a, NFData b) => NFData (a:>b) where
  rnf :: (a :> b) -> ()
rnf (a
a:>b
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` b -> ()
forall a. NFData a => a -> ()
rnf b
b
  {-# Inline rnf #-}

--instance (Arbitrary a, Arbitrary b) => Arbitrary (a :> b) where
--  arbitrary = (:>) <$> arbitrary <*> arbitrary
--  shrink (a:>b) = (:>) <$> shrink a <*> shrink b



-- | Base data constructor for multi-dimensional indices.

data Z = Z
  deriving (Z -> Z -> Bool
(Z -> Z -> Bool) -> (Z -> Z -> Bool) -> Eq Z
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Z -> Z -> Bool
$c/= :: Z -> Z -> Bool
== :: Z -> Z -> Bool
$c== :: Z -> Z -> Bool
Eq,Eq Z
Eq Z
-> (Z -> Z -> Ordering)
-> (Z -> Z -> Bool)
-> (Z -> Z -> Bool)
-> (Z -> Z -> Bool)
-> (Z -> Z -> Bool)
-> (Z -> Z -> Z)
-> (Z -> Z -> Z)
-> Ord Z
Z -> Z -> Bool
Z -> Z -> Ordering
Z -> Z -> Z
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 :: Z -> Z -> Z
$cmin :: Z -> Z -> Z
max :: Z -> Z -> Z
$cmax :: Z -> Z -> Z
>= :: Z -> Z -> Bool
$c>= :: Z -> Z -> Bool
> :: Z -> Z -> Bool
$c> :: Z -> Z -> Bool
<= :: Z -> Z -> Bool
$c<= :: Z -> Z -> Bool
< :: Z -> Z -> Bool
$c< :: Z -> Z -> Bool
compare :: Z -> Z -> Ordering
$ccompare :: Z -> Z -> Ordering
$cp1Ord :: Eq Z
Ord,ReadPrec [Z]
ReadPrec Z
Int -> ReadS Z
ReadS [Z]
(Int -> ReadS Z)
-> ReadS [Z] -> ReadPrec Z -> ReadPrec [Z] -> Read Z
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Z]
$creadListPrec :: ReadPrec [Z]
readPrec :: ReadPrec Z
$creadPrec :: ReadPrec Z
readList :: ReadS [Z]
$creadList :: ReadS [Z]
readsPrec :: Int -> ReadS Z
$creadsPrec :: Int -> ReadS Z
Read,Int -> Z -> ShowS
[Z] -> ShowS
Z -> String
(Int -> Z -> ShowS) -> (Z -> String) -> ([Z] -> ShowS) -> Show Z
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Z] -> ShowS
$cshowList :: [Z] -> ShowS
show :: Z -> String
$cshow :: Z -> String
showsPrec :: Int -> Z -> ShowS
$cshowsPrec :: Int -> Z -> ShowS
Show,(forall x. Z -> Rep Z x) -> (forall x. Rep Z x -> Z) -> Generic Z
forall x. Rep Z x -> Z
forall x. Z -> Rep Z x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Z x -> Z
$cfrom :: forall x. Z -> Rep Z x
Generic,Typeable Z
DataType
Constr
Typeable Z
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Z -> c Z)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Z)
-> (Z -> Constr)
-> (Z -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Z))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Z))
-> ((forall b. Data b => b -> b) -> Z -> Z)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r)
-> (forall u. (forall d. Data d => d -> u) -> Z -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Z -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Z -> m Z)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Z -> m Z)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Z -> m Z)
-> Data Z
Z -> DataType
Z -> Constr
(forall b. Data b => b -> b) -> Z -> Z
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Z -> c Z
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Z
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Z -> u
forall u. (forall d. Data d => d -> u) -> Z -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Z -> m Z
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Z -> m Z
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Z
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Z -> c Z
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Z)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Z)
$cZ :: Constr
$tZ :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Z -> m Z
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Z -> m Z
gmapMp :: (forall d. Data d => d -> m d) -> Z -> m Z
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Z -> m Z
gmapM :: (forall d. Data d => d -> m d) -> Z -> m Z
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Z -> m Z
gmapQi :: Int -> (forall d. Data d => d -> u) -> Z -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Z -> u
gmapQ :: (forall d. Data d => d -> u) -> Z -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Z -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Z -> r
gmapT :: (forall b. Data b => b -> b) -> Z -> Z
$cgmapT :: (forall b. Data b => b -> b) -> Z -> Z
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Z)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Z)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Z)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Z)
dataTypeOf :: Z -> DataType
$cdataTypeOf :: Z -> DataType
toConstr :: Z -> Constr
$ctoConstr :: Z -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Z
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Z
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Z -> c Z
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Z -> c Z
$cp1Data :: Typeable Z
Data,Typeable,Z
Z -> Z -> Bounded Z
forall a. a -> a -> Bounded a
maxBound :: Z
$cmaxBound :: Z
minBound :: Z
$cminBound :: Z
Bounded)

derivingUnbox "Z"
  [t| Z -> () |]
  [| const () |]
  [| const Z  |]

instance Binary    Z
instance Serialize Z
instance ToJSON    Z
instance FromJSON  Z
instance Hashable  Z

instance Arbitrary Z where
  arbitrary :: Gen Z
arbitrary = Z -> Gen Z
forall (m :: * -> *) a. Monad m => a -> m a
return Z
Z

instance NFData Z where
  rnf :: Z -> ()
rnf Z
Z = ()
  {-# Inline rnf #-}



-- | Index structures for complex, heterogeneous indexing. Mostly designed for
-- indexing in DP grammars, where the indices work for linear and context-free
-- grammars on one or more tapes, for strings, sets, later on tree structures.

class Index i where
  -- | Data structure encoding the upper limit for each array.
  data LimitType i :: *
  -- | Given a maximal size, and a current index, calculate
  -- the linear index.
  linearIndex :: LimitType i -> i -> Int
  -- | Given a maximal size and a valid @Int@, return the index.
  fromLinearIndex :: LimitType i -> Int -> i
  -- | Given the 'LimitType', return the number of cells required for storage.
  size :: LimitType i -> Int
  -- | Check if an index is within the bounds.
  inBounds :: LimitType i -> i -> Bool
  -- | A lower bound of @zero@
  zeroBound :: i
  -- | A lower bound of @zero@ but for a @LimitType i@.
  zeroBound' :: LimitType i
  -- | The list of cell sizes for each dimension. its product yields the total
  -- size.
  totalSize :: LimitType i -> [Integer]
  -- | Pretty-print all upper bounds
  showBound :: LimitType i -> [String]
  -- | Pretty-print all indices
  showIndex :: i -> [String]

-- | Given the maximal number of cells (@Word@, because this is the pointer
-- limit for the machine), and the list of sizes, will check if this is still
-- legal. Consider dividing the @Word@ by the actual memory requirements for
-- each cell, to get better exception handling for too large arrays.
--
-- One list should be given for each array.

sizeIsValid :: Monad m => Word -> [[Integer]] -> ExceptT SizeError m CellSize
sizeIsValid :: Word -> [[Integer]] -> ExceptT SizeError m CellSize
sizeIsValid Word
maxCells [[Integer]]
cells = do
  let ps :: [Integer]
ps = ([Integer] -> Integer) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [[Integer]]
cells
      s :: Integer
s  = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
ps
  Bool -> ExceptT SizeError m () -> ExceptT SizeError m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
maxCells Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
s) (ExceptT SizeError m () -> ExceptT SizeError m ())
-> ExceptT SizeError m () -> ExceptT SizeError m ()
forall a b. (a -> b) -> a -> b
$
    SizeError -> ExceptT SizeError m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SizeError -> ExceptT SizeError m ())
-> (String -> SizeError) -> String -> ExceptT SizeError m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SizeError
SizeError
               (String -> ExceptT SizeError m ())
-> String -> ExceptT SizeError m ()
forall a b. (a -> b) -> a -> b
$ String -> Word -> Integer -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"PrimitiveArrays would be larger than maximal cell size. The given limit is %d, but the requested size is %d, with size %s for each array. (Debug hint: %s)"
                  Word
maxCells Integer
s ([Integer] -> String
forall a. Show a => a -> String
show [Integer]
ps) (Integer -> String
forall a. Show a => a -> String
show Integer
s)
  CellSize -> ExceptT SizeError m CellSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CellSize -> ExceptT SizeError m CellSize)
-> (Word -> CellSize) -> Word -> ExceptT SizeError m CellSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CellSize
CellSize (Word -> ExceptT SizeError m CellSize)
-> Word -> ExceptT SizeError m CellSize
forall a b. (a -> b) -> a -> b
$ Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s
{-# Inlinable sizeIsValid #-}

-- | In case @totalSize@ or variants thereof produce a size that is too big to
-- handle.

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

-- | The total number of cells that are allocated.

newtype CellSize = CellSize Word
  deriving stock (CellSize -> CellSize -> Bool
(CellSize -> CellSize -> Bool)
-> (CellSize -> CellSize -> Bool) -> Eq CellSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellSize -> CellSize -> Bool
$c/= :: CellSize -> CellSize -> Bool
== :: CellSize -> CellSize -> Bool
$c== :: CellSize -> CellSize -> Bool
Eq,Eq CellSize
Eq CellSize
-> (CellSize -> CellSize -> Ordering)
-> (CellSize -> CellSize -> Bool)
-> (CellSize -> CellSize -> Bool)
-> (CellSize -> CellSize -> Bool)
-> (CellSize -> CellSize -> Bool)
-> (CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize -> CellSize)
-> Ord CellSize
CellSize -> CellSize -> Bool
CellSize -> CellSize -> Ordering
CellSize -> CellSize -> CellSize
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 :: CellSize -> CellSize -> CellSize
$cmin :: CellSize -> CellSize -> CellSize
max :: CellSize -> CellSize -> CellSize
$cmax :: CellSize -> CellSize -> CellSize
>= :: CellSize -> CellSize -> Bool
$c>= :: CellSize -> CellSize -> Bool
> :: CellSize -> CellSize -> Bool
$c> :: CellSize -> CellSize -> Bool
<= :: CellSize -> CellSize -> Bool
$c<= :: CellSize -> CellSize -> Bool
< :: CellSize -> CellSize -> Bool
$c< :: CellSize -> CellSize -> Bool
compare :: CellSize -> CellSize -> Ordering
$ccompare :: CellSize -> CellSize -> Ordering
$cp1Ord :: Eq CellSize
Ord,Int -> CellSize -> ShowS
[CellSize] -> ShowS
CellSize -> String
(Int -> CellSize -> ShowS)
-> (CellSize -> String) -> ([CellSize] -> ShowS) -> Show CellSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellSize] -> ShowS
$cshowList :: [CellSize] -> ShowS
show :: CellSize -> String
$cshow :: CellSize -> String
showsPrec :: Int -> CellSize -> ShowS
$cshowsPrec :: Int -> CellSize -> ShowS
Show)
  deriving newtype (Integer -> CellSize
CellSize -> CellSize
CellSize -> CellSize -> CellSize
(CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize)
-> (CellSize -> CellSize)
-> (CellSize -> CellSize)
-> (Integer -> CellSize)
-> Num CellSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CellSize
$cfromInteger :: Integer -> CellSize
signum :: CellSize -> CellSize
$csignum :: CellSize -> CellSize
abs :: CellSize -> CellSize
$cabs :: CellSize -> CellSize
negate :: CellSize -> CellSize
$cnegate :: CellSize -> CellSize
* :: CellSize -> CellSize -> CellSize
$c* :: CellSize -> CellSize -> CellSize
- :: CellSize -> CellSize -> CellSize
$c- :: CellSize -> CellSize -> CellSize
+ :: CellSize -> CellSize -> CellSize
$c+ :: CellSize -> CellSize -> CellSize
Num,CellSize
CellSize -> CellSize -> Bounded CellSize
forall a. a -> a -> Bounded a
maxBound :: CellSize
$cmaxBound :: CellSize
minBound :: CellSize
$cminBound :: CellSize
Bounded,Enum CellSize
Real CellSize
Real CellSize
-> Enum CellSize
-> (CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize -> CellSize)
-> (CellSize -> CellSize -> (CellSize, CellSize))
-> (CellSize -> CellSize -> (CellSize, CellSize))
-> (CellSize -> Integer)
-> Integral CellSize
CellSize -> Integer
CellSize -> CellSize -> (CellSize, CellSize)
CellSize -> CellSize -> CellSize
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: CellSize -> Integer
$ctoInteger :: CellSize -> Integer
divMod :: CellSize -> CellSize -> (CellSize, CellSize)
$cdivMod :: CellSize -> CellSize -> (CellSize, CellSize)
quotRem :: CellSize -> CellSize -> (CellSize, CellSize)
$cquotRem :: CellSize -> CellSize -> (CellSize, CellSize)
mod :: CellSize -> CellSize -> CellSize
$cmod :: CellSize -> CellSize -> CellSize
div :: CellSize -> CellSize -> CellSize
$cdiv :: CellSize -> CellSize -> CellSize
rem :: CellSize -> CellSize -> CellSize
$crem :: CellSize -> CellSize -> CellSize
quot :: CellSize -> CellSize -> CellSize
$cquot :: CellSize -> CellSize -> CellSize
$cp2Integral :: Enum CellSize
$cp1Integral :: Real CellSize
Integral,Num CellSize
Ord CellSize
Num CellSize
-> Ord CellSize -> (CellSize -> Rational) -> Real CellSize
CellSize -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: CellSize -> Rational
$ctoRational :: CellSize -> Rational
$cp2Real :: Ord CellSize
$cp1Real :: Num CellSize
Real,Int -> CellSize
CellSize -> Int
CellSize -> [CellSize]
CellSize -> CellSize
CellSize -> CellSize -> [CellSize]
CellSize -> CellSize -> CellSize -> [CellSize]
(CellSize -> CellSize)
-> (CellSize -> CellSize)
-> (Int -> CellSize)
-> (CellSize -> Int)
-> (CellSize -> [CellSize])
-> (CellSize -> CellSize -> [CellSize])
-> (CellSize -> CellSize -> [CellSize])
-> (CellSize -> CellSize -> CellSize -> [CellSize])
-> Enum CellSize
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 :: CellSize -> CellSize -> CellSize -> [CellSize]
$cenumFromThenTo :: CellSize -> CellSize -> CellSize -> [CellSize]
enumFromTo :: CellSize -> CellSize -> [CellSize]
$cenumFromTo :: CellSize -> CellSize -> [CellSize]
enumFromThen :: CellSize -> CellSize -> [CellSize]
$cenumFromThen :: CellSize -> CellSize -> [CellSize]
enumFrom :: CellSize -> [CellSize]
$cenumFrom :: CellSize -> [CellSize]
fromEnum :: CellSize -> Int
$cfromEnum :: CellSize -> Int
toEnum :: Int -> CellSize
$ctoEnum :: Int -> CellSize
pred :: CellSize -> CellSize
$cpred :: CellSize -> CellSize
succ :: CellSize -> CellSize
$csucc :: CellSize -> CellSize
Enum)



-- | Generate a stream of indices in correct order for dynamic programming.
-- Since the stream generators require @concatMap@ / @flatten@ we have to
-- write more specialized code for @(z:.IX)@ stuff.

class (Index i) => IndexStream i where
  -- | Generate an index stream using 'LimitType's. This prevents having to
  -- figure out how the actual limits for complicated index types (like @Set@)
  -- would look like, since for @Set@, for example, the @LimitType Set == Int@
  -- provides just the number of bits.
  --
  -- This generates an index stream suitable for @forward@ structure filling.
  -- The first index is the smallest (or the first indices considered are all
  -- equally small in partially ordered sets). Larger indices follow up until
  -- the largest one.
  streamUp :: Monad m => LimitType i -> LimitType i -> Stream m i
  -- | If 'streamUp' generates indices from smallest to largest, then
  -- 'streamDown' generates indices from largest to smallest. Outside grammars
  -- make implicit use of this. Asking for an axiom in backtracking requests
  -- the first element from this stream.
  streamDown :: Monad m => LimitType i -> LimitType i -> Stream m i



instance Index Z where
  data LimitType Z = ZZ
  linearIndex :: LimitType Z -> Z -> Int
linearIndex LimitType Z
_ Z
_ = Int
0
  {-# INLINE linearIndex #-}
  fromLinearIndex :: LimitType Z -> Int -> Z
fromLinearIndex LimitType Z
_ Int
_ = Z
Z
  {-# Inline fromLinearIndex #-}
  size :: LimitType Z -> Int
size LimitType Z
_ = Int
1
  {-# INLINE size #-}
  inBounds :: LimitType Z -> Z -> Bool
inBounds LimitType Z
_ Z
_ = Bool
True
  {-# INLINE inBounds #-}
  zeroBound :: Z
zeroBound = Z
Z
  {-# Inline zeroBound #-}
  zeroBound' :: LimitType Z
zeroBound' = LimitType Z
ZZ
  {-# Inline zeroBound' #-}
  totalSize :: LimitType Z -> [Integer]
totalSize LimitType Z
ZZ = [Integer
1]
  {-# Inline [1] totalSize #-}
  showBound :: LimitType Z -> [String]
showBound LimitType Z
ZZ = [LimitType Z -> String
forall a. Show a => a -> String
show LimitType Z
ZZ]
  showIndex :: Z -> [String]
showIndex Z
Z = [Z -> String
forall a. Show a => a -> String
show Z
Z]

instance IndexStream Z where
  streamUp :: LimitType Z -> LimitType Z -> Stream m Z
streamUp LimitType Z
ZZ LimitType Z
ZZ = Z -> Stream m Z
forall (m :: * -> *) a. Monad m => a -> Stream m a
SM.singleton Z
Z
  {-# Inline streamUp #-}
  streamDown :: LimitType Z -> LimitType Z -> Stream m Z
streamDown LimitType Z
ZZ LimitType Z
ZZ = Z -> Stream m Z
forall (m :: * -> *) a. Monad m => a -> Stream m a
SM.singleton Z
Z
  {-# Inline streamDown #-}

deriving instance Eq       (LimitType Z)
deriving instance Generic  (LimitType Z)
deriving instance Read     (LimitType Z)
deriving instance Show     (LimitType Z)
deriving instance Data     (LimitType Z)
deriving instance Typeable (LimitType Z)
deriving instance Bounded  (LimitType Z)

instance (Index zs, Index z) => Index (zs:.z) where
  data LimitType (zs:.z) = !(LimitType zs) :.. !(LimitType z)
  linearIndex :: LimitType (zs :. z) -> (zs :. z) -> Int
linearIndex (hs:..h) (zs
zs:.z
z) = LimitType zs -> zs -> Int
forall i. Index i => LimitType i -> i -> Int
linearIndex LimitType zs
hs zs
zs Int -> Int -> Int
forall a. Num a => a -> a -> a
* LimitType z -> Int
forall i. Index i => LimitType i -> Int
size LimitType z
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LimitType z -> z -> Int
forall i. Index i => LimitType i -> i -> Int
linearIndex LimitType z
h z
z
  {-# INLINE linearIndex #-}
  fromLinearIndex :: LimitType (zs :. z) -> Int -> zs :. z
fromLinearIndex (hs:..h) Int
k = let (Int
l , Int
r) = Int -> Int -> (Int, Int)
quotRemInt Int
k (LimitType z -> Int
forall i. Index i => LimitType i -> Int
size LimitType z
h)
    in  LimitType zs -> Int -> zs
forall i. Index i => LimitType i -> Int -> i
fromLinearIndex LimitType zs
hs Int
l zs -> z -> zs :. z
forall a b. a -> b -> a :. b
:. LimitType z -> Int -> z
forall i. Index i => LimitType i -> Int -> i
fromLinearIndex LimitType z
h Int
r
  {-# Inline fromLinearIndex #-}
  size :: LimitType (zs :. z) -> Int
size (hs:..h) = LimitType zs -> Int
forall i. Index i => LimitType i -> Int
size LimitType zs
hs Int -> Int -> Int
forall a. Num a => a -> a -> a
* LimitType z -> Int
forall i. Index i => LimitType i -> Int
size LimitType z
h
  {-# INLINE size #-}
  inBounds :: LimitType (zs :. z) -> (zs :. z) -> Bool
inBounds (hs:..h) (zs
zs:.z
z) = LimitType zs -> zs -> Bool
forall i. Index i => LimitType i -> i -> Bool
inBounds LimitType zs
hs zs
zs Bool -> Bool -> Bool
&& LimitType z -> z -> Bool
forall i. Index i => LimitType i -> i -> Bool
inBounds LimitType z
h z
z
  {-# INLINE inBounds #-}
  zeroBound :: zs :. z
zeroBound = zs
forall i. Index i => i
zeroBound zs -> z -> zs :. z
forall a b. a -> b -> a :. b
:. z
forall i. Index i => i
zeroBound
  {-# Inline zeroBound #-}
  zeroBound' :: LimitType (zs :. z)
zeroBound' = LimitType zs
forall i. Index i => LimitType i
zeroBound' LimitType zs -> LimitType z -> LimitType (zs :. z)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:.. LimitType z
forall i. Index i => LimitType i
zeroBound'
  {-# Inline zeroBound' #-}
  totalSize :: LimitType (zs :. z) -> [Integer]
totalSize (hs:..h) =
    let tshs :: [Integer]
tshs = LimitType zs -> [Integer]
forall i. Index i => LimitType i -> [Integer]
totalSize LimitType zs
hs
        tsh :: [Integer]
tsh  = LimitType z -> [Integer]
forall i. Index i => LimitType i -> [Integer]
totalSize LimitType z
h
    in [Integer]
tshs [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer]
tsh
  {-# Inline totalSize #-}
  showBound :: LimitType (zs :. z) -> [String]
showBound (zs:..z) = LimitType zs -> [String]
forall i. Index i => LimitType i -> [String]
showBound LimitType zs
zs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ LimitType z -> [String]
forall i. Index i => LimitType i -> [String]
showBound LimitType z
z
  showIndex :: (zs :. z) -> [String]
showIndex (zs
zs:.z
z) = zs -> [String]
forall i. Index i => i -> [String]
showIndex zs
zs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ z -> [String]
forall i. Index i => i -> [String]
showIndex z
z

deriving instance (Eq (LimitType zs)     , Eq (LimitType z)     ) => Eq      (LimitType (zs:.z))
deriving instance (Generic (LimitType zs), Generic (LimitType z)) => Generic (LimitType (zs:.z))
deriving instance (Read (LimitType zs)   , Read (LimitType z)   ) => Read    (LimitType (zs:.z))
deriving instance (Show (LimitType zs)   , Show (LimitType z)   ) => Show    (LimitType (zs:.z))
deriving instance
  ( Data zs, Data (LimitType zs), Typeable zs
  , Data z , Data (LimitType z) , Typeable z
  ) => Data    (LimitType (zs:.z))
deriving instance (Bounded (LimitType zs), Bounded (LimitType z)) => Bounded (LimitType (zs:.z))

--instance (Index zs, Index z) => Index (zs:>z) where
--  type LimitType (zs:>z) = LimitType zs:>LimitType z
--  linearIndex (hs:>h) (zs:>z) = linearIndex hs zs * (size (Proxy :: Proxy z) h) + linearIndex h z
--  {-# INLINE linearIndex #-}
--  size Proxy (ss:>s) = size (Proxy :: Proxy zs) ss * (size (Proxy :: Proxy z) s)
--  {-# INLINE size #-}
--  inBounds (hs:>h) (zs:>z) = inBounds hs zs && inBounds h z
--  {-# INLINE inBounds #-}



-- * Somewhat experimental lens support.
--
-- The problem here is that tuples are n-ary, while inductive tuples are
-- binary, recursive.

instance Field1 (Z:.a) (Z:.a') a a' where
  {-# Inline _1 #-}
  _1 :: (a -> f a') -> (Z :. a) -> f (Z :. a')
_1 = ((Z :. a) -> a)
-> ((Z :. a) -> a' -> Z :. a') -> Lens (Z :. a) (Z :. a') a a'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Z
Z:.a
a) -> a
a) (\(Z
Z:.a
_) a'
a -> (Z
ZZ -> a' -> Z :. a'
forall a b. a -> b -> a :. b
:.a'
a))

instance Field1 (Z:.a:.b) (Z:.a':.b) a a' where
  {-# Inline _1 #-}
  _1 :: (a -> f a') -> ((Z :. a) :. b) -> f ((Z :. a') :. b)
_1 = (((Z :. a) :. b) -> a)
-> (((Z :. a) :. b) -> a' -> (Z :. a') :. b)
-> Lens ((Z :. a) :. b) ((Z :. a') :. b) a a'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Z
Z:.a
a:.b
b) -> a
a) (\(Z
Z:.a
_:.b
b) a'
a -> (Z
ZZ -> a' -> Z :. a'
forall a b. a -> b -> a :. b
:.a'
a(Z :. a') -> b -> (Z :. a') :. b
forall a b. a -> b -> a :. b
:.b
b))

instance Field1 (Z:.a:.b:.c) (Z:.a':.b:.c) a a' where
  {-# Inline _1 #-}
  _1 :: (a -> f a') -> (((Z :. a) :. b) :. c) -> f (((Z :. a') :. b) :. c)
_1 = ((((Z :. a) :. b) :. c) -> a)
-> ((((Z :. a) :. b) :. c) -> a' -> ((Z :. a') :. b) :. c)
-> Lens (((Z :. a) :. b) :. c) (((Z :. a') :. b) :. c) a a'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Z
Z:.a
a:.b
b:.c
c) -> a
a) (\(Z
Z:.a
_:.b
b:.c
c) a'
a -> (Z
ZZ -> a' -> Z :. a'
forall a b. a -> b -> a :. b
:.a'
a(Z :. a') -> b -> (Z :. a') :. b
forall a b. a -> b -> a :. b
:.b
b((Z :. a') :. b) -> c -> ((Z :. a') :. b) :. c
forall a b. a -> b -> a :. b
:.c
c))


instance Field2 (Z:.a:.b) (Z:.a:.b') b b' where
  {-# Inline _2 #-}
  _2 :: (b -> f b') -> ((Z :. a) :. b) -> f ((Z :. a) :. b')
_2 = (((Z :. a) :. b) -> b)
-> (((Z :. a) :. b) -> b' -> (Z :. a) :. b')
-> Lens ((Z :. a) :. b) ((Z :. a) :. b') b b'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Z
Z:.a
a:.b
b) -> b
b) (\(Z
Z:.a
a:.b
_) b'
b -> (Z
ZZ -> a -> Z :. a
forall a b. a -> b -> a :. b
:.a
a(Z :. a) -> b' -> (Z :. a) :. b'
forall a b. a -> b -> a :. b
:.b'
b))

instance Field2 (Z:.a:.b:.c) (Z:.a:.b':.c) b b' where
  {-# Inline _2 #-}
  _2 :: (b -> f b') -> (((Z :. a) :. b) :. c) -> f (((Z :. a) :. b') :. c)
_2 = ((((Z :. a) :. b) :. c) -> b)
-> ((((Z :. a) :. b) :. c) -> b' -> ((Z :. a) :. b') :. c)
-> Lens (((Z :. a) :. b) :. c) (((Z :. a) :. b') :. c) b b'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Z
Z:.a
a:.b
b:.c
c) -> b
b) (\(Z
Z:.a
a:.b
_:.c
c) b'
b -> (Z
ZZ -> a -> Z :. a
forall a b. a -> b -> a :. b
:.a
a(Z :. a) -> b' -> (Z :. a) :. b'
forall a b. a -> b -> a :. b
:.b'
b((Z :. a) :. b') -> c -> ((Z :. a) :. b') :. c
forall a b. a -> b -> a :. b
:.c
c))


instance Field3 (Z:.a:.b:.c) (Z:.a:.b:.c') c c' where
  {-# Inline _3 #-}
  _3 :: (c -> f c') -> (((Z :. a) :. b) :. c) -> f (((Z :. a) :. b) :. c')
_3 = ((((Z :. a) :. b) :. c) -> c)
-> ((((Z :. a) :. b) :. c) -> c' -> ((Z :. a) :. b) :. c')
-> Lens (((Z :. a) :. b) :. c) (((Z :. a) :. b) :. c') c c'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Z
Z:.a
a:.b
b:.c
c) -> c
c) (\(Z
Z:.a
a:.b
b:.c
_) c'
c -> (Z
ZZ -> a -> Z :. a
forall a b. a -> b -> a :. b
:.a
a(Z :. a) -> b -> (Z :. a) :. b
forall a b. a -> b -> a :. b
:.b
b((Z :. a) :. b) -> c' -> ((Z :. a) :. b) :. c'
forall a b. a -> b -> a :. b
:.c'
c))



-- * Operations for sparsity.

-- | @manhattan@ turns an index @sh@ into a starting point within 'sparseIndices' of the 'Sparse'
-- data structure. This should reduce the time required to search @sparseIndices@, because
-- @manhattanStart[manhattan sh]@ yields a left bound, while @manhattanStart[manhattan sh +1]@ will
-- yield an excluded right bound.
--
-- Uses the @Manhattan@ distance.
--
-- TODO This should probably be moved into the @Index@ module.

class SparseBucket sh where
  -- | The manhattan distance for an index.
  manhattan :: LimitType sh -> sh -> Int
  -- | The maximal possible manhattan distance.
  manhattanMax :: LimitType sh -> Int

instance SparseBucket Z where
  {-# Inline manhattan #-}
  manhattan :: LimitType Z -> Z -> Int
manhattan LimitType Z
ZZ Z
Z = Int
0
  {-# Inline manhattanMax #-}
  manhattanMax :: LimitType Z -> Int
manhattanMax LimitType Z
ZZ = Int
1

-- | Manhattan distances add up.

instance (SparseBucket i, SparseBucket is) => SparseBucket (is:.i) where
  {-# Inline manhattan #-}
  manhattan :: LimitType (is :. i) -> (is :. i) -> Int
manhattan (zz:..z) (is
is:.i
i) = LimitType is -> is -> Int
forall sh. SparseBucket sh => LimitType sh -> sh -> Int
manhattan LimitType is
zz is
is Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LimitType i -> i -> Int
forall sh. SparseBucket sh => LimitType sh -> sh -> Int
manhattan LimitType i
z i
i
  {-# Inline manhattanMax #-}
  manhattanMax :: LimitType (is :. i) -> Int
manhattanMax (zz:..z) = LimitType is -> Int
forall sh. SparseBucket sh => LimitType sh -> Int
manhattanMax LimitType is
zz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LimitType i -> Int
forall sh. SparseBucket sh => LimitType sh -> Int
manhattanMax LimitType i
z