{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
#endif
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Constant-time field accessors for extensible records. The
-- trade-off is the usual lists vs arrays one: it is fast to add an
-- element to the head of a list, but element access is linear time;
-- array access time is uniform, but extending the array is more
-- slower.
--
-- Tradeoffs:
--
-- * No sharing of the spine (i.e. when you change elements in the front of the
--   record the tail can't be re-used)
-- * ARec requires (4 + n) words + size of the fields
--   * 1 for the ARec constructor
--   * 1 for the pointer to the SmallArray#
--   * The SmallArray# has 2 words as header (1 for GC, 1 for number of elements)
--   * 1 pointer per element to the actual data
-- * Rec requires (2n) words + size of Fields
--   * 1 word per (:&) constructor
--   * 1 word for the pointer to the element
module Data.Vinyl.ARec.Internal
  ( ARec (..)
  , ToARec
  , IndexableField
  , arec
  , ARecBuilder (..)
  , arcons
  , arnil
  , toARec
  , fromARec
  , aget
  , unsafeAput
  , unsafeAlens
  , arecGetSubset
  , arecSetSubset
  , arecRepsMatchCoercion
  , arecConsMatchCoercion
  ) where
import Data.Vinyl.Core
import Data.Vinyl.Lens (RecElem(..), RecSubset(..))
import Data.Vinyl.TypeLevel
import Data.Vinyl.ARec.Internal.SmallArray
import Control.Monad.ST

import Unsafe.Coerce
#if __GLASGOW_HASKELL__ < 806
import Data.Constraint.Forall (Forall)
#endif
import Data.Type.Coercion     (Coercion (..))
import GHC.Types

-- | An array-backed extensible record with constant-time field
-- access.
newtype ARec (f :: k -> *) (ts :: [k]) = ARec SmallArray
type role ARec representational nominal

-- | Get the ith element from the ARec
unsafeIxARec
  :: forall a k (f :: k -> *) (ts :: [k]).
     ARec f ts
  -> Int
  -> a
unsafeIxARec :: ARec f ts -> Int -> a
unsafeIxARec (ARec SmallArray
ar) Int
ix = SmallArray -> Int -> a
forall a. SmallArray -> Int -> a
indexSmallArray SmallArray
ar Int
ix
{-# INLINE unsafeIxARec #-}

-- | Given that @xs@ and @ys@ have the same length, and mapping
-- @f@ over @xs@ and @g@ over @ys@ produces lists whose elements
-- are pairwise 'Coercible', @ARec f xs@ and @ARec g ys@ are
-- 'Coercible'.
arecRepsMatchCoercion :: AllRepsMatch f xs g ys => Coercion (ARec f xs) (ARec g ys)
arecRepsMatchCoercion :: Coercion (ARec f xs) (ARec g ys)
arecRepsMatchCoercion = Coercion () () -> Coercion (ARec f xs) (ARec g ys)
forall a b. a -> b
unsafeCoerce (Coercion () ()
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion :: Coercion () ())

-- | Given that @forall x. Coercible (f x) (g x)@, produce a coercion from
-- @ARec f xs@ to @ARec g xs@. While the constraint looks a lot like
-- @Coercible f g@, it is actually weaker.

#if __GLASGOW_HASKELL__ >= 806
arecConsMatchCoercion ::
  (forall (x :: k). Coercible (f x) (g x)) => Coercion (ARec f xs) (ARec g xs)
arecConsMatchCoercion :: Coercion (ARec f xs) (ARec g xs)
arecConsMatchCoercion = Coercion () () -> Coercion (ARec f xs) (ARec g xs)
forall a b. a -> b
unsafeCoerce (Coercion () ()
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion :: Coercion () ())
#else
arecConsMatchCoercion :: forall k (f :: k -> *) (g :: k -> *) (xs :: [k]).
  Forall (Similar f g) => Coercion (Rec f xs) (Rec g xs)
-- Why do we need this? No idea, really. I guess some change in
-- newtype handling for Coercible in 8.6?
arecConsMatchCoercion = unsafeCoerce (Coercion :: Coercion (Rec f xs) (Rec f xs))
#endif

-- Using a class instead of a recursive function allows aRecValues to be
-- completely inlined
class ToARec (us :: [k]) where
  aRecValues :: Rec f us -> ARecBuilder f us

instance ToARec '[] where
  aRecValues :: Rec f '[] -> ARecBuilder f '[]
aRecValues Rec f '[]
RNil = ARecBuilder f '[]
forall k k (f :: k). ARecBuilder f '[]
arnil
  {-# INLINE aRecValues #-}

instance ToARec us => ToARec (u ': us) where
  aRecValues :: Rec f (u : us) -> ARecBuilder f (u : us)
aRecValues (f r
x :& Rec f rs
xs) = f r
x f r -> ARecBuilder f rs -> ARecBuilder f (r : rs)
forall a (f :: a -> *) (u :: a) (us :: [a]).
f u -> ARecBuilder f us -> ARecBuilder f (u : us)
`arcons` Rec f rs -> ARecBuilder f rs
forall k (us :: [k]) (f :: k -> *).
ToARec us =>
Rec f us -> ARecBuilder f us
aRecValues Rec f rs
xs
  {-# INLINE aRecValues #-}

-- | Convert a 'Rec' into an 'ARec' for constant-time field access.
toARec
  :: forall f ts.
     (NatToInt (RLength ts), ToARec ts)
  => Rec f ts
  -> ARec f ts
toARec :: Rec f ts -> ARec f ts
toARec Rec f ts
rs = ARecBuilder f ts -> ARec f ts
forall k (us :: [k]) (f :: k -> *).
NatToInt (RLength us) =>
ARecBuilder f us -> ARec f us
arec (Rec f ts -> ARecBuilder f ts
forall k (us :: [k]) (f :: k -> *).
ToARec us =>
Rec f us -> ARecBuilder f us
aRecValues Rec f ts
rs)
{-# INLINE toARec #-}

{-
-- This is sensible, but the ergonomics are likely quite bad thanks to the
-- interaction between Coercible resolution and resolution in the presence of
-- quantified constraints. Is there a good way to do this?

arecConsMatchCoercible :: forall k f g rep (r :: TYPE rep).
     (forall (x :: k). Coercible (f x) (g x))
  => ((forall (xs :: [k]). Coercible (ARec f xs) (ARec g xs)) => r) -> r
arecConsMatchCoercible f = f
-}

-- | An efficient builder for ARec values
--
-- Use the pseudo-constructors 'arcons' and 'arnil' to construct an
-- 'ARecBuilder' and then turn it into an 'ARec' with 'arec'
--
-- Example: (requires -XOverloadedLabels and )
--
-- > user :: ARec ElField '[ "name"   ::: String
-- >                       , "age"    ::: Int
-- >                       , "active" ::: Bool]
-- > user = arec (  #name   =: "Peter"
-- >             `arcons` #age    =: 4
-- >             `arcons` #active =: True
-- >             `arcons` arnil
-- >             )
newtype ARecBuilder f us =
  -- A function that writes values to the correct position in the underlying array
  -- Takes the current index
  ARecBuilder ( forall s.
                Int -- Index to write to
              -> SmallMutableArray s -- Arrray to write to
              -> ST s ()
              )

infixr 1 `arcons`
-- | Pseudo-constructor for an ARecBuilder
--
-- "Cons" a field to an ARec under construction
--
-- See 'ARecBuilder'
arcons :: f u -> ARecBuilder f us -> ARecBuilder f (u ': us)
arcons :: f u -> ARecBuilder f us -> ARecBuilder f (u : us)
arcons !f u
v (ARecBuilder forall s. Int -> SmallMutableArray s -> ST s ()
fvs) = (forall s. Int -> SmallMutableArray s -> ST s ())
-> ARecBuilder f (u : us)
forall k k (f :: k) (us :: k).
(forall s. Int -> SmallMutableArray s -> ST s ())
-> ARecBuilder f us
ARecBuilder ((forall s. Int -> SmallMutableArray s -> ST s ())
 -> ARecBuilder f (u : us))
-> (forall s. Int -> SmallMutableArray s -> ST s ())
-> ARecBuilder f (u : us)
forall a b. (a -> b) -> a -> b
$ \Int
i SmallMutableArray s
mArr -> do
    SmallMutableArray s -> Int -> f u -> ST s ()
forall s a. SmallMutableArray s -> Int -> a -> ST s ()
writeSmallArray SmallMutableArray s
mArr Int
i f u
v
    Int -> SmallMutableArray s -> ST s ()
forall s. Int -> SmallMutableArray s -> ST s ()
fvs (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s
mArr
{-# INLINE arcons #-}

-- | Pseudo-constructor for 'ARecBuilder'
--
-- Build an ARec without fields
--
-- See 'ARecBuilder'
arnil :: ARecBuilder f '[]
arnil :: ARecBuilder f '[]
arnil = (forall s. Int -> SmallMutableArray s -> ST s ())
-> ARecBuilder f '[]
forall k k (f :: k) (us :: k).
(forall s. Int -> SmallMutableArray s -> ST s ())
-> ARecBuilder f us
ARecBuilder ((forall s. Int -> SmallMutableArray s -> ST s ())
 -> ARecBuilder f '[])
-> (forall s. Int -> SmallMutableArray s -> ST s ())
-> ARecBuilder f '[]
forall a b. (a -> b) -> a -> b
$ \Int
_i SmallMutableArray s
_arr -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE arnil #-}

-- | Turn an ARecBuilder into an ARec
--
-- See 'ARecBuilder'
arec
  :: forall k (us :: [k] ) f
  . (NatToInt (RLength us)) =>
      ARecBuilder f us
  -> ARec f us
arec :: ARecBuilder f us -> ARec f us
arec (ARecBuilder forall s. Int -> SmallMutableArray s -> ST s ()
fillArray) = SmallArray -> ARec f us
forall k (f :: k -> *) (ts :: [k]). SmallArray -> ARec f ts
ARec (SmallArray -> ARec f us) -> SmallArray -> ARec f us
forall a b. (a -> b) -> a -> b
$
  (forall s. ST s SmallArray) -> SmallArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s SmallArray) -> SmallArray)
-> (forall s. ST s SmallArray) -> SmallArray
forall a b. (a -> b) -> a -> b
$ Int -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall s.
Int -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
withNewSmallArray (NatToInt (RLength us) => Int
forall (n :: Nat). NatToInt n => Int
natToInt @(RLength us))
          ((SmallMutableArray s -> ST s ()) -> ST s SmallArray)
-> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall a b. (a -> b) -> a -> b
$ Int -> SmallMutableArray s -> ST s ()
forall s. Int -> SmallMutableArray s -> ST s ()
fillArray Int
0
{-# INLINE arec #-}

-- | Defines a constraint that lets us index into an 'ARec' in order
-- to produce a 'Rec' using 'fromARec'.
class (NatToInt (RIndex t ts)) => IndexableField ts t where
instance (NatToInt (RIndex t ts)) => IndexableField ts t where

-- | Convert an 'ARec' into a 'Rec'.
fromARec :: forall f ts.
            (RecApplicative ts, RPureConstrained (IndexableField ts) ts)
         => ARec f ts -> Rec f ts
fromARec :: ARec f ts -> Rec f ts
fromARec ARec f ts
ar = (forall (a :: u). IndexableField ts a => f a) -> Rec f ts
forall u (c :: u -> Constraint) (ts :: [u]) (f :: u -> *).
RPureConstrained c ts =>
(forall (a :: u). c a => f a) -> Rec f ts
rpureConstrained @(IndexableField ts) forall (t :: u). NatToInt (RIndex t ts) => f t
forall (a :: u). IndexableField ts a => f a
aux
  where aux :: forall t. NatToInt (RIndex t ts) => f t
        aux :: f t
aux = ARec f ts -> Int -> f t
forall a k (f :: k -> *) (ts :: [k]). ARec f ts -> Int -> a
unsafeIxARec ARec f ts
ar (NatToInt (RIndex t ts) => Int
forall (n :: Nat). NatToInt n => Int
natToInt @(RIndex t ts))
{-# INLINE fromARec #-}

-- | Get a field from an 'ARec'.
aget :: forall t f ts. (NatToInt (RIndex t ts)) => ARec f ts -> f t
aget :: ARec f ts -> f t
aget ARec f ts
ar = ARec f ts -> Int -> f t
forall a k (f :: k -> *) (ts :: [k]). ARec f ts -> Int -> a
unsafeIxARec ARec f ts
ar (NatToInt (RIndex t ts) => Int
forall (n :: Nat). NatToInt n => Int
natToInt @(RIndex t ts))
{-# INLINE aget #-}

-- | Set a field in an 'ARec'.
unsafeAput :: forall t t' f ts ts'. (NatToInt (RIndex t ts))
      => f t' -> ARec f ts -> ARec f ts'
unsafeAput :: f t' -> ARec f ts -> ARec f ts'
unsafeAput f t'
x (ARec SmallArray
arr) = SmallArray -> ARec f ts'
forall k (f :: k -> *) (ts :: [k]). SmallArray -> ARec f ts
ARec (SmallArray -> ARec f ts') -> SmallArray -> ARec f ts'
forall a b. (a -> b) -> a -> b
$ (forall s. ST s SmallArray) -> SmallArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s SmallArray) -> SmallArray)
-> (forall s. ST s SmallArray) -> SmallArray
forall a b. (a -> b) -> a -> b
$
  SmallArray -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall s.
SmallArray -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
withThawedSmallArray SmallArray
arr ((SmallMutableArray s -> ST s ()) -> ST s SmallArray)
-> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s
mArr ->
    SmallMutableArray s -> Int -> f t' -> ST s ()
forall s a. SmallMutableArray s -> Int -> a -> ST s ()
writeSmallArray SmallMutableArray s
mArr (NatToInt (RIndex t ts) => Int
forall (n :: Nat). NatToInt n => Int
natToInt @(RIndex t ts)) f t'
x
{-# INLINE unsafeAput #-}

-- | Define a lens for a field of an 'ARec'.
unsafeAlens :: forall f g t t' ts ts'. (Functor g, NatToInt (RIndex t ts))
      => (f t -> g (f t')) -> ARec f ts -> g (ARec f ts')
unsafeAlens :: (f t -> g (f t')) -> ARec f ts -> g (ARec f ts')
unsafeAlens f t -> g (f t')
f ARec f ts
ar = (f t' -> ARec f ts') -> g (f t') -> g (ARec f ts')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f t' -> ARec f ts -> ARec f ts')
-> ARec f ts -> f t' -> ARec f ts'
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t' :: k) (f :: k -> *) (ts :: [k]) (ts' :: [k]).
NatToInt (RIndex t ts) =>
f t' -> ARec f ts -> ARec f ts'
forall k (t :: k) (t' :: k) (f :: k -> *) (ts :: [k]) (ts' :: [k]).
NatToInt (RIndex t ts) =>
f t' -> ARec f ts -> ARec f ts'
unsafeAput @t) ARec f ts
ar) (f t -> g (f t')
f (ARec f ts -> f t
forall k (t :: k) (f :: k -> *) (ts :: [k]).
NatToInt (RIndex t ts) =>
ARec f ts -> f t
aget ARec f ts
ar))
{-# INLINE unsafeAlens #-}

-- instance (i ~ RIndex t ts, i ~ RIndex t' ts', NatToInt (RIndex t ts)) => RecElem ARec t t' ts ts' i where
--   rlens = alens
--   rget = aget
--   rput = aput

instance RecElem ARec t t' (t ': ts) (t' ': ts) 'Z where
  rlensC :: (f t -> g (f t')) -> ARec f (t : ts) -> g (ARec f (t' : ts))
rlensC = (f t -> g (f t')) -> ARec f (t : ts) -> g (ARec f (t' : ts))
forall k (f :: k -> *) (g :: * -> *) (t :: k) (t' :: k) (ts :: [k])
       (ts' :: [k]).
(Functor g, NatToInt (RIndex t ts)) =>
(f t -> g (f t')) -> ARec f ts -> g (ARec f ts')
unsafeAlens
  {-# INLINE rlensC #-}
  rgetC :: ARec f (t : ts) -> f t
rgetC = ARec f (t : ts) -> f t
forall k (t :: k) (f :: k -> *) (ts :: [k]).
NatToInt (RIndex t ts) =>
ARec f ts -> f t
aget
  {-# INLINE rgetC #-}
  rputC :: f t' -> ARec f (t : ts) -> ARec f (t' : ts)
rputC = forall (t' :: a) (f :: a -> *) (ts :: [a]) (ts' :: [a]).
NatToInt (RIndex t ts) =>
f t' -> ARec f ts -> ARec f ts'
forall k (t :: k) (t' :: k) (f :: k -> *) (ts :: [k]) (ts' :: [k]).
NatToInt (RIndex t ts) =>
f t' -> ARec f ts -> ARec f ts'
unsafeAput @t
  {-# INLINE rputC #-}

instance (RIndex t (s ': ts) ~ 'S i, NatToInt i,  RecElem ARec t t' ts ts' i)
  => RecElem ARec t t' (s ': ts) (s ': ts') ('S i) where
  rlensC :: (f t -> g (f t')) -> ARec f (s : ts) -> g (ARec f (s : ts'))
rlensC = (f t -> g (f t')) -> ARec f (s : ts) -> g (ARec f (s : ts'))
forall k (f :: k -> *) (g :: * -> *) (t :: k) (t' :: k) (ts :: [k])
       (ts' :: [k]).
(Functor g, NatToInt (RIndex t ts)) =>
(f t -> g (f t')) -> ARec f ts -> g (ARec f ts')
unsafeAlens
  {-# INLINE rlensC #-}
  rgetC :: ARec f (s : ts) -> f t
rgetC = ARec f (s : ts) -> f t
forall k (t :: k) (f :: k -> *) (ts :: [k]).
NatToInt (RIndex t ts) =>
ARec f ts -> f t
aget
  {-# INLINE rgetC #-}
  rputC :: f t' -> ARec f (s : ts) -> ARec f (s : ts')
rputC = forall (t' :: a) (f :: a -> *) (ts :: [a]) (ts' :: [a]).
NatToInt (RIndex t ts) =>
f t' -> ARec f ts -> ARec f ts'
forall k (t :: k) (t' :: k) (f :: k -> *) (ts :: [k]) (ts' :: [k]).
NatToInt (RIndex t ts) =>
f t' -> ARec f ts -> ARec f ts'
unsafeAput @t
  {-# INLINE rputC #-}

-- | Get a subset of a record's fields.
arecGetSubset :: forall rs ss f.
                 (IndexWitnesses (RImage rs ss), NatToInt (RLength rs))
              => ARec f ss -> ARec f rs
arecGetSubset :: ARec f ss -> ARec f rs
arecGetSubset (ARec SmallArray
arr) =
  SmallArray -> ARec f rs
forall k (f :: k -> *) (ts :: [k]). SmallArray -> ARec f ts
ARec (SmallArray -> ARec f rs) -> SmallArray -> ARec f rs
forall a b. (a -> b) -> a -> b
$ (forall s. ST s SmallArray) -> SmallArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s SmallArray) -> SmallArray)
-> (forall s. ST s SmallArray) -> SmallArray
forall a b. (a -> b) -> a -> b
$
    Int -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall s.
Int -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
withNewSmallArray (NatToInt (RLength rs) => Int
forall (n :: Nat). NatToInt n => Int
natToInt @(RLength rs)) ((SmallMutableArray s -> ST s ()) -> ST s SmallArray)
-> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s
mArr ->
      SmallMutableArray s -> Int -> [Int] -> ST s ()
forall s. SmallMutableArray s -> Int -> [Int] -> ST s ()
go SmallMutableArray s
mArr Int
0 (IndexWitnesses (RImage rs ss) => [Int]
forall (is :: [Nat]). IndexWitnesses is => [Int]
indexWitnesses @(RImage rs ss))
  where
    go :: SmallMutableArray s -> Int -> [Int] -> ST s ()
    go :: SmallMutableArray s -> Int -> [Int] -> ST s ()
go SmallMutableArray s
_mArr Int
_to [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go SmallMutableArray s
mArr Int
to (Int
from : [Int]
froms) = do
      SmallMutableArray s -> Int -> Any -> ST s ()
forall s a. SmallMutableArray s -> Int -> a -> ST s ()
writeSmallArray SmallMutableArray s
mArr Int
to (SmallArray -> Int -> Any
forall a. SmallArray -> Int -> a
indexSmallArray SmallArray
arr Int
from :: Any)
      SmallMutableArray s -> Int -> [Int] -> ST s ()
forall s. SmallMutableArray s -> Int -> [Int] -> ST s ()
go SmallMutableArray s
mArr (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
froms
{-# INLINE arecGetSubset #-}

-- | Set a subset of a larger record's fields to all of the fields of
-- a smaller record.
arecSetSubset :: forall rs ss f. (IndexWitnesses (RImage rs ss))
              => ARec f ss -> ARec f rs -> ARec f ss
arecSetSubset :: ARec f ss -> ARec f rs -> ARec f ss
arecSetSubset (ARec SmallArray
arrBig) (ARec SmallArray
arrSmall) = SmallArray -> ARec f ss
forall k (f :: k -> *) (ts :: [k]). SmallArray -> ARec f ts
ARec (SmallArray -> ARec f ss) -> SmallArray -> ARec f ss
forall a b. (a -> b) -> a -> b
$ (forall s. ST s SmallArray) -> SmallArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s SmallArray) -> SmallArray)
-> (forall s. ST s SmallArray) -> SmallArray
forall a b. (a -> b) -> a -> b
$
  SmallArray -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall s.
SmallArray -> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
withThawedSmallArray SmallArray
arrBig ((SmallMutableArray s -> ST s ()) -> ST s SmallArray)
-> (SmallMutableArray s -> ST s ()) -> ST s SmallArray
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s
mArr -> do
    SmallMutableArray s -> Int -> [Int] -> ST s ()
forall s. SmallMutableArray s -> Int -> [Int] -> ST s ()
go SmallMutableArray s
mArr Int
0 (IndexWitnesses (RImage rs ss) => [Int]
forall (is :: [Nat]). IndexWitnesses is => [Int]
indexWitnesses @(RImage rs ss))
  where
    go :: SmallMutableArray s -> Int -> [Int] -> ST s ()
    go :: SmallMutableArray s -> Int -> [Int] -> ST s ()
go SmallMutableArray s
_mArr Int
_ [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go SmallMutableArray s
mArr Int
from (Int
to : [Int]
tos) = do
      SmallMutableArray s -> Int -> Any -> ST s ()
forall s a. SmallMutableArray s -> Int -> a -> ST s ()
writeSmallArray SmallMutableArray s
mArr Int
to (SmallArray -> Int -> Any
forall a. SmallArray -> Int -> a
indexSmallArray SmallArray
arrSmall Int
from)
      SmallMutableArray s -> Int -> [Int] -> ST s ()
forall s. SmallMutableArray s -> Int -> [Int] -> ST s ()
go SmallMutableArray s
mArr (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
tos
{-# INLINE arecSetSubset #-}

instance (is ~ RImage rs ss, IndexWitnesses is, NatToInt (RLength rs))
         => RecSubset ARec rs ss is where
  rsubsetC :: (ARec f rs -> g (ARec f rs)) -> ARec f ss -> g (ARec f ss)
rsubsetC ARec f rs -> g (ARec f rs)
f ARec f ss
big = (ARec f rs -> ARec f ss) -> g (ARec f rs) -> g (ARec f ss)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ARec f ss -> ARec f rs -> ARec f ss
forall k (rs :: [k]) (ss :: [k]) (f :: k -> *).
IndexWitnesses (RImage rs ss) =>
ARec f ss -> ARec f rs -> ARec f ss
arecSetSubset ARec f ss
big) (ARec f rs -> g (ARec f rs)
f (ARec f ss -> ARec f rs
forall k (rs :: [k]) (ss :: [k]) (f :: k -> *).
(IndexWitnesses (RImage rs ss), NatToInt (RLength rs)) =>
ARec f ss -> ARec f rs
arecGetSubset ARec f ss
big))
  {-# INLINE rsubsetC #-}

instance (RPureConstrained (IndexableField rs) rs,
          RecApplicative rs,
          Show (Rec f rs)) => Show (ARec f rs) where
  show :: ARec f rs -> String
show = Rec f rs -> String
forall a. Show a => a -> String
show (Rec f rs -> String)
-> (ARec f rs -> Rec f rs) -> ARec f rs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ARec f rs -> Rec f rs
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec

instance (RPureConstrained (IndexableField rs) rs,
          RecApplicative rs,
          Eq (Rec f rs)) => Eq (ARec f rs) where
  ARec f rs
x == :: ARec f rs -> ARec f rs -> Bool
== ARec f rs
y = ARec f rs -> Rec f rs
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec f rs
x Rec f rs -> Rec f rs -> Bool
forall a. Eq a => a -> a -> Bool
== ARec f rs -> Rec f rs
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec f rs
y

instance (RPureConstrained (IndexableField rs) rs,
          RecApplicative rs,
          Ord (Rec f rs)) => Ord (ARec f rs) where
  compare :: ARec f rs -> ARec f rs -> Ordering
compare ARec f rs
x ARec f rs
y = Rec f rs -> Rec f rs -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ARec f rs -> Rec f rs
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec f rs
x) (ARec f rs -> Rec f rs
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
fromARec ARec f rs
y)