{-
 - Copyright (C) 2019  Koz Ross <koz.ross@retro-freedom.nz>
 -
 - This program is free software: you can redistribute it and/or modify
 - it under the terms of the GNU General Public License as published by
 - the Free Software Foundation, either version 3 of the License, or
 - (at your option) any later version.
 -
 - This program is distributed in the hope that it will be useful,
 - but WITHOUT ANY WARRANTY; without even the implied warranty of
 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 - GNU General Public License for more details.
 -
 - You should have received a copy of the GNU General Public License
 - along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}

{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Extra.Solver #-}

{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | 
-- Module:        Data.Finitary.Pack
-- Description:   A wrapper around @Finitary@ types, designed to provide easy
--                derivation of @Storable@, @Binary@ and @Unbox@ instances.
-- Copyright:     (C) Koz Ross, 2019
-- License:       GPL version 3.0 or later
-- Maintainer:    koz.ross@retro-freedom.nz
-- Stability:     Experimental
-- Portability:   GHC only
--
-- Defines a newtype for easy derivation of 'Data.Vector.Unboxed.Unbox', 'Storable', 
-- 'Data.Binary.Binary' and 'Hashable' instances for any type with a 'Finitary' instance. The easiest way to use
-- this is with the @DerivingVia@ extension:
--
-- > {-# LANGUAGE DeriveAnyClass #-}
-- > {-# LANGUAGE DeriveGeneric #-}
-- > {-# LANGUAGE DerivingVia #-}
-- >
-- > import Data.Finitary
-- > import Data.Finitary.Pack
-- > import Data.Word
-- > import Data.Hashable
-- >
-- > data Foo = Bar | Baz (Word8, Word8) | Quux Word16
-- >  deriving (Eq, Generic, Finitary)
-- >  deriving (Storable, Binary, Hashable) via (Pack Foo)
-- 
-- Alternatively, you can just use @Pack a@ instead of @a@ wherever appropriate.
-- Unfortunately (due to role restrictions on unboxed vectors), you /must/ use
-- @Pack a@ if you want a 'Data.Vector.Unboxed.Vector' full of @a@s -
-- @DerivingVia@ is of no help here.
module Data.Finitary.Pack 
(
  Pack(..)
) where

import Data.Foldable (traverse_)
import CoercibleUtils (op, over, over2)
import Control.DeepSeq (NFData)
import GHC.Generics (Generic, Generic1)
import Data.Data (Data)
import Type.Reflection (Typeable)
import Data.Finitary (Finitary(..))
import GHC.TypeNats
import GHC.TypeLits.Extra
import Data.Word (Word8)
import Numeric.Natural (Natural)
import Control.Monad.State.Strict (evalState, MonadState(..), modify)
import Data.Proxy (Proxy(..))
import Data.Hashable (Hashable(..))
import Foreign.Storable (Storable(..))
import Foreign.Ptr (castPtr)

import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Generic.Sized as VGS
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Sized as VSS
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Sized as VUS
import qualified Data.Binary as B

-- | Essentially @Identity a@, but with different instances. So named due to the \'packing\' of the 
-- type's indices densely into arrays, memory or bits.
newtype Pack a = Pack { Pack a -> a
unPack :: a }
  deriving (Pack a -> Pack a -> Bool
(Pack a -> Pack a -> Bool)
-> (Pack a -> Pack a -> Bool) -> Eq (Pack a)
forall a. Eq a => Pack a -> Pack a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pack a -> Pack a -> Bool
$c/= :: forall a. Eq a => Pack a -> Pack a -> Bool
== :: Pack a -> Pack a -> Bool
$c== :: forall a. Eq a => Pack a -> Pack a -> Bool
Eq, Eq (Pack a)
Eq (Pack a) =>
(Pack a -> Pack a -> Ordering)
-> (Pack a -> Pack a -> Bool)
-> (Pack a -> Pack a -> Bool)
-> (Pack a -> Pack a -> Bool)
-> (Pack a -> Pack a -> Bool)
-> (Pack a -> Pack a -> Pack a)
-> (Pack a -> Pack a -> Pack a)
-> Ord (Pack a)
Pack a -> Pack a -> Bool
Pack a -> Pack a -> Ordering
Pack a -> Pack a -> Pack a
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. Ord a => Eq (Pack a)
forall a. Ord a => Pack a -> Pack a -> Bool
forall a. Ord a => Pack a -> Pack a -> Ordering
forall a. Ord a => Pack a -> Pack a -> Pack a
min :: Pack a -> Pack a -> Pack a
$cmin :: forall a. Ord a => Pack a -> Pack a -> Pack a
max :: Pack a -> Pack a -> Pack a
$cmax :: forall a. Ord a => Pack a -> Pack a -> Pack a
>= :: Pack a -> Pack a -> Bool
$c>= :: forall a. Ord a => Pack a -> Pack a -> Bool
> :: Pack a -> Pack a -> Bool
$c> :: forall a. Ord a => Pack a -> Pack a -> Bool
<= :: Pack a -> Pack a -> Bool
$c<= :: forall a. Ord a => Pack a -> Pack a -> Bool
< :: Pack a -> Pack a -> Bool
$c< :: forall a. Ord a => Pack a -> Pack a -> Bool
compare :: Pack a -> Pack a -> Ordering
$ccompare :: forall a. Ord a => Pack a -> Pack a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Pack a)
Ord, Pack a
Pack a -> Pack a -> Bounded (Pack a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Pack a
maxBound :: Pack a
$cmaxBound :: forall a. Bounded a => Pack a
minBound :: Pack a
$cminBound :: forall a. Bounded a => Pack a
Bounded, (forall x. Pack a -> Rep (Pack a) x)
-> (forall x. Rep (Pack a) x -> Pack a) -> Generic (Pack a)
forall x. Rep (Pack a) x -> Pack a
forall x. Pack a -> Rep (Pack a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Pack a) x -> Pack a
forall a x. Pack a -> Rep (Pack a) x
$cto :: forall a x. Rep (Pack a) x -> Pack a
$cfrom :: forall a x. Pack a -> Rep (Pack a) x
Generic, Int -> Pack a -> ShowS
[Pack a] -> ShowS
Pack a -> String
(Int -> Pack a -> ShowS)
-> (Pack a -> String) -> ([Pack a] -> ShowS) -> Show (Pack a)
forall a. Show a => Int -> Pack a -> ShowS
forall a. Show a => [Pack a] -> ShowS
forall a. Show a => Pack a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pack a] -> ShowS
$cshowList :: forall a. Show a => [Pack a] -> ShowS
show :: Pack a -> String
$cshow :: forall a. Show a => Pack a -> String
showsPrec :: Int -> Pack a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Pack a -> ShowS
Show, ReadPrec [Pack a]
ReadPrec (Pack a)
Int -> ReadS (Pack a)
ReadS [Pack a]
(Int -> ReadS (Pack a))
-> ReadS [Pack a]
-> ReadPrec (Pack a)
-> ReadPrec [Pack a]
-> Read (Pack a)
forall a. Read a => ReadPrec [Pack a]
forall a. Read a => ReadPrec (Pack a)
forall a. Read a => Int -> ReadS (Pack a)
forall a. Read a => ReadS [Pack a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pack a]
$creadListPrec :: forall a. Read a => ReadPrec [Pack a]
readPrec :: ReadPrec (Pack a)
$creadPrec :: forall a. Read a => ReadPrec (Pack a)
readList :: ReadS [Pack a]
$creadList :: forall a. Read a => ReadS [Pack a]
readsPrec :: Int -> ReadS (Pack a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Pack a)
Read, Typeable, Typeable (Pack a)
DataType
Constr
Typeable (Pack a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Pack a -> c (Pack a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Pack a))
-> (Pack a -> Constr)
-> (Pack a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Pack a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pack a)))
-> ((forall b. Data b => b -> b) -> Pack a -> Pack a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Pack a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Pack a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pack a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pack a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pack a -> m (Pack a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pack a -> m (Pack a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pack a -> m (Pack a))
-> Data (Pack a)
Pack a -> DataType
Pack a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Pack a))
(forall b. Data b => b -> b) -> Pack a -> Pack a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pack a -> c (Pack a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pack a)
forall a. Data a => Typeable (Pack a)
forall a. Data a => Pack a -> DataType
forall a. Data a => Pack a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Pack a -> Pack a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Pack a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Pack a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pack a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pack a -> c (Pack a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pack a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pack a))
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) -> Pack a -> u
forall u. (forall d. Data d => d -> u) -> Pack a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pack a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pack a -> c (Pack a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Pack a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pack a))
$cPack :: Constr
$tPack :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
gmapMp :: (forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
gmapM :: (forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Pack a -> m (Pack a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pack a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Pack a -> u
gmapQ :: (forall d. Data d => d -> u) -> Pack a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Pack a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pack a -> r
gmapT :: (forall b. Data b => b -> b) -> Pack a -> Pack a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Pack a -> Pack a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pack a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pack a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Pack a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pack a))
dataTypeOf :: Pack a -> DataType
$cdataTypeOf :: forall a. Data a => Pack a -> DataType
toConstr :: Pack a -> Constr
$ctoConstr :: forall a. Data a => Pack a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pack a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pack a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pack a -> c (Pack a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pack a -> c (Pack a)
$cp1Data :: forall a. Data a => Typeable (Pack a)
Data, (forall a. Pack a -> Rep1 Pack a)
-> (forall a. Rep1 Pack a -> Pack a) -> Generic1 Pack
forall a. Rep1 Pack a -> Pack a
forall a. Pack a -> Rep1 Pack a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Pack a -> Pack a
$cfrom1 :: forall a. Pack a -> Rep1 Pack a
Generic1, a -> Pack b -> Pack a
(a -> b) -> Pack a -> Pack b
(forall a b. (a -> b) -> Pack a -> Pack b)
-> (forall a b. a -> Pack b -> Pack a) -> Functor Pack
forall a b. a -> Pack b -> Pack a
forall a b. (a -> b) -> Pack a -> Pack b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pack b -> Pack a
$c<$ :: forall a b. a -> Pack b -> Pack a
fmap :: (a -> b) -> Pack a -> Pack b
$cfmap :: forall a b. (a -> b) -> Pack a -> Pack b
Functor, b -> Pack a -> Pack a
NonEmpty (Pack a) -> Pack a
Pack a -> Pack a -> Pack a
(Pack a -> Pack a -> Pack a)
-> (NonEmpty (Pack a) -> Pack a)
-> (forall b. Integral b => b -> Pack a -> Pack a)
-> Semigroup (Pack a)
forall b. Integral b => b -> Pack a -> Pack a
forall a. Semigroup a => NonEmpty (Pack a) -> Pack a
forall a. Semigroup a => Pack a -> Pack a -> Pack a
forall a b. (Semigroup a, Integral b) => b -> Pack a -> Pack a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Pack a -> Pack a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Pack a -> Pack a
sconcat :: NonEmpty (Pack a) -> Pack a
$csconcat :: forall a. Semigroup a => NonEmpty (Pack a) -> Pack a
<> :: Pack a -> Pack a -> Pack a
$c<> :: forall a. Semigroup a => Pack a -> Pack a -> Pack a
Semigroup, Semigroup (Pack a)
Pack a
Semigroup (Pack a) =>
Pack a
-> (Pack a -> Pack a -> Pack a)
-> ([Pack a] -> Pack a)
-> Monoid (Pack a)
[Pack a] -> Pack a
Pack a -> Pack a -> Pack a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (Pack a)
forall a. Monoid a => Pack a
forall a. Monoid a => [Pack a] -> Pack a
forall a. Monoid a => Pack a -> Pack a -> Pack a
mconcat :: [Pack a] -> Pack a
$cmconcat :: forall a. Monoid a => [Pack a] -> Pack a
mappend :: Pack a -> Pack a -> Pack a
$cmappend :: forall a. Monoid a => Pack a -> Pack a -> Pack a
mempty :: Pack a
$cmempty :: forall a. Monoid a => Pack a
$cp1Monoid :: forall a. Monoid a => Semigroup (Pack a)
Monoid)

instance (NFData a) => NFData (Pack a)

instance (Finitary a) => Finitary (Pack a)

-- | We can hash any @Finitary@ by hashing its index.
instance (Finitary a, 1 <= Cardinality a) => Hashable (Pack a) where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> Pack a -> Int
hashWithSalt salt :: Int
salt = Int -> Vector Vector (CLog 256 (Cardinality a)) Word8 -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Vector Vector (CLog 256 (Cardinality a)) Word8 -> Int)
-> (Pack a -> Vector Vector (CLog 256 (Cardinality a)) Word8)
-> Pack a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Finitary a, 1 <= Cardinality a, Vector Vector Word8) =>
Pack a -> Vector Vector (WordCount a) Word8
forall (v :: * -> *) a.
(Finitary a, 1 <= Cardinality a, Vector v Word8) =>
Pack a -> Vector v (WordCount a) Word8
packWords @VU.Vector 

-- | We can serialize any @Finitary@ by serializing its index.
instance (Finitary a, 1 <= Cardinality a) => B.Binary (Pack a) where
  {-# INLINE put #-}
  put :: Pack a -> Put
put = Vector Vector (CLog 256 (Cardinality a)) Word8 -> Put
forall t. Binary t => t -> Put
B.put (Vector Vector (CLog 256 (Cardinality a)) Word8 -> Put)
-> (Pack a -> Vector Vector (CLog 256 (Cardinality a)) Word8)
-> Pack a
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Finitary a, 1 <= Cardinality a, Vector Vector Word8) =>
Pack a -> Vector Vector (WordCount a) Word8
forall (v :: * -> *) a.
(Finitary a, 1 <= Cardinality a, Vector v Word8) =>
Pack a -> Vector v (WordCount a) Word8
packWords @VU.Vector
  {-# INLINE get #-}
  get :: Get (Pack a)
get = forall a.
(Finitary a, Vector Vector Word8) =>
Vector Vector (WordCount a) Word8 -> Pack a
forall (v :: * -> *) a.
(Finitary a, Vector v Word8) =>
Vector v (WordCount a) Word8 -> Pack a
unpackWords @VU.Vector (Vector Vector (CLog 256 (Cardinality a)) Word8 -> Pack a)
-> Get (Vector Vector (CLog 256 (Cardinality a)) Word8)
-> Get (Pack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Vector Vector (CLog 256 (Cardinality a)) Word8)
forall t. Binary t => Get t
B.get

-- | As @Finitary@ instances have known limits on their indices, they can be
-- stored as their indices.
instance (Finitary a, 1 <= Cardinality a) => Storable (Pack a) where
  {-# INLINE sizeOf #-}
  sizeOf :: Pack a -> Int
sizeOf _ = Vector (CLog 256 (Cardinality a)) Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Vector Vector (CLog (Cardinality Word8) (Cardinality a)) Word8
forall a. HasCallStack => a
undefined :: VSS.Vector (WordCount a) Word8)
  {-# INLINE alignment #-}
  alignment :: Pack a -> Int
alignment _ = Vector (CLog 256 (Cardinality a)) Word8 -> Int
forall a. Storable a => a -> Int
alignment (Vector Vector (CLog (Cardinality Word8) (Cardinality a)) Word8
forall a. HasCallStack => a
undefined :: VSS.Vector (WordCount a) Word8)
  {-# INLINE peek #-}
  peek :: Ptr (Pack a) -> IO (Pack a)
peek = (Vector (CLog 256 (Cardinality a)) Word8 -> Pack a)
-> IO (Vector (CLog 256 (Cardinality a)) Word8) -> IO (Pack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (CLog 256 (Cardinality a)) Word8 -> Pack a
forall (v :: * -> *) a.
(Finitary a, Vector v Word8) =>
Vector v (WordCount a) Word8 -> Pack a
unpackWords (IO (Vector (CLog 256 (Cardinality a)) Word8) -> IO (Pack a))
-> (Ptr (Pack a) -> IO (Vector (CLog 256 (Cardinality a)) Word8))
-> Ptr (Pack a)
-> IO (Pack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Storable
  (Vector Vector (CLog (Cardinality Word8) (Cardinality a)) Word8) =>
Ptr
  (Vector Vector (CLog (Cardinality Word8) (Cardinality a)) Word8)
-> IO
     (Vector Vector (CLog (Cardinality Word8) (Cardinality a)) Word8)
forall a. Storable a => Ptr a -> IO a
peek @(VSS.Vector (WordCount a) Word8) (Ptr (Vector (CLog 256 (Cardinality a)) Word8)
 -> IO (Vector (CLog 256 (Cardinality a)) Word8))
-> (Ptr (Pack a) -> Ptr (Vector (CLog 256 (Cardinality a)) Word8))
-> Ptr (Pack a)
-> IO (Vector (CLog 256 (Cardinality a)) Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Pack a) -> Ptr (Vector (CLog 256 (Cardinality a)) Word8)
forall a b. Ptr a -> Ptr b
castPtr
  {-# INLINE poke #-}
  poke :: Ptr (Pack a) -> Pack a -> IO ()
poke ptr :: Ptr (Pack a)
ptr = Ptr (Vector (CLog 256 (Cardinality a)) Word8)
-> Vector (CLog 256 (Cardinality a)) Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Pack a) -> Ptr (Vector (CLog 256 (Cardinality a)) Word8)
forall a b. Ptr a -> Ptr b
castPtr Ptr (Pack a)
ptr) (Vector (CLog 256 (Cardinality a)) Word8 -> IO ())
-> (Pack a -> Vector (CLog 256 (Cardinality a)) Word8)
-> Pack a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Finitary a, 1 <= Cardinality a, Vector Vector Word8) =>
Pack a -> Vector Vector (WordCount a) Word8
forall (v :: * -> *) a.
(Finitary a, 1 <= Cardinality a, Vector v Word8) =>
Pack a -> Vector v (WordCount a) Word8
packWords @VS.Vector

newtype instance VU.MVector s (Pack a) = MV_Pack (VU.MVector s Word8)

instance (Finitary a, 1 <= Cardinality a) => VGM.MVector VU.MVector (Pack a) where
  {-# INLINE basicLength #-}
  basicLength :: MVector s (Pack a) -> Int
basicLength = (\x :: Int
x -> Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Finitary a, 1 <= Cardinality a) => Int
forall a. (Finitary a, 1 <= Cardinality a) => Int
lenOf @a) (Int -> Int)
-> (MVector s (Pack a) -> Int) -> MVector s (Pack a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector s Word8 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength (MVector s Word8 -> Int)
-> (MVector s (Pack a) -> MVector s Word8)
-> MVector s (Pack a)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVector s Word8 -> MVector s (Pack a))
-> MVector s (Pack a) -> MVector s Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op MVector s Word8 -> MVector s (Pack a)
forall s a. MVector s Word8 -> MVector s (Pack a)
MV_Pack
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: Int -> Int -> MVector s (Pack a) -> MVector s (Pack a)
basicUnsafeSlice i :: Int
i len :: Int
len = (MVector s Word8 -> MVector s (Pack a))
-> (MVector s Word8 -> MVector s Word8)
-> MVector s (Pack a)
-> MVector s (Pack a)
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over MVector s Word8 -> MVector s (Pack a)
forall s a. MVector s Word8 -> MVector s (Pack a)
MV_Pack (Int -> Int -> MVector s Word8 -> MVector s Word8
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.basicUnsafeSlice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Finitary a, 1 <= Cardinality a) => Int
forall a. (Finitary a, 1 <= Cardinality a) => Int
lenOf @a) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Finitary a, 1 <= Cardinality a) => Int
forall a. (Finitary a, 1 <= Cardinality a) => Int
lenOf @a))
  {-# INLINE basicOverlaps #-}
  basicOverlaps :: MVector s (Pack a) -> MVector s (Pack a) -> Bool
basicOverlaps = (MVector s Word8 -> MVector s (Pack a))
-> (MVector s Word8 -> MVector s Word8 -> Bool)
-> MVector s (Pack a)
-> MVector s (Pack a)
-> Bool
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a -> a') -> b -> b -> b'
over2 MVector s Word8 -> MVector s (Pack a)
forall s a. MVector s Word8 -> MVector s (Pack a)
MV_Pack MVector s Word8 -> MVector s Word8 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VGM.basicOverlaps
  {-# INLINE basicUnsafeNew #-}
  basicUnsafeNew :: Int -> m (MVector (PrimState m) (Pack a))
basicUnsafeNew len :: Int
len = MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a)
forall s a. MVector s Word8 -> MVector s (Pack a)
MV_Pack (MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a))
-> m (MVector (PrimState m) Word8)
-> m (MVector (PrimState m) (Pack a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Word8)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VGM.basicUnsafeNew (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Finitary a, 1 <= Cardinality a) => Int
forall a. (Finitary a, 1 <= Cardinality a) => Int
lenOf @a)
  {-# INLINE basicInitialize #-}
  basicInitialize :: MVector (PrimState m) (Pack a) -> m ()
basicInitialize = MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicInitialize (MVector (PrimState m) Word8 -> m ())
-> (MVector (PrimState m) (Pack a) -> MVector (PrimState m) Word8)
-> MVector (PrimState m) (Pack a)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a))
-> MVector (PrimState m) (Pack a) -> MVector (PrimState m) Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a)
forall s a. MVector s Word8 -> MVector s (Pack a)
MV_Pack
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeRead :: MVector (PrimState m) (Pack a) -> Int -> m (Pack a)
basicUnsafeRead (MV_Pack v) i :: Int
i = Vector Vector (CLog 256 (Cardinality a)) Word8 -> Pack a
forall (v :: * -> *) a.
(Finitary a, Vector v Word8) =>
Vector v (WordCount a) Word8 -> Pack a
unpackWords (Vector Vector (CLog 256 (Cardinality a)) Word8 -> Pack a)
-> m (Vector Vector (CLog 256 (Cardinality a)) Word8) -> m (Pack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Finite (CLog 256 (Cardinality a)) -> m Word8)
-> m (Vector Vector (CLog 256 (Cardinality a)) Word8)
forall (n :: Nat) (m :: * -> *) a.
(KnownNat n, Storable a, Monad m) =>
(Finite n -> m a) -> m (Vector n a)
VSS.generateM (MVector (PrimState m) Word8 -> Int -> m Word8
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
VGM.basicUnsafeRead MVector (PrimState m) Word8
v (Int -> m Word8)
-> (Finite (CLog 256 (Cardinality a)) -> Int)
-> Finite (CLog 256 (Cardinality a))
-> m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int)
-> (Finite (CLog 256 (Cardinality a)) -> Int)
-> Finite (CLog 256 (Cardinality a))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (CLog 256 (Cardinality a)) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  {-# INLINE basicUnsafeWrite #-}
  basicUnsafeWrite :: MVector (PrimState m) (Pack a) -> Int -> Pack a -> m ()
basicUnsafeWrite (MV_Pack v) i :: Int
i x :: Pack a
x = do let arr :: Vector Vector (WordCount a) Word8
arr = Pack a -> Vector Vector (WordCount a) Word8
forall (v :: * -> *) a.
(Finitary a, 1 <= Cardinality a, Vector v Word8) =>
Pack a -> Vector v (WordCount a) Word8
packWords Pack a
x
                                        let ixes :: [Int]
ixes = [Int
i .. (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Finitary a, 1 <= Cardinality a) => Int
forall a. (Finitary a, 1 <= Cardinality a) => Int
lenOf @a Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)]
                                        (Int -> m ()) -> [Int] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\j :: Int
j -> MVector (PrimState m) Word8 -> Int -> Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.basicUnsafeWrite MVector (PrimState m) Word8
v Int
j (Vector (CLog 256 (Cardinality a)) Word8 -> Int -> Word8
forall (n :: Nat) a. Unbox a => Vector n a -> Int -> a
VUS.unsafeIndex Vector (CLog 256 (Cardinality a)) Word8
Vector Vector (WordCount a) Word8
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))) [Int]
ixes

newtype instance VU.Vector (Pack a) = V_Pack (VU.Vector Word8)

instance (Finitary a, 1 <= Cardinality a) => VG.Vector VU.Vector (Pack a) where
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeFreeze :: Mutable Vector (PrimState m) (Pack a) -> m (Vector (Pack a))
basicUnsafeFreeze = (Vector Word8 -> Vector (Pack a))
-> m (Vector Word8) -> m (Vector (Pack a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Word8 -> Vector (Pack a)
forall a. Vector Word8 -> Vector (Pack a)
V_Pack (m (Vector Word8) -> m (Vector (Pack a)))
-> (MVector (PrimState m) (Pack a) -> m (Vector Word8))
-> MVector (PrimState m) (Pack a)
-> m (Vector (Pack a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector (PrimState m) Word8 -> m (Vector Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
VG.basicUnsafeFreeze (MVector (PrimState m) Word8 -> m (Vector Word8))
-> (MVector (PrimState m) (Pack a) -> MVector (PrimState m) Word8)
-> MVector (PrimState m) (Pack a)
-> m (Vector Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a))
-> MVector (PrimState m) (Pack a) -> MVector (PrimState m) Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a)
forall s a. MVector s Word8 -> MVector s (Pack a)
MV_Pack
  {-# INLINE basicUnsafeThaw #-}
  basicUnsafeThaw :: Vector (Pack a) -> m (Mutable Vector (PrimState m) (Pack a))
basicUnsafeThaw = (MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a))
-> m (MVector (PrimState m) Word8)
-> m (MVector (PrimState m) (Pack a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) Word8 -> MVector (PrimState m) (Pack a)
forall s a. MVector s Word8 -> MVector s (Pack a)
MV_Pack (m (MVector (PrimState m) Word8)
 -> m (MVector (PrimState m) (Pack a)))
-> (Vector (Pack a) -> m (MVector (PrimState m) Word8))
-> Vector (Pack a)
-> m (MVector (PrimState m) (Pack a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> m (MVector (PrimState m) Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
VG.basicUnsafeThaw (Vector Word8 -> m (MVector (PrimState m) Word8))
-> (Vector (Pack a) -> Vector Word8)
-> Vector (Pack a)
-> m (MVector (PrimState m) Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Word8 -> Vector (Pack a))
-> Vector (Pack a) -> Vector Word8
forall a b. Coercible a b => (a -> b) -> b -> a
op Vector Word8 -> Vector (Pack a)
forall a. Vector Word8 -> Vector (Pack a)
V_Pack
  {-# INLINE basicLength #-}
  basicLength :: Vector (Pack a) -> Int
basicLength = (Vector Word8 -> Vector (Pack a))
-> (Vector Word8 -> Int) -> Vector (Pack a) -> Int
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over Vector Word8 -> Vector (Pack a)
forall a. Vector Word8 -> Vector (Pack a)
V_Pack Vector Word8 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.basicLength
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: Int -> Int -> Vector (Pack a) -> Vector (Pack a)
basicUnsafeSlice i :: Int
i len :: Int
len = (Vector Word8 -> Vector (Pack a))
-> (Vector Word8 -> Vector Word8)
-> Vector (Pack a)
-> Vector (Pack a)
forall a b a' b'.
(Coercible a b, Coercible a' b') =>
(a -> b) -> (a -> a') -> b -> b'
over Vector Word8 -> Vector (Pack a)
forall a. Vector Word8 -> Vector (Pack a)
V_Pack (Int -> Int -> Vector Word8 -> Vector Word8
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.basicUnsafeSlice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Finitary a, 1 <= Cardinality a) => Int
forall a. (Finitary a, 1 <= Cardinality a) => Int
lenOf @a) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Finitary a, 1 <= Cardinality a) => Int
forall a. (Finitary a, 1 <= Cardinality a) => Int
lenOf @a))
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeIndexM :: Vector (Pack a) -> Int -> m (Pack a)
basicUnsafeIndexM (V_Pack v) i :: Int
i = Vector Vector (CLog 256 (Cardinality a)) Word8 -> Pack a
forall (v :: * -> *) a.
(Finitary a, Vector v Word8) =>
Vector v (WordCount a) Word8 -> Pack a
unpackWords (Vector Vector (CLog 256 (Cardinality a)) Word8 -> Pack a)
-> m (Vector Vector (CLog 256 (Cardinality a)) Word8) -> m (Pack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Finite (CLog 256 (Cardinality a)) -> m Word8)
-> m (Vector Vector (CLog 256 (Cardinality a)) Word8)
forall (n :: Nat) (m :: * -> *) a.
(KnownNat n, Storable a, Monad m) =>
(Finite n -> m a) -> m (Vector n a)
VSS.generateM (Vector Word8 -> Int -> m Word8
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
VG.basicUnsafeIndexM Vector Word8
v (Int -> m Word8)
-> (Finite (CLog 256 (Cardinality a)) -> Int)
-> Finite (CLog 256 (Cardinality a))
-> m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int)
-> (Finite (CLog 256 (Cardinality a)) -> Int)
-> Finite (CLog 256 (Cardinality a))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (CLog 256 (Cardinality a)) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

-- | We can rely on the fact that indexes of any @Finitary@ type have a fixed
-- maximum size to \'unravel\' them into a block of 'Word8's, which we can
-- easily unbox.
instance (Finitary a, 1 <= Cardinality a) => VU.Unbox (Pack a)

-- helpers

type WordCount a = CLog (Cardinality Word8) (Cardinality a)

{-# INLINE packWords #-}
packWords :: forall v a . (Finitary a, 1 <= Cardinality a, VG.Vector v Word8) => Pack a -> VGS.Vector v (WordCount a) Word8
packWords :: Pack a -> Vector v (WordCount a) Word8
packWords = State Natural (Vector v (CLog 256 (Cardinality a)) Word8)
-> Natural -> Vector v (CLog 256 (Cardinality a)) Word8
forall s a. State s a -> s -> a
evalState (StateT Natural Identity Word8
-> State Natural (Vector v (CLog 256 (Cardinality a)) Word8)
forall (v :: * -> *) (n :: Nat) (m :: * -> *) a.
(KnownNat n, Vector v a, Monad m) =>
m a -> m (Vector v n a)
VGS.replicateM StateT Natural Identity Word8
go) (Natural -> Vector v (CLog 256 (Cardinality a)) Word8)
-> (Pack a -> Natural)
-> Pack a
-> Vector v (CLog 256 (Cardinality a)) Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral (Finite (Cardinality a)), Num Natural) =>
Finite (Cardinality a) -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Natural (Finite (Cardinality a) -> Natural)
-> (Pack a -> Finite (Cardinality a)) -> Pack a -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite (a -> Finite (Cardinality a))
-> (Pack a -> a) -> Pack a -> Finite (Cardinality a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pack a -> a
forall a. Pack a -> a
unPack
  where go :: StateT Natural Identity Word8
go = do Natural
n <- StateT Natural Identity Natural
forall s (m :: * -> *). MonadState s m => m s
get
                let (d :: Natural
d, r :: Natural
r) = Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
quotRem Natural
n (Proxy (Cardinality Word8) -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal @(Cardinality Word8) Proxy (Cardinality Word8)
forall k (t :: k). Proxy t
Proxy)
                Natural -> StateT Natural Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Natural
d
                Word8 -> StateT Natural Identity Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> StateT Natural Identity Word8)
-> (Natural -> Word8) -> Natural -> StateT Natural Identity Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> StateT Natural Identity Word8)
-> Natural -> StateT Natural Identity Word8
forall a b. (a -> b) -> a -> b
$ Natural
r

{-# INLINE unpackWords #-}
unpackWords :: forall v a . (Finitary a, VG.Vector v Word8) => VGS.Vector v (WordCount a) Word8 -> Pack a
unpackWords :: Vector v (WordCount a) Word8 -> Pack a
unpackWords v :: Vector v (WordCount a) Word8
v = a -> Pack a
forall a. a -> Pack a
Pack (a -> Pack a) -> (Natural -> a) -> Natural -> Pack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Finite (Cardinality a) -> a)
-> (Natural -> Finite (Cardinality a)) -> Natural -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State Natural (Finite (Cardinality a))
-> Natural -> Finite (Cardinality a)
forall s a. State s a -> s -> a
evalState ((Finite (Cardinality a)
 -> Word8 -> State Natural (Finite (Cardinality a)))
-> Finite (Cardinality a)
-> Vector v (CLog 256 (Cardinality a)) Word8
-> State Natural (Finite (Cardinality a))
forall (m :: * -> *) (v :: * -> *) b a (n :: Nat).
(Monad m, Vector v b) =>
(a -> b -> m a) -> a -> Vector v n b -> m a
VGS.foldM Finite (Cardinality a)
-> Word8 -> State Natural (Finite (Cardinality a))
forall (m :: * -> *) a b.
(MonadState Natural m, Integral a, Num b) =>
b -> a -> m b
go 0 Vector v (CLog 256 (Cardinality a)) Word8
Vector v (WordCount a) Word8
v) (Natural -> Pack a) -> Natural -> Pack a
forall a b. (a -> b) -> a -> b
$ 1
  where go :: b -> a -> m b
go acc :: b
acc w :: a
w = do Natural
power <- m Natural
forall s (m :: * -> *). MonadState s m => m s
get
                      (Natural -> Natural) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\x :: Natural
x -> Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Proxy (Cardinality Word8) -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal @(Cardinality Word8) Proxy (Cardinality Word8)
forall k (t :: k). Proxy t
Proxy)
                      b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b
acc b -> b -> b
forall a. Num a => a -> a -> a
+ Natural -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
power b -> b -> b
forall a. Num a => a -> a -> a
* a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)

{-# INLINE lenOf #-}  
lenOf :: forall a . (Finitary a, 1 <= Cardinality a) => Int
lenOf :: Int
lenOf = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int)
-> (Proxy (CLog 256 (Cardinality a)) -> Natural)
-> Proxy (CLog 256 (Cardinality a))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
forall (proxy :: Nat -> *).
KnownNat (WordCount a) =>
proxy (WordCount a) -> Natural
natVal @(WordCount a) (Proxy (CLog 256 (Cardinality a)) -> Int)
-> Proxy (CLog 256 (Cardinality a)) -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (CLog 256 (Cardinality a))
forall k (t :: k). Proxy t
Proxy