{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
#if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__)
{-# LANGUAGE StandaloneDeriving #-}
#else
{-# OPTIONS_GHC -fplugin Data.Constraint.Deriving #-}
#endif
module Numeric.Dimensions.Idx
(
Idx (Idx), Idxs
, idxFromWord, idxToWord
, listIdxs, idxsFromWords
, liftIdxs, unliftIdxs, unsafeUnliftIdxs
, TypedList ( XIdxs, U, (:*), Empty, Cons, Snoc, Reverse)
, OutOfDimBounds (..), outOfDimBounds, outOfDimBoundsNoCallStack
#if !defined(__HADDOCK__) && !defined(__HADDOCK_VERSION__)
, xnatNInstEnumIdx, xnatXInstEnumIdx, incohInstEnumIdx
, xnatNInstNumIdx, xnatXInstNumIdx, incohInstNumIdx
, instRealIdx, instIntegralIdx
#endif
) where
import Data.Coerce
import Data.Data (Data)
import Foreign.Storable (Storable)
import GHC.Enum
import GHC.Generics (Generic)
import qualified Text.Read as P
import Unsafe.Coerce
import GHC.Exception
import GHC.Stack
#ifdef UNSAFE_INDICES
import GHC.Base (Int (..), Type, Word (..), int2Word#, word2Int#)
#else
import GHC.Base (Int (..), Type, Word (..), int2Word#, maxInt, plusWord2#,
timesWord2#, word2Int#)
#endif
#if !defined(__HADDOCK__) && !defined(__HADDOCK_VERSION__)
import Data.Constraint
import Data.Constraint.Bare
import Data.Constraint.Deriving
#endif
import Numeric.Dimensions.Dim
import Numeric.TypedList (typedListReadPrec, typedListShowsPrec)
newtype Idx (d :: k) = Idx' Word
deriving ( Typeable (Idx d)
DataType
Constr
Typeable (Idx d)
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Idx d -> c (Idx d))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Idx d))
-> (Idx d -> Constr)
-> (Idx d -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Idx d)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Idx d)))
-> ((forall b. Data b => b -> b) -> Idx d -> Idx d)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r)
-> (forall u. (forall d. Data d => d -> u) -> Idx d -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Idx d -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d))
-> Data (Idx d)
Idx d -> DataType
Idx d -> Constr
(forall b. Data b => b -> b) -> Idx d -> Idx d
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Idx d -> c (Idx d)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Idx d)
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) -> Idx d -> u
forall u. (forall d. Data d => d -> u) -> Idx d -> [u]
forall k (d :: k). (Typeable d, Typeable k) => Typeable (Idx d)
forall k (d :: k). (Typeable d, Typeable k) => Idx d -> DataType
forall k (d :: k). (Typeable d, Typeable k) => Idx d -> Constr
forall k (d :: k).
(Typeable d, Typeable k) =>
(forall b. Data b => b -> b) -> Idx d -> Idx d
forall k (d :: k) u.
(Typeable d, Typeable k) =>
Int -> (forall d. Data d => d -> u) -> Idx d -> u
forall k (d :: k) u.
(Typeable d, Typeable k) =>
(forall d. Data d => d -> u) -> Idx d -> [u]
forall k (d :: k) r r'.
(Typeable d, Typeable k) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
forall k (d :: k) r r'.
(Typeable d, Typeable k) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
forall k (d :: k) (m :: * -> *).
(Typeable d, Typeable k, Monad m) =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
forall k (d :: k) (m :: * -> *).
(Typeable d, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
forall k (d :: k) (c :: * -> *).
(Typeable d, Typeable k) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Idx d)
forall k (d :: k) (c :: * -> *).
(Typeable d, Typeable k) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Idx d -> c (Idx d)
forall k (d :: k) (t :: * -> *) (c :: * -> *).
(Typeable d, Typeable k, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Idx d))
forall k (d :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable d, Typeable k, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Idx d))
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Idx d)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Idx d -> c (Idx d)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Idx d))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Idx d))
$cIdx' :: Constr
$tIdx :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
$cgmapMo :: forall k (d :: k) (m :: * -> *).
(Typeable d, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
gmapMp :: (forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
$cgmapMp :: forall k (d :: k) (m :: * -> *).
(Typeable d, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
gmapM :: (forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
$cgmapM :: forall k (d :: k) (m :: * -> *).
(Typeable d, Typeable k, Monad m) =>
(forall d. Data d => d -> m d) -> Idx d -> m (Idx d)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Idx d -> u
$cgmapQi :: forall k (d :: k) u.
(Typeable d, Typeable k) =>
Int -> (forall d. Data d => d -> u) -> Idx d -> u
gmapQ :: (forall d. Data d => d -> u) -> Idx d -> [u]
$cgmapQ :: forall k (d :: k) u.
(Typeable d, Typeable k) =>
(forall d. Data d => d -> u) -> Idx d -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
$cgmapQr :: forall k (d :: k) r r'.
(Typeable d, Typeable k) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
$cgmapQl :: forall k (d :: k) r r'.
(Typeable d, Typeable k) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Idx d -> r
gmapT :: (forall b. Data b => b -> b) -> Idx d -> Idx d
$cgmapT :: forall k (d :: k).
(Typeable d, Typeable k) =>
(forall b. Data b => b -> b) -> Idx d -> Idx d
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Idx d))
$cdataCast2 :: forall k (d :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable d, Typeable k, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Idx d))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Idx d))
$cdataCast1 :: forall k (d :: k) (t :: * -> *) (c :: * -> *).
(Typeable d, Typeable k, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Idx d))
dataTypeOf :: Idx d -> DataType
$cdataTypeOf :: forall k (d :: k). (Typeable d, Typeable k) => Idx d -> DataType
toConstr :: Idx d -> Constr
$ctoConstr :: forall k (d :: k). (Typeable d, Typeable k) => Idx d -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Idx d)
$cgunfold :: forall k (d :: k) (c :: * -> *).
(Typeable d, Typeable k) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Idx d)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Idx d -> c (Idx d)
$cgfoldl :: forall k (d :: k) (c :: * -> *).
(Typeable d, Typeable k) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Idx d -> c (Idx d)
$cp1Data :: forall k (d :: k). (Typeable d, Typeable k) => Typeable (Idx d)
Data, (forall x. Idx d -> Rep (Idx d) x)
-> (forall x. Rep (Idx d) x -> Idx d) -> Generic (Idx d)
forall x. Rep (Idx d) x -> Idx d
forall x. Idx d -> Rep (Idx d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (d :: k) x. Rep (Idx d) x -> Idx d
forall k (d :: k) x. Idx d -> Rep (Idx d) x
$cto :: forall k (d :: k) x. Rep (Idx d) x -> Idx d
$cfrom :: forall k (d :: k) x. Idx d -> Rep (Idx d) x
Generic, Ptr b -> Int -> IO (Idx d)
Ptr b -> Int -> Idx d -> IO ()
Ptr (Idx d) -> IO (Idx d)
Ptr (Idx d) -> Int -> IO (Idx d)
Ptr (Idx d) -> Int -> Idx d -> IO ()
Ptr (Idx d) -> Idx d -> IO ()
Idx d -> Int
(Idx d -> Int)
-> (Idx d -> Int)
-> (Ptr (Idx d) -> Int -> IO (Idx d))
-> (Ptr (Idx d) -> Int -> Idx d -> IO ())
-> (forall b. Ptr b -> Int -> IO (Idx d))
-> (forall b. Ptr b -> Int -> Idx d -> IO ())
-> (Ptr (Idx d) -> IO (Idx d))
-> (Ptr (Idx d) -> Idx d -> IO ())
-> Storable (Idx d)
forall b. Ptr b -> Int -> IO (Idx d)
forall b. Ptr b -> Int -> Idx d -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall k (d :: k). Ptr (Idx d) -> IO (Idx d)
forall k (d :: k). Ptr (Idx d) -> Int -> IO (Idx d)
forall k (d :: k). Ptr (Idx d) -> Int -> Idx d -> IO ()
forall k (d :: k). Ptr (Idx d) -> Idx d -> IO ()
forall k (d :: k). Idx d -> Int
forall k (d :: k) b. Ptr b -> Int -> IO (Idx d)
forall k (d :: k) b. Ptr b -> Int -> Idx d -> IO ()
poke :: Ptr (Idx d) -> Idx d -> IO ()
$cpoke :: forall k (d :: k). Ptr (Idx d) -> Idx d -> IO ()
peek :: Ptr (Idx d) -> IO (Idx d)
$cpeek :: forall k (d :: k). Ptr (Idx d) -> IO (Idx d)
pokeByteOff :: Ptr b -> Int -> Idx d -> IO ()
$cpokeByteOff :: forall k (d :: k) b. Ptr b -> Int -> Idx d -> IO ()
peekByteOff :: Ptr b -> Int -> IO (Idx d)
$cpeekByteOff :: forall k (d :: k) b. Ptr b -> Int -> IO (Idx d)
pokeElemOff :: Ptr (Idx d) -> Int -> Idx d -> IO ()
$cpokeElemOff :: forall k (d :: k). Ptr (Idx d) -> Int -> Idx d -> IO ()
peekElemOff :: Ptr (Idx d) -> Int -> IO (Idx d)
$cpeekElemOff :: forall k (d :: k). Ptr (Idx d) -> Int -> IO (Idx d)
alignment :: Idx d -> Int
$calignment :: forall k (d :: k). Idx d -> Int
sizeOf :: Idx d -> Int
$csizeOf :: forall k (d :: k). Idx d -> Int
Storable, Idx d -> Idx d -> Bool
(Idx d -> Idx d -> Bool) -> (Idx d -> Idx d -> Bool) -> Eq (Idx d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (d :: k). Idx d -> Idx d -> Bool
/= :: Idx d -> Idx d -> Bool
$c/= :: forall k (d :: k). Idx d -> Idx d -> Bool
== :: Idx d -> Idx d -> Bool
$c== :: forall k (d :: k). Idx d -> Idx d -> Bool
Eq, Eq (Idx d)
Eq (Idx d)
-> (Idx d -> Idx d -> Ordering)
-> (Idx d -> Idx d -> Bool)
-> (Idx d -> Idx d -> Bool)
-> (Idx d -> Idx d -> Bool)
-> (Idx d -> Idx d -> Bool)
-> (Idx d -> Idx d -> Idx d)
-> (Idx d -> Idx d -> Idx d)
-> Ord (Idx d)
Idx d -> Idx d -> Bool
Idx d -> Idx d -> Ordering
Idx d -> Idx d -> Idx d
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 k (d :: k). Eq (Idx d)
forall k (d :: k). Idx d -> Idx d -> Bool
forall k (d :: k). Idx d -> Idx d -> Ordering
forall k (d :: k). Idx d -> Idx d -> Idx d
min :: Idx d -> Idx d -> Idx d
$cmin :: forall k (d :: k). Idx d -> Idx d -> Idx d
max :: Idx d -> Idx d -> Idx d
$cmax :: forall k (d :: k). Idx d -> Idx d -> Idx d
>= :: Idx d -> Idx d -> Bool
$c>= :: forall k (d :: k). Idx d -> Idx d -> Bool
> :: Idx d -> Idx d -> Bool
$c> :: forall k (d :: k). Idx d -> Idx d -> Bool
<= :: Idx d -> Idx d -> Bool
$c<= :: forall k (d :: k). Idx d -> Idx d -> Bool
< :: Idx d -> Idx d -> Bool
$c< :: forall k (d :: k). Idx d -> Idx d -> Bool
compare :: Idx d -> Idx d -> Ordering
$ccompare :: forall k (d :: k). Idx d -> Idx d -> Ordering
$cp1Ord :: forall k (d :: k). Eq (Idx d)
Ord )
pattern Idx :: forall d . BoundedDim d => Word -> Idx d
pattern $bIdx :: Word -> Idx d
$mIdx :: forall r k (d :: k).
BoundedDim d =>
Idx d -> (Word -> r) -> (Void# -> r) -> r
Idx w <- Idx' w
where
Idx = Word -> Idx d
forall k (d :: k). BoundedDim d => Word -> Idx d
unsafeIdxFromWord
{-# COMPLETE Idx #-}
type Idxs = (TypedList Idx :: [k] -> Type)
unsafeIdxFromWord :: forall (k :: Type) (d :: k) . BoundedDim d => Word -> Idx d
#ifdef UNSAFE_INDICES
unsafeIdxFromWord = coerce
#else
unsafeIdxFromWord :: Word -> Idx d
unsafeIdxFromWord Word
w
| DimType d
DimTXNatX <- KnownDimType d => DimType d
forall k (d :: k). KnownDimType d => DimType d
dimType @d
= Word -> Idx d
coerce Word
w
| Word
w Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
d = Word -> Idx d
coerce Word
w
| Bool
otherwise = String
-> Word -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx d
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack String
"unsafeIdxFromWord" Word
w Word
d Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
where
d :: Word
d = Dim (DimBound d) -> Word
forall k (x :: k). Dim x -> Word
dimVal (BoundedDim d => Dim (DimBound d)
forall k (d :: k). BoundedDim d => Dim (DimBound d)
dimBound @d)
#endif
{-# INLINE unsafeIdxFromWord #-}
idxFromWord :: forall d . BoundedDim d => Word -> Maybe (Idx d)
idxFromWord :: Word -> Maybe (Idx d)
idxFromWord Word
w
| Word
w Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Dim (DimBound d) -> Word
forall k (x :: k). Dim x -> Word
dimVal (BoundedDim d => Dim (DimBound d)
forall k (d :: k). BoundedDim d => Dim (DimBound d)
dimBound @d) = Idx d -> Maybe (Idx d)
forall a. a -> Maybe a
Just (Word -> Idx d
coerce Word
w)
| Bool
otherwise = Maybe (Idx d)
forall a. Maybe a
Nothing
{-# INLINE idxFromWord #-}
idxToWord :: forall d . Idx d -> Word
idxToWord :: Idx d -> Word
idxToWord = Idx d -> Word
coerce
{-# INLINE idxToWord #-}
{-# RULES
"fromIntegral/idxToWord"
fromIntegral = idxToWord
#-}
listIdxs :: forall ds . Idxs ds -> [Word]
listIdxs :: Idxs ds -> [Word]
listIdxs = Idxs ds -> [Word]
forall a b. a -> b
unsafeCoerce
{-# INLINE listIdxs #-}
idxsFromWords :: forall ds . BoundedDims ds => [Word] -> Maybe (Idxs ds)
idxsFromWords :: [Word] -> Maybe (Idxs ds)
idxsFromWords = Maybe [Word] -> Maybe (Idxs ds)
forall a b. a -> b
unsafeCoerce (Maybe [Word] -> Maybe (Idxs ds))
-> ([Word] -> Maybe [Word]) -> [Word] -> Maybe (Idxs ds)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> [Word] -> Maybe [Word]
go (Dims (DimsBound ds) -> [Word]
forall k (xs :: [k]). Dims xs -> [Word]
listDims (BoundedDims ds => Dims (DimsBound ds)
forall k (ds :: [k]). BoundedDims ds => Dims (DimsBound ds)
dimsBound @ds))
where
go :: [Word] -> [Word] -> Maybe [Word]
go :: [Word] -> [Word] -> Maybe [Word]
go [] [] = [Word] -> Maybe [Word]
forall a. a -> Maybe a
Just []
go (Word
d : [Word]
ds) (Word
i : [Word]
is)
| Word
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
d = (Word
iWord -> [Word] -> [Word]
forall a. a -> [a] -> [a]
:) ([Word] -> [Word]) -> Maybe [Word] -> Maybe [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word] -> [Word] -> Maybe [Word]
go [Word]
ds [Word]
is
go [Word]
_ [Word]
_ = Maybe [Word]
forall a. Maybe a
Nothing
pattern XIdxs :: forall (ds :: [XNat]) (ns :: [Nat])
. (FixedDims ds ns, Dimensions ns) => Idxs ns -> Idxs ds
pattern $bXIdxs :: Idxs ns -> Idxs ds
$mXIdxs :: forall r (ds :: [XNat]) (ns :: [Nat]).
(FixedDims ds ns, Dimensions ns) =>
Idxs ds -> (Idxs ns -> r) -> (Void# -> r) -> r
XIdxs ns <- (unliftIdxs -> Just ns)
where
XIdxs = Idxs ns -> Idxs ds
forall (ds :: [XNat]) (ns :: [Nat]).
FixedDims ds ns =>
Idxs ns -> Idxs ds
liftIdxs
liftIdxs :: forall (ds :: [XNat]) (ns :: [Nat])
. FixedDims ds ns => Idxs ns -> Idxs ds
liftIdxs :: Idxs ns -> Idxs ds
liftIdxs = Idxs ns -> Idxs ds
forall a b. a -> b
unsafeCoerce
{-# INLINE liftIdxs #-}
unliftIdxs :: forall (ds :: [XNat]) (ns :: [Nat])
. (FixedDims ds ns, Dimensions ns) => Idxs ds -> Maybe (Idxs ns)
unliftIdxs :: Idxs ds -> Maybe (Idxs ns)
unliftIdxs Idxs ds
U = Idxs ns -> Maybe (Idxs ns)
forall a. a -> Maybe a
Just Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U
unliftIdxs (Idx' Word
i :* TypedList Idx ys
is)
| Dim y
d :* Dims ys
Dims <- Dimensions ns => TypedList Dim ns
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ns
, Word
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Dim y -> Word
forall k (x :: k). Dim x -> Word
dimVal Dim y
d = (Word -> Idx (Head ns)
forall k (d :: k). Word -> Idx d
Idx' Word
i Idx (Head ns) -> TypedList Idx (Tail ns) -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:*) (TypedList Idx (Tail ns) -> Idxs ns)
-> Maybe (TypedList Idx (Tail ns)) -> Maybe (Idxs ns)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypedList Idx ys -> Maybe (TypedList Idx (Tail ns))
forall (ds :: [XNat]) (ns :: [Nat]).
(FixedDims ds ns, Dimensions ns) =>
Idxs ds -> Maybe (Idxs ns)
unliftIdxs TypedList Idx ys
is
| Bool
otherwise = Maybe (Idxs ns)
forall a. Maybe a
Nothing
{-# INLINE unliftIdxs #-}
unsafeUnliftIdxs :: forall (ds :: [XNat]) (ns :: [Nat])
. (FixedDims ds ns, Dimensions ns) => Idxs ds -> Idxs ns
#ifdef UNSAFE_INDICES
unsafeUnliftIdxs = unsafeCoerce
#else
unsafeUnliftIdxs :: Idxs ds -> Idxs ns
unsafeUnliftIdxs Idxs ds
is' = [Word] -> Idxs ns
forall a b. a -> b
unsafeCoerce ((Word -> Word -> Word) -> [Word] -> [Word] -> [Word]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word -> Word -> Word
f [Word]
is [Word]
ds)
where
f :: Word -> Word -> Word
f Word
i Word
d | Word
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
d = Word
i
| Bool
otherwise = Word -> Word -> Word
err Word
i Word
d
is :: [Word]
is = Idxs ds -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs Idxs ds
is'
ds :: [Word]
ds = Dims ns -> [Word]
forall k (xs :: [k]). Dims xs -> [Word]
listDims (Dimensions ns => Dims ns
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ns)
err :: Word -> Word -> Word
err Word
i Word
d = String
-> Word -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Word
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
String
"unsafeUnliftIdxs" Word
i Word
d Maybe Word
forall a. Maybe a
Nothing (([Word], [Word]) -> Maybe ([Word], [Word])
forall a. a -> Maybe a
Just ([Word]
ds, [Word]
is))
#endif
{-# INLINE unsafeUnliftIdxs #-}
instance BoundedDim d => Read (Idx d) where
readPrec :: ReadPrec (Idx d)
readPrec = do
Word
w <- ReadPrec Word
forall a. Read a => ReadPrec a
P.readPrec
case KnownDimType d => DimType d
forall k (d :: k). KnownDimType d => DimType d
dimType @d of
DimType d
DimTXNatX -> Idx d -> ReadPrec (Idx d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Idx d
forall k (d :: k). Word -> Idx d
Idx' Word
w)
DimType d
_ | Word
w Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Dim (DimBound d) -> Word
forall k (x :: k). Dim x -> Word
dimVal (BoundedDim d => Dim (DimBound d)
forall k (d :: k). BoundedDim d => Dim (DimBound d)
dimBound @d)
-> Idx d -> ReadPrec (Idx d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Idx d
forall k (d :: k). Word -> Idx d
Idx' Word
w)
| Bool
otherwise -> ReadPrec (Idx d)
forall a. ReadPrec a
P.pfail
readList :: ReadS [Idx d]
readList = ReadS [Idx d]
forall a. Read a => ReadS [a]
P.readListDefault
readListPrec :: ReadPrec [Idx d]
readListPrec = ReadPrec [Idx d]
forall a. Read a => ReadPrec [a]
P.readListPrecDefault
instance Show (Idx d) where
showsPrec :: Int -> Idx d -> ShowS
showsPrec = (Int -> Word -> ShowS) -> Int -> Idx d -> ShowS
coerce (Int -> Word -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec :: Int -> Word -> ShowS)
instance BoundedDim d => Bounded (Idx d) where
minBound :: Idx d
minBound = Word -> Idx d
coerce (Word
0 :: Word)
{-# INLINE minBound #-}
maxBound :: Idx d
maxBound = Word -> Idx d
coerce (Dim (DimBound d) -> Word
forall k (x :: k). Dim x -> Word
dimVal (BoundedDim d => Dim (DimBound d)
forall k (d :: k). BoundedDim d => Dim (DimBound d)
dimBound @d) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
{-# INLINE maxBound #-}
instance KnownDim n => Enum (Idx (n :: Nat)) where
#ifdef UNSAFE_INDICES
succ = coerce ((+ 1) :: Word -> Word)
#else
succ :: Idx n -> Idx n
succ x :: Idx n
x@(Idx' Word
i)
| Idx n
x Idx n -> Idx n -> Bool
forall a. Ord a => a -> a -> Bool
< Idx n
forall a. Bounded a => a
maxBound = Word -> Idx n
coerce (Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
| Bool
otherwise = String
-> Word -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
String
"Enum.succ{Idx}" (Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) (KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n) Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
#endif
{-# INLINE succ #-}
#ifdef UNSAFE_INDICES
pred = coerce (subtract 1 :: Word -> Word)
#else
pred :: Idx n -> Idx n
pred x :: Idx n
x@(Idx' Word
i)
| Idx n
x Idx n -> Idx n -> Bool
forall a. Ord a => a -> a -> Bool
> Idx n
forall a. Bounded a => a
minBound = Word -> Idx n
coerce (Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
| Bool
otherwise = String
-> Int -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
String
"Enum.pred{Idx}" (-Int
1 :: Int) (KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n) Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
#endif
{-# INLINE pred #-}
#ifdef UNSAFE_INDICES
toEnum (I# i#) = coerce (W# (int2Word# i#))
#else
toEnum :: Int -> Idx n
toEnum Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Word
i' Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
d = Word -> Idx n
coerce Word
i'
| Bool
otherwise = String
-> Int -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
String
"Enum.toEnum{Idx}" Int
i Word
d Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
where
d :: Word
d = KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n
i' :: Word
i' = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
#endif
{-# INLINE toEnum #-}
#ifdef UNSAFE_INDICES
fromEnum (Idx' (W# w#)) = I# (word2Int# w#)
#else
fromEnum :: Idx n -> Int
fromEnum (Idx' x :: Word
x@(W# Word#
w#))
| Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
maxIntWord = Int# -> Int
I# (Word# -> Int#
word2Int# Word#
w#)
| Bool
otherwise = String -> Word -> Int
forall a b. Show a => String -> a -> b
fromEnumError String
"Idx" Word
x
where
maxIntWord :: Word
maxIntWord = Word# -> Word
W# (case Int
maxInt of I# Int#
i -> Int# -> Word#
int2Word# Int#
i)
#endif
{-# INLINE fromEnum #-}
enumFrom :: Idx n -> [Idx n]
enumFrom (Idx' Word
n) = [Word] -> [Idx n]
coerce (Word -> Word -> [Word]
forall a. Enum a => a -> a -> [a]
enumFromTo Word
n (KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1))
{-# INLINE enumFrom #-}
enumFromThen :: Idx n -> Idx n -> [Idx n]
enumFromThen (Idx' Word
n0) (Idx' Word
n1)
= [Word] -> [Idx n]
coerce (Word -> Word -> Word -> [Word]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Word
n0 Word
n1 Word
lim)
where
lim :: Word
lim = if Word
n1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
n0 then Word
forall a. Bounded a => a
maxBound else Word
forall a. Bounded a => a
minBound
{-# INLINE enumFromThen #-}
enumFromTo :: Idx n -> Idx n -> [Idx n]
enumFromTo
= (Word -> Word -> [Word]) -> Idx n -> Idx n -> [Idx n]
coerce (Word -> Word -> [Word]
forall a. Enum a => a -> a -> [a]
enumFromTo :: Word -> Word -> [Word])
{-# INLINE enumFromTo #-}
enumFromThenTo :: Idx n -> Idx n -> Idx n -> [Idx n]
enumFromThenTo
= (Word -> Word -> Word -> [Word])
-> Idx n -> Idx n -> Idx n -> [Idx n]
coerce (Word -> Word -> Word -> [Word]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo :: Word -> Word -> Word -> [Word])
{-# INLINE enumFromThenTo #-}
instance KnownDim n => Num (Idx (n :: Nat)) where
#ifdef UNSAFE_INDICES
(+) = coerce ((+) :: Word -> Word -> Word)
#else
(Idx' a :: Word
a@(W# Word#
a#)) + :: Idx n -> Idx n -> Idx n
+ (Idx' b :: Word
b@(W# Word#
b#))
| Bool
ovf Bool -> Bool -> Bool
|| Word
r Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
d
= String
-> Integer -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
(String
"Num.(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"){Idx}")
(Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
b) Word
d Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
| Bool
otherwise = Word -> Idx n
coerce Word
r
where
(Bool
ovf, Word
r) = case Word# -> Word# -> (# Word#, Word# #)
plusWord2# Word#
a# Word#
b# of
(# Word#
r2#, Word#
r1# #) -> ( Word# -> Word
W# Word#
r2# Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 , Word# -> Word
W# Word#
r1# )
d :: Word
d = KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n
#endif
{-# INLINE (+) #-}
#ifdef UNSAFE_INDICES
(-) = coerce ((-) :: Word -> Word -> Word)
#else
(Idx' Word
a) - :: Idx n -> Idx n -> Idx n
- (Idx' Word
b)
| Word
b Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
a
= String
-> Integer -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
(String
"Num.(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"){Idx}")
(Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
b) (KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n) Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
| Bool
otherwise = Word -> Idx n
coerce (Word
a Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
b)
#endif
{-# INLINE (-) #-}
#ifdef UNSAFE_INDICES
(*) = coerce ((*) :: Word -> Word -> Word)
#else
(Idx' a :: Word
a@(W# Word#
a#)) * :: Idx n -> Idx n -> Idx n
* (Idx' b :: Word
b@(W# Word#
b#))
| Bool
ovf Bool -> Bool -> Bool
|| Word
r Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
d
= String
-> Integer -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
(String
"Num.(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"){Idx}")
(Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
b) Word
d Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
| Bool
otherwise = Word -> Idx n
coerce Word
r
where
(Bool
ovf, Word
r) = case Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
a# Word#
b# of
(# Word#
r2#, Word#
r1# #) -> ( Word# -> Word
W# Word#
r2# Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 , Word# -> Word
W# Word#
r1# )
d :: Word
d = KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n
#endif
{-# INLINE (*) #-}
#ifdef UNSAFE_INDICES
negate = id
#else
negate :: Idx n -> Idx n
negate (Idx' Word
0) = Word -> Idx n
forall k (d :: k). Word -> Idx d
Idx' Word
0
negate (Idx' Word
i) = String
-> Integer -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
String
"Num.negate{Idx}" (- Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
i) (KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n) Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
#endif
{-# INLINE negate #-}
abs :: Idx n -> Idx n
abs = Idx n -> Idx n
forall a. a -> a
id
{-# INLINE abs #-}
signum :: Idx n -> Idx n
signum = Idx n -> Idx n -> Idx n
forall a b. a -> b -> a
const (Word -> Idx n
forall k (d :: k). Word -> Idx d
Idx' Word
1)
{-# INLINE signum #-}
#ifdef UNSAFE_INDICES
fromInteger = coerce (fromInteger :: Integer -> Word)
#else
fromInteger :: Integer -> Idx n
fromInteger Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
d
= Word -> Idx n
forall k (d :: k). Word -> Idx d
Idx' (Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i)
| Bool
otherwise = String
-> Integer -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> Idx n
forall i a.
Integral i =>
String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack
String
"Num.fromInteger{Idx}" Integer
i Word
d Maybe Word
forall a. Maybe a
Nothing Maybe ([Word], [Word])
forall a. Maybe a
Nothing
where
d :: Word
d = KnownDim n => Word
forall k (n :: k). KnownDim n => Word
dimVal' @n
#endif
{-# INLINE fromInteger #-}
#if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__)
deriving instance BoundedDim d => Enum (Idx d)
deriving instance BoundedDim d => Integral (Idx d)
deriving instance BoundedDim d => Real (Idx d)
deriving instance BoundedDim d => Num (Idx d)
#else
{-# ANN xnatNInstEnumIdx (ToInstance NoOverlap) #-}
xnatNInstEnumIdx ::
forall (n :: Nat)
. KnownDim n => Dict (Enum (Idx (N n)))
xnatNInstEnumIdx = unsafeCoerce (Dict @(Enum (Idx n)))
{-# ANN xnatXInstEnumIdx (ToInstance NoOverlap) #-}
xnatXInstEnumIdx ::
forall (m :: Nat)
. Dict (Enum (Idx (XN m)))
xnatXInstEnumIdx = unsafeCoerce (Dict @(Enum Word))
{-# ANN incohInstEnumIdx (ToInstance Incoherent) #-}
incohInstEnumIdx ::
forall (k :: Type) (d :: k)
. BoundedDim d => Dict (Enum (Idx d))
incohInstEnumIdx = case dimType @d of
DimTNat -> Dict
DimTXNatN -> xnatNInstEnumIdx
DimTXNatX -> xnatXInstEnumIdx
{-# ANN xnatNInstNumIdx (ToInstance NoOverlap) #-}
xnatNInstNumIdx ::
forall (n :: Nat)
. KnownDim n => Dict (Num (Idx (N n)))
xnatNInstNumIdx = unsafeCoerce (Dict @(Num (Idx n)))
{-# ANN xnatXInstNumIdx (ToInstance NoOverlap) #-}
xnatXInstNumIdx ::
forall (m :: Nat)
. Dict (Num (Idx (XN m)))
xnatXInstNumIdx = unsafeCoerce (Dict @(Num Word))
{-# ANN incohInstNumIdx (ToInstance Incoherent) #-}
incohInstNumIdx ::
forall (k :: Type) (d :: k)
. BoundedDim d => Dict (Num (Idx d))
incohInstNumIdx = case dimType @d of
DimTNat -> Dict
DimTXNatN -> xnatNInstNumIdx
DimTXNatX -> xnatXInstNumIdx
{-# ANN defineReal ClassDict #-}
defineReal ::
forall a
. (Num a, Ord a)
=> (a -> Rational)
-> Dict (Real a)
defineReal = defineReal
{-# ANN instRealIdx (ToInstance NoOverlap) #-}
instRealIdx ::
forall (k :: Type) (d :: k)
. BoundedDim d => Dict (Real (Idx d))
instRealIdx
= withBareConstraint (dictToBare (incohInstNumIdx @k @d))
$ defineReal (coerce (toRational @Word))
{-# ANN defineIntegral ClassDict #-}
defineIntegral ::
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)
-> Dict (Integral a)
defineIntegral = defineIntegral
{-# ANN instIntegralIdx (ToInstance NoOverlap) #-}
instIntegralIdx ::
forall (k :: Type) (d :: k)
. BoundedDim d => Dict (Integral (Idx d))
instIntegralIdx
= withBareConstraint (dictToBare (instRealIdx @k @d))
$ withBareConstraint (dictToBare (incohInstEnumIdx @k @d))
$ defineIntegral
(coerce (quot @Word)) (coerce (rem @Word))
(coerce (div @Word)) (coerce (mod @Word))
(coerce (quotRem @Word)) (coerce (divMod @Word))
(coerce (toInteger @Word))
#endif
instance Eq (Idxs (xs :: [k])) where
== :: Idxs xs -> Idxs xs -> Bool
(==) = ([Word] -> [Word] -> Bool) -> Idxs xs -> Idxs xs -> Bool
forall a b. a -> b
unsafeCoerce ([Word] -> [Word] -> Bool
forall a. Eq a => a -> a -> Bool
(==) :: [Word] -> [Word] -> Bool)
{-# INLINE (==) #-}
instance Ord (Idxs (xs :: [k])) where
compare :: Idxs xs -> Idxs xs -> Ordering
compare = ([Word] -> [Word] -> Ordering) -> Idxs xs -> Idxs xs -> Ordering
forall a b. a -> b
unsafeCoerce ([Word] -> [Word] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare :: [Word] -> [Word] -> Ordering)
{-# INLINE compare #-}
instance Show (Idxs (xs :: [k])) where
showsPrec :: Int -> Idxs xs -> ShowS
showsPrec = (forall (x :: k). Int -> Idx x -> ShowS) -> Int -> Idxs xs -> ShowS
forall k (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS)
-> Int -> TypedList f xs -> ShowS
typedListShowsPrec @Idx @xs forall (x :: k). Int -> Idx x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance BoundedDims xs => Read (Idxs (xs :: [k])) where
readPrec :: ReadPrec (Idxs xs)
readPrec = String
-> (forall (x :: k). BoundedDim x => ReadPrec (Idx x))
-> TypedList Proxy xs
-> ReadPrec (Idxs xs)
forall k (c :: k -> Constraint) (f :: k -> *) (xs :: [k])
(g :: k -> *).
All c xs =>
String
-> (forall (x :: k). c x => ReadPrec (f x))
-> TypedList g xs
-> ReadPrec (TypedList f xs)
typedListReadPrec @BoundedDim String
":*" forall (x :: k). BoundedDim x => ReadPrec (Idx x)
forall a. Read a => ReadPrec a
P.readPrec (RepresentableList xs => TypedList Proxy xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
readList :: ReadS [Idxs xs]
readList = ReadS [Idxs xs]
forall a. Read a => ReadS [a]
P.readListDefault
readListPrec :: ReadPrec [Idxs xs]
readListPrec = ReadPrec [Idxs xs]
forall a. Read a => ReadPrec [a]
P.readListPrecDefault
instance BoundedDims ds => Bounded (Idxs (ds :: [k])) where
maxBound :: Idxs ds
maxBound = Dims ds -> Idxs ds
forall (ns :: [k]). Dims ns -> Idxs ns
f (BoundedDims ds => Dims ds
forall k (ds :: [k]). BoundedDims ds => Dims ds
minimalDims @ds)
where
f :: forall (ns :: [k]) . Dims ns -> Idxs ns
f :: Dims ns -> Idxs ns
f Dims ns
U = Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U
f (Dim y
d :* TypedList Dim ys
ds) = Word -> Idx y
coerce (Dim y -> Word
forall k (x :: k). Dim x -> Word
dimVal Dim y
d Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Idx y -> TypedList Idx ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* TypedList Dim ys -> TypedList Idx ys
forall (ns :: [k]). Dims ns -> Idxs ns
f TypedList Dim ys
ds
{-# INLINE maxBound #-}
minBound :: Idxs ds
minBound = Dims ds -> Idxs ds
forall (ns :: [k]). Dims ns -> Idxs ns
f (BoundedDims ds => Dims ds
forall k (ds :: [k]). BoundedDims ds => Dims ds
minimalDims @ds)
where
f :: forall (ns :: [k]) . Dims ns -> Idxs ns
f :: Dims ns -> Idxs ns
f Dims ns
U = Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U
f (Dim y
_ :* TypedList Dim ys
ds) = Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' Word
0 Idx y -> TypedList Idx ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* TypedList Dim ys -> TypedList Idx ys
forall (ns :: [k]). Dims ns -> Idxs ns
f TypedList Dim ys
ds
{-# INLINE minBound #-}
instance Dimensions ds => Enum (Idxs ds) where
succ :: Idxs ds -> Idxs ds
succ Idxs ds
idx = case Dims ds -> Idxs ds -> (Bool, Idxs ds)
forall k (ns :: [k]). Dims ns -> Idxs ns -> (Bool, Idxs ns)
go Dims ds
dds Idxs ds
idx of
(Bool
True , Idxs ds
_ ) -> String -> Idxs ds
forall a. String -> a
succError (String -> Idxs ds) -> String -> Idxs ds
forall a b. (a -> b) -> a -> b
$ Dims ds -> String
forall k (ns :: [k]). Dims ns -> String
showIdxsType Dims ds
dds
(Bool
False, Idxs ds
i') -> Idxs ds
i'
where
dds :: Dims ds
dds = Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
go :: forall ns . Dims ns -> Idxs ns -> (Bool, Idxs ns)
go :: Dims ns -> Idxs ns -> (Bool, Idxs ns)
go Dims ns
U Idxs ns
U = (Bool
True, Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U)
go (Dim y
d :* TypedList Dim ys
ds) (Idx' Word
i :* TypedList Idx ys
is) = case TypedList Dim ys -> Idxs ys -> (Bool, Idxs ys)
forall k (ns :: [k]). Dims ns -> Idxs ns -> (Bool, Idxs ns)
go TypedList Dim ys
ds Idxs ys
TypedList Idx ys
is of
(Bool
True , Idxs ys
is')
| Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Dim y -> Word
forall k (x :: k). Dim x -> Word
dimVal Dim y
d -> (Bool
True , Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' Word
0 Idx y -> Idxs ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Idxs ys
is')
| Bool
otherwise -> (Bool
False, Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' (Word
iWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1) Idx y -> Idxs ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Idxs ys
is')
(Bool
False, Idxs ys
is') -> (Bool
False, Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' Word
i Idx y -> Idxs ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Idxs ys
is')
{-# INLINE succ #-}
pred :: Idxs ds -> Idxs ds
pred Idxs ds
idx = case Dims ds -> Idxs ds -> (Bool, Idxs ds)
forall k (ns :: [k]). Dims ns -> Idxs ns -> (Bool, Idxs ns)
go Dims ds
dds Idxs ds
idx of
(Bool
True , Idxs ds
_ ) -> String -> Idxs ds
forall a. String -> a
predError (String -> Idxs ds) -> String -> Idxs ds
forall a b. (a -> b) -> a -> b
$ Dims ds -> String
forall k (ns :: [k]). Dims ns -> String
showIdxsType Dims ds
dds
(Bool
False, Idxs ds
i') -> Idxs ds
i'
where
dds :: Dims ds
dds = Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
go :: forall ns . Dims ns -> Idxs ns -> (Bool, Idxs ns)
go :: Dims ns -> Idxs ns -> (Bool, Idxs ns)
go Dims ns
U Idxs ns
U = (Bool
True, Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U)
go (Dim y
d :* TypedList Dim ys
ds) (Idx' Word
i :* TypedList Idx ys
is) = case TypedList Dim ys -> Idxs ys -> (Bool, Idxs ys)
forall k (ns :: [k]). Dims ns -> Idxs ns -> (Bool, Idxs ns)
go TypedList Dim ys
ds Idxs ys
TypedList Idx ys
is of
(Bool
True , Idxs ys
is')
| Word
i Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 -> (Bool
True , Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' (Dim y -> Word
forall k (x :: k). Dim x -> Word
dimVal Dim y
d Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Idx y -> Idxs ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Idxs ys
is')
| Bool
otherwise -> (Bool
False, Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' (Word
iWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) Idx y -> Idxs ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Idxs ys
is')
(Bool
False, Idxs ys
is') -> (Bool
False, Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' Word
i Idx y -> Idxs ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Idxs ys
is')
{-# INLINE pred #-}
toEnum :: Int -> Idxs ds
toEnum Int
off0 = case Dims ds -> (Word, Idxs ds)
forall k (ns :: [k]). Dims ns -> (Word, Idxs ns)
go Dims ds
dds of
(Word
0, Idxs ds
i) -> Idxs ds
i
(Word, Idxs ds)
_ -> String -> Int -> (Word, Word) -> Idxs ds
forall a b. Show a => String -> Int -> (a, a) -> b
toEnumError (Dims ds -> String
forall k (ns :: [k]). Dims ns -> String
showIdxsType Dims ds
dds) Int
off0 (Word
0, Dims ds -> Word
forall k (xs :: [k]). Dims xs -> Word
totalDim Dims ds
dds Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
where
dds :: Dims ds
dds = Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
go :: forall ns . Dims ns -> (Word, Idxs ns)
go :: Dims ns -> (Word, Idxs ns)
go Dims ns
U = (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off0, Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U)
go (Dim y
d :* TypedList Dim ys
ds)
| (Word
off , Idxs ys
is) <- TypedList Dim ys -> (Word, Idxs ys)
forall k (ns :: [k]). Dims ns -> (Word, Idxs ns)
go TypedList Dim ys
ds
, (Word
off', Word
i ) <- Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
quotRem Word
off (Dim y -> Word
forall k (x :: k). Dim x -> Word
dimVal Dim y
d)
= (Word
off', Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' Word
i Idx y -> Idxs ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Idxs ys
is)
{-# INLINE toEnum #-}
fromEnum :: Idxs ds -> Int
fromEnum = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> (Idxs ds -> Word) -> Idxs ds -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word, Word) -> Word
forall a b. (a, b) -> b
snd
((Word, Word) -> Word)
-> (Idxs ds -> (Word, Word)) -> Idxs ds -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word, Word) -> (Word, Word) -> (Word, Word))
-> (Word, Word) -> [(Word, Word)] -> (Word, Word)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Word, Word) -> (Word, Word) -> (Word, Word)
f (Word
1, Word
0)
([(Word, Word)] -> (Word, Word))
-> (Idxs ds -> [(Word, Word)]) -> Idxs ds -> (Word, Word)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> [Word] -> [(Word, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Dims ds -> [Word]
forall k (xs :: [k]). Dims xs -> [Word]
listDims (Dims ds -> [Word]) -> Dims ds -> [Word]
forall a b. (a -> b) -> a -> b
$ Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds) ([Word] -> [(Word, Word)])
-> (Idxs ds -> [Word]) -> Idxs ds -> [(Word, Word)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idxs ds -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs
where
f :: (Word, Word) -> (Word, Word) -> (Word, Word)
f :: (Word, Word) -> (Word, Word) -> (Word, Word)
f (Word
d, Word
i) (Word
td, Word
off) = (Word
d Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
td, Word
off Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
td Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
i)
{-# INLINE fromEnum #-}
enumFrom :: Idxs ds -> [Idxs ds]
enumFrom = (Bool -> [Word] -> [Word] -> [[Word]])
-> Bool -> Dims ds -> Idxs ds -> [Idxs ds]
forall a b. a -> b
unsafeCoerce Bool -> [Word] -> [Word] -> [[Word]]
go Bool
True (Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds)
where
go :: Bool -> [Word] -> [Word] -> [[Word]]
go :: Bool -> [Word] -> [Word] -> [[Word]]
go Bool
b (Word
d:[Word]
ds) (Word
i:[Word]
is) =
[ Word
i' Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
is' | (Bool
b', Word
i') <- [Bool] -> [Word] -> [(Bool, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Bool
b Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)
([Word] -> [(Bool, Word)]) -> [Word] -> [(Bool, Word)]
forall a b. (a -> b) -> a -> b
$ Word -> Word -> [Word]
forall a. Enum a => a -> a -> [a]
enumFromTo (if Bool
b then Word
i else Word
0) (Word
d Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
, [Word]
is' <- Bool -> [Word] -> [Word] -> [[Word]]
go Bool
b' [Word]
ds [Word]
is ]
go Bool
_ [Word]
_ [Word]
_ = [[]]
{-# INLINE enumFrom #-}
enumFromTo :: Idxs ds -> Idxs ds -> [Idxs ds]
enumFromTo = (Bool -> Bool -> [Word] -> [Word] -> [Word] -> [[Word]])
-> Bool -> Bool -> Dims ds -> Idxs ds -> Idxs ds -> [Idxs ds]
forall a b. a -> b
unsafeCoerce Bool -> Bool -> [Word] -> [Word] -> [Word] -> [[Word]]
go Bool
True Bool
True (Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds)
where
go :: Bool -> Bool -> [Word] -> [Word] -> [Word] -> [[Word]]
go :: Bool -> Bool -> [Word] -> [Word] -> [Word] -> [[Word]]
go Bool
bl Bool
bu (Word
d:[Word]
ds) (Word
x:[Word]
xs) (Word
y:[Word]
ys) =
[ Word
i Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
is | (Bool
bl', Bool
bu', Word
i) <- Bool -> Bool -> [Word] -> [(Bool, Bool, Word)]
prepapp Bool
bl Bool
bu
([Word] -> [(Bool, Bool, Word)]) -> [Word] -> [(Bool, Bool, Word)]
forall a b. (a -> b) -> a -> b
$ Word -> Word -> [Word]
forall a. Enum a => a -> a -> [a]
enumFromTo (if Bool
bl then Word
x else Word
0)
(if Bool
bu then Word
y else Word
d Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
, [Word]
is <- Bool -> Bool -> [Word] -> [Word] -> [Word] -> [[Word]]
go Bool
bl' Bool
bu' [Word]
ds [Word]
xs [Word]
ys ]
go Bool
_ Bool
_ [Word]
_ [Word]
_ [Word]
_ = [[]]
prepapp :: Bool -> Bool -> [Word] -> [(Bool, Bool, Word)]
prepapp Bool
_ Bool
_ [] = []
prepapp Bool
bl Bool
bu [Word
i] = [(Bool
bl, Bool
bu, Word
i)]
prepapp Bool
bl Bool
bu (Word
i:[Word]
is) = (Bool
bl, Bool
False, Word
i :: Word) (Bool, Bool, Word) -> [(Bool, Bool, Word)] -> [(Bool, Bool, Word)]
forall a. a -> [a] -> [a]
: Bool -> [Word] -> [(Bool, Bool, Word)]
app Bool
bu [Word]
is
app :: Bool -> [Word] -> [(Bool, Bool, Word)]
app Bool
_ [] = []
app Bool
bu [Word
i] = [(Bool
False, Bool
bu, Word
i :: Word)]
app Bool
bu (Word
i:[Word]
is) = (Bool
False, Bool
False, Word
i) (Bool, Bool, Word) -> [(Bool, Bool, Word)] -> [(Bool, Bool, Word)]
forall a. a -> [a] -> [a]
: Bool -> [Word] -> [(Bool, Bool, Word)]
app Bool
bu [Word]
is
{-# INLINE enumFromTo #-}
enumFromThen :: Idxs ds -> Idxs ds -> [Idxs ds]
enumFromThen Idxs ds
x0 Idxs ds
x1 = case Idxs ds -> Idxs ds -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Idxs ds
x1 Idxs ds
x0 of
Ordering
EQ -> Idxs ds -> [Idxs ds]
forall a. a -> [a]
repeat Idxs ds
x0
Ordering
GT -> Idxs ds -> Idxs ds -> Idxs ds -> [Idxs ds]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Idxs ds
x0 Idxs ds
x1 (Idxs ds -> [Idxs ds]) -> Idxs ds -> [Idxs ds]
forall a b. (a -> b) -> a -> b
$ Dims ds -> Idxs ds
forall k (ns :: [k]). Dims ns -> Idxs ns
maxB Dims ds
ds
Ordering
LT -> Idxs ds -> Idxs ds -> Idxs ds -> [Idxs ds]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Idxs ds
x0 Idxs ds
x1 (Idxs ds -> [Idxs ds]) -> Idxs ds -> [Idxs ds]
forall a b. (a -> b) -> a -> b
$ Dims ds -> Idxs ds
forall k (ns :: [k]). Dims ns -> Idxs ns
minB Dims ds
ds
where
ds :: Dims ds
ds = Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
maxB :: forall ns . Dims ns -> Idxs ns
maxB :: Dims ns -> Idxs ns
maxB Dims ns
U = Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U
maxB (Dim y
x :* TypedList Dim ys
xs) = Word -> Idx y
coerce (Dim y -> Word
forall k (x :: k). Dim x -> Word
dimVal Dim y
x Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Idx y -> TypedList Idx ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* TypedList Dim ys -> TypedList Idx ys
forall k (ns :: [k]). Dims ns -> Idxs ns
maxB TypedList Dim ys
xs
minB :: forall ns . Dims ns -> Idxs ns
minB :: Dims ns -> Idxs ns
minB Dims ns
U = Idxs ns
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
U
minB (Dim y
_ :* TypedList Dim ys
xs) = Word -> Idx y
forall k (d :: k). Word -> Idx d
Idx' Word
0 Idx y -> TypedList Idx ys -> Idxs ns
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* TypedList Dim ys -> TypedList Idx ys
forall k (ns :: [k]). Dims ns -> Idxs ns
minB TypedList Dim ys
xs
{-# INLINE enumFromThen #-}
enumFromThenTo :: Idxs ds -> Idxs ds -> Idxs ds -> [Idxs ds]
enumFromThenTo Idxs ds
x0 Idxs ds
x1 Idxs ds
y = case Ordering
dir of
Ordering
EQ -> if [Word]
allYs [Word] -> [Word] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Word]
allX0s then Idxs ds -> [Idxs ds]
forall a. a -> [a]
repeat Idxs ds
x0 else []
Ordering
GT -> let (Word
_, [Word]
allDXs) = [Word] -> [Word] -> [Word] -> (Word, [Word])
idxMinus [Word]
allDs [Word]
allX0s [Word]
allX1s
repeatStep :: [Word] -> [[Word]]
repeatStep [Word]
is
= if [Word]
is [Word] -> [Word] -> Bool
forall a. Ord a => a -> a -> Bool
<= [Word]
allYs
then [Word]
is [Word] -> [[Word]] -> [[Word]]
forall a. a -> [a] -> [a]
: case [Word] -> [Word] -> [Word] -> (Word, [Word])
idxPlus [Word]
allDs [Word]
is [Word]
allDXs of
(Word
0, [Word]
is') -> [Word] -> [[Word]]
repeatStep [Word]
is'
(Word, [Word])
_ -> []
else []
in [[Word]] -> [Idxs ds]
forall a b. a -> b
unsafeCoerce ([Word] -> [[Word]]
repeatStep [Word]
allX0s)
Ordering
LT -> let (Word
_, [Word]
allDXs) = [Word] -> [Word] -> [Word] -> (Word, [Word])
idxMinus [Word]
allDs [Word]
allX1s [Word]
allX0s
repeatStep :: [Word] -> [[Word]]
repeatStep [Word]
is
= if [Word]
is [Word] -> [Word] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Word]
allYs
then [Word]
is [Word] -> [[Word]] -> [[Word]]
forall a. a -> [a] -> [a]
: case [Word] -> [Word] -> [Word] -> (Word, [Word])
idxMinus [Word]
allDs [Word]
allDXs [Word]
is of
(Word
0, [Word]
is') -> [Word] -> [[Word]]
repeatStep [Word]
is'
(Word, [Word])
_ -> []
else []
in [[Word]] -> [Idxs ds]
forall a b. a -> b
unsafeCoerce ([Word] -> [[Word]]
repeatStep [Word]
allX0s)
where
allDs :: [Word]
allDs = Dims ds -> [Word]
forall k (xs :: [k]). Dims xs -> [Word]
listDims (Dims ds -> [Word]) -> Dims ds -> [Word]
forall a b. (a -> b) -> a -> b
$ Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
allX0s :: [Word]
allX0s = Idxs ds -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs Idxs ds
x0
allX1s :: [Word]
allX1s = Idxs ds -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs Idxs ds
x1
allYs :: [Word]
allYs = Idxs ds -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs Idxs ds
y
dir :: Ordering
dir = [Word] -> [Word] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Word]
allX1s [Word]
allX0s
idxMinus :: [Word] -> [Word] -> [Word] -> (Word, [Word])
idxMinus :: [Word] -> [Word] -> [Word] -> (Word, [Word])
idxMinus (Word
d:[Word]
ds) (Word
a:[Word]
as) (Word
b:[Word]
bs)
= let (Word
one , [Word]
xs ) = [Word] -> [Word] -> [Word] -> (Word, [Word])
idxMinus [Word]
ds [Word]
as [Word]
bs
(Word
one', Word
x ) = Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
quotRem (Word
d Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
b Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
a Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
one) Word
d
in (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
one', Word
x Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
xs)
idxMinus [Word]
_ [Word]
_ [Word]
_ = (Word
0, [])
idxPlus :: [Word] -> [Word] -> [Word] -> (Word, [Word])
idxPlus :: [Word] -> [Word] -> [Word] -> (Word, [Word])
idxPlus (Word
d:[Word]
ds) (Word
a:[Word]
as) (Word
b:[Word]
bs)
= let (Word
one , [Word]
xs ) = [Word] -> [Word] -> [Word] -> (Word, [Word])
idxPlus [Word]
ds [Word]
as [Word]
bs
(Word
one', Word
x ) = Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
quotRem (Word
a Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
b Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
one) Word
d
in (Word
one', Word
x Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
xs)
idxPlus [Word]
_ [Word]
_ [Word]
_ = (Word
0, [])
{-# INLINE enumFromThenTo #-}
showIdxsType :: Dims ns -> String
showIdxsType :: Dims ns -> String
showIdxsType Dims ns
ds = String
"Idxs '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word] -> String
forall a. Show a => a -> String
show (Dims ns -> [Word]
forall k (xs :: [k]). Dims xs -> [Word]
listDims Dims ns
ds)
outOfDimBoundsNoCallStack ::
Integral i
=> String
-> i
-> Word
-> Maybe Word
-> Maybe ([Word], [Word])
-> a
outOfDimBoundsNoCallStack :: String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBoundsNoCallStack String
s i
i Word
d Maybe Word
msubd Maybe ([Word], [Word])
dimsCtx
= OutOfDimBounds -> a
forall a e. Exception e => e -> a
throw OutOfDimBounds :: Integer
-> Word
-> Maybe Word
-> Maybe ([Word], [Word])
-> String
-> Maybe CallStack
-> OutOfDimBounds
OutOfDimBounds
{ oodIdx :: Integer
oodIdx = i -> Integer
forall a. Integral a => a -> Integer
toInteger i
i
, oodDim :: Word
oodDim = Word
d
, oodSubDim :: Maybe Word
oodSubDim = Maybe Word
msubd
, oodDimsCtx :: Maybe ([Word], [Word])
oodDimsCtx = Maybe ([Word], [Word])
dimsCtx
, oodName :: String
oodName = String
s
, oodCallStack :: Maybe CallStack
oodCallStack = Maybe CallStack
forall a. Maybe a
Nothing
}
outOfDimBounds ::
(HasCallStack, Integral i)
=> String
-> i
-> Word
-> Maybe Word
-> Maybe ([Word], [Word])
-> a
outOfDimBounds :: String -> i -> Word -> Maybe Word -> Maybe ([Word], [Word]) -> a
outOfDimBounds String
s i
i Word
d Maybe Word
msubd Maybe ([Word], [Word])
dimsCtx
= OutOfDimBounds -> a
forall a e. Exception e => e -> a
throw OutOfDimBounds :: Integer
-> Word
-> Maybe Word
-> Maybe ([Word], [Word])
-> String
-> Maybe CallStack
-> OutOfDimBounds
OutOfDimBounds
{ oodIdx :: Integer
oodIdx = i -> Integer
forall a. Integral a => a -> Integer
toInteger i
i
, oodDim :: Word
oodDim = Word
d
, oodSubDim :: Maybe Word
oodSubDim = Maybe Word
msubd
, oodDimsCtx :: Maybe ([Word], [Word])
oodDimsCtx = Maybe ([Word], [Word])
dimsCtx
, oodName :: String
oodName = String
s
, oodCallStack :: Maybe CallStack
oodCallStack = CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack
}
data OutOfDimBounds
= OutOfDimBounds
{ OutOfDimBounds -> Integer
oodIdx :: Integer
, OutOfDimBounds -> Word
oodDim :: Word
, OutOfDimBounds -> Maybe Word
oodSubDim :: Maybe Word
, OutOfDimBounds -> Maybe ([Word], [Word])
oodDimsCtx :: Maybe ([Word], [Word])
, OutOfDimBounds -> String
oodName :: String
, OutOfDimBounds -> Maybe CallStack
oodCallStack :: Maybe CallStack
}
instance Eq OutOfDimBounds where
== :: OutOfDimBounds -> OutOfDimBounds -> Bool
(==) OutOfDimBounds
a OutOfDimBounds
b = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OutOfDimBounds -> Integer
oodIdx OutOfDimBounds
a) (OutOfDimBounds -> Integer
oodIdx OutOfDimBounds
b)
, Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OutOfDimBounds -> Word
oodDim OutOfDimBounds
a) (OutOfDimBounds -> Word
oodDim OutOfDimBounds
b)
, Maybe Word -> Maybe Word -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OutOfDimBounds -> Maybe Word
oodSubDim OutOfDimBounds
a) (OutOfDimBounds -> Maybe Word
oodSubDim OutOfDimBounds
b)
, Maybe ([Word], [Word]) -> Maybe ([Word], [Word]) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OutOfDimBounds -> Maybe ([Word], [Word])
oodDimsCtx OutOfDimBounds
a) (OutOfDimBounds -> Maybe ([Word], [Word])
oodDimsCtx OutOfDimBounds
b)
, String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OutOfDimBounds -> String
oodName OutOfDimBounds
a) (OutOfDimBounds -> String
oodName OutOfDimBounds
b)
]
instance Ord OutOfDimBounds where
compare :: OutOfDimBounds -> OutOfDimBounds -> Ordering
compare OutOfDimBounds
a OutOfDimBounds
b = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
[ Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OutOfDimBounds -> Integer
oodIdx OutOfDimBounds
a) (OutOfDimBounds -> Integer
oodIdx OutOfDimBounds
b)
, Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OutOfDimBounds -> Word
oodDim OutOfDimBounds
a) (OutOfDimBounds -> Word
oodDim OutOfDimBounds
b)
, Maybe Word -> Maybe Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OutOfDimBounds -> Maybe Word
oodSubDim OutOfDimBounds
a) (OutOfDimBounds -> Maybe Word
oodSubDim OutOfDimBounds
b)
, Maybe ([Word], [Word]) -> Maybe ([Word], [Word]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OutOfDimBounds -> Maybe ([Word], [Word])
oodDimsCtx OutOfDimBounds
a) (OutOfDimBounds -> Maybe ([Word], [Word])
oodDimsCtx OutOfDimBounds
b)
, String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OutOfDimBounds -> String
oodName OutOfDimBounds
a) (OutOfDimBounds -> String
oodName OutOfDimBounds
b)
]
instance Show OutOfDimBounds where
showsPrec :: Int -> OutOfDimBounds -> ShowS
showsPrec Int
p OutOfDimBounds
e = String -> ShowS
addLoc String
errStr
where
addLoc :: String -> ShowS
addLoc String
s
= let someE :: SomeException
someE = case OutOfDimBounds -> Maybe CallStack
oodCallStack OutOfDimBounds
e of
Maybe CallStack
Nothing -> String -> SomeException
errorCallException String
s
Just CallStack
st -> String -> CallStack -> SomeException
errorCallWithCallStackException String
s CallStack
st
errc :: ErrorCall
errc :: ErrorCall
errc = case SomeException -> Maybe ErrorCall
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
someE of
Maybe ErrorCall
Nothing -> String -> ErrorCall
ErrorCall String
s
Just ErrorCall
ec -> ErrorCall
ec
in Int -> ErrorCall -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ErrorCall
errc
errStr :: String
errStr = OutOfDimBounds -> String
oodName OutOfDimBounds
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
errContent String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
errCtx
errContent :: String
errContent = case OutOfDimBounds -> Maybe Word
oodSubDim OutOfDimBounds
e of
Maybe Word
Nothing -> String
"index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (OutOfDimBounds -> Integer
oodIdx OutOfDimBounds
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" is outside of Dim bounds (0 <= i < " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show (OutOfDimBounds -> Word
oodDim OutOfDimBounds
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
Just Word
sd -> String
"index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (OutOfDimBounds -> Integer
oodIdx OutOfDimBounds
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" and subspace dim " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
sd String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" together exceed the original space dim " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show (OutOfDimBounds -> Word
oodDim OutOfDimBounds
e)
errCtx :: String
errCtx = case OutOfDimBounds -> Maybe ([Word], [Word])
oodDimsCtx OutOfDimBounds
e of
Maybe ([Word], [Word])
Nothing -> String
"."
Just ([Word]
ds, [Word]
is)
-> String
";\n dims: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (case [Word] -> SomeDims
someDimsVal [Word]
ds of SomeDims Dims ns
x -> Dims ns -> String
forall a. Show a => a -> String
show Dims ns
x)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n idxs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Idxs Any -> String
forall a. Show a => a -> String
show ([Word] -> Idxs ns
forall a b. a -> b
unsafeCoerce [Word]
is :: Idxs ns)
instance Exception OutOfDimBounds