{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE TypeFamilies          #-}

{- |
Copyright:  (c) 2017-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

TypeRepMap implementation based on Vector.
-}

module Data.TypeRep.Vector
       ( TypeRepVector (..)
       , TF (..)
       , empty
       , insert
       , lookup
       , size
       , fromList
       ) where

import Prelude hiding (lookup)

import Control.Arrow ((&&&))
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
import Data.Word (Word64)
import GHC.Base hiding (empty)
import GHC.Exts (sortWith)
import GHC.Fingerprint (Fingerprint (..))
import Unsafe.Coerce (unsafeCoerce)

import qualified Data.Vector as V
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Unboxed as Unboxed


data instance Unboxed.MVector s Fingerprint = MFingerprintVector (Unboxed.MVector s Word64) (Unboxed.MVector s Word64)
data instance Unboxed.Vector Fingerprint = FingerprintVector (Unboxed.Vector Word64) (Unboxed.Vector Word64)

instance Unboxed.Unbox Fingerprint

instance M.MVector Unboxed.MVector Fingerprint where
    {-# INLINE basicLength  #-}
    basicLength :: MVector s Fingerprint -> Int
basicLength (MFingerprintVector x _) = MVector s Word64 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s Word64
x
    {-# INLINE basicUnsafeSlice  #-}
    basicUnsafeSlice :: Int -> Int -> MVector s Fingerprint -> MVector s Fingerprint
basicUnsafeSlice Int
i Int
m (MFingerprintVector a b) =
        MVector s Word64 -> MVector s Word64 -> MVector s Fingerprint
forall s.
MVector s Word64 -> MVector s Word64 -> MVector s Fingerprint
MFingerprintVector (Int -> Int -> MVector s Word64 -> MVector s Word64
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
m MVector s Word64
a) (Int -> Int -> MVector s Word64 -> MVector s Word64
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
m MVector s Word64
b)
    {-# INLINE basicOverlaps  #-}
    basicOverlaps :: MVector s Fingerprint -> MVector s Fingerprint -> Bool
basicOverlaps (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) =
        MVector s Word64 -> MVector s Word64 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s Word64
as1 MVector s Word64
as2 Bool -> Bool -> Bool
|| MVector s Word64 -> MVector s Word64 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s Word64
bs1 MVector s Word64
bs2
    {-# INLINE basicUnsafeNew  #-}
    basicUnsafeNew :: Int -> m (MVector (PrimState m) Fingerprint)
basicUnsafeNew Int
n_ = do
        MVector (PrimState m) Word64
as <- Int -> m (MVector (PrimState m) Word64)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n_
        MVector (PrimState m) Word64
bs <- Int -> m (MVector (PrimState m) Word64)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n_
        MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) Fingerprint
 -> m (MVector (PrimState m) Fingerprint))
-> MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) Word64
-> MVector (PrimState m) Word64
-> MVector (PrimState m) Fingerprint
forall s.
MVector s Word64 -> MVector s Word64 -> MVector s Fingerprint
MFingerprintVector MVector (PrimState m) Word64
as MVector (PrimState m) Word64
bs
    {-# INLINE basicInitialize  #-}
    basicInitialize :: MVector (PrimState m) Fingerprint -> m ()
basicInitialize (MFingerprintVector as bs) = do
        MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) Word64
as
        MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) Word64
bs
    {-# INLINE basicUnsafeReplicate  #-}
    basicUnsafeReplicate :: Int -> Fingerprint -> m (MVector (PrimState m) Fingerprint)
basicUnsafeReplicate Int
n_ (Fingerprint Word64
a Word64
b) = do
        MVector (PrimState m) Word64
as <- Int -> Word64 -> m (MVector (PrimState m) Word64)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n_ Word64
a
        MVector (PrimState m) Word64
bs <- Int -> Word64 -> m (MVector (PrimState m) Word64)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n_ Word64
b
        MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) Fingerprint
 -> m (MVector (PrimState m) Fingerprint))
-> MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) Word64
-> MVector (PrimState m) Word64
-> MVector (PrimState m) Fingerprint
forall s.
MVector s Word64 -> MVector s Word64 -> MVector s Fingerprint
MFingerprintVector MVector (PrimState m) Word64
as MVector (PrimState m) Word64
bs
    {-# INLINE basicUnsafeRead  #-}
    basicUnsafeRead :: MVector (PrimState m) Fingerprint -> Int -> m Fingerprint
basicUnsafeRead (MFingerprintVector as bs) Int
i_ = do
        Word64
a <- MVector (PrimState m) Word64 -> Int -> m Word64
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) Word64
as Int
i_
        Word64
b <- MVector (PrimState m) Word64 -> Int -> m Word64
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) Word64
bs Int
i_
        Fingerprint -> m Fingerprint
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Fingerprint
Fingerprint Word64
a Word64
b)
    {-# INLINE basicUnsafeWrite  #-}
    basicUnsafeWrite :: MVector (PrimState m) Fingerprint -> Int -> Fingerprint -> m ()
basicUnsafeWrite (MFingerprintVector as bs) Int
i_ (Fingerprint Word64
a Word64
b) = do
        MVector (PrimState m) Word64 -> Int -> Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) Word64
as Int
i_ Word64
a
        MVector (PrimState m) Word64 -> Int -> Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) Word64
bs Int
i_ Word64
b
    {-# INLINE basicClear  #-}
    basicClear :: MVector (PrimState m) Fingerprint -> m ()
basicClear (MFingerprintVector as bs) = do
        MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) Word64
as
        MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) Word64
bs
    {-# INLINE basicSet  #-}
    basicSet :: MVector (PrimState m) Fingerprint -> Fingerprint -> m ()
basicSet (MFingerprintVector as bs) (Fingerprint Word64
a Word64
b) = do
        MVector (PrimState m) Word64 -> Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) Word64
as Word64
a
        MVector (PrimState m) Word64 -> Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) Word64
bs Word64
b
    {-# INLINE basicUnsafeCopy  #-}
    basicUnsafeCopy :: MVector (PrimState m) Fingerprint
-> MVector (PrimState m) Fingerprint -> m ()
basicUnsafeCopy (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) = do
        MVector (PrimState m) Word64
-> MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) Word64
as1 MVector (PrimState m) Word64
as2
        MVector (PrimState m) Word64
-> MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) Word64
bs1 MVector (PrimState m) Word64
bs2
    {-# INLINE basicUnsafeMove  #-}
    basicUnsafeMove :: MVector (PrimState m) Fingerprint
-> MVector (PrimState m) Fingerprint -> m ()
basicUnsafeMove (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) = do
        MVector (PrimState m) Word64
-> MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) Word64
as1 MVector (PrimState m) Word64
as2
        MVector (PrimState m) Word64
-> MVector (PrimState m) Word64 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) Word64
bs1 MVector (PrimState m) Word64
bs2
    {-# INLINE basicUnsafeGrow  #-}
    basicUnsafeGrow :: MVector (PrimState m) Fingerprint
-> Int -> m (MVector (PrimState m) Fingerprint)
basicUnsafeGrow (MFingerprintVector as bs) Int
m_ = do
        MVector (PrimState m) Word64
as' <- MVector (PrimState m) Word64
-> Int -> m (MVector (PrimState m) Word64)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) Word64
as Int
m_
        MVector (PrimState m) Word64
bs' <- MVector (PrimState m) Word64
-> Int -> m (MVector (PrimState m) Word64)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) Word64
bs Int
m_
        MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) Fingerprint
 -> m (MVector (PrimState m) Fingerprint))
-> MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) Word64
-> MVector (PrimState m) Word64
-> MVector (PrimState m) Fingerprint
forall s.
MVector s Word64 -> MVector s Word64 -> MVector s Fingerprint
MFingerprintVector MVector (PrimState m) Word64
as' MVector (PrimState m) Word64
bs'

instance G.Vector Unboxed.Vector Fingerprint where
    {-# INLINE basicUnsafeFreeze  #-}
    basicUnsafeFreeze :: Mutable Vector (PrimState m) Fingerprint -> m (Vector Fingerprint)
basicUnsafeFreeze (MFingerprintVector as bs) = do
        Vector Word64
as' <- Mutable Vector (PrimState m) Word64 -> m (Vector Word64)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) Word64
Mutable Vector (PrimState m) Word64
as
        Vector Word64
bs' <- Mutable Vector (PrimState m) Word64 -> m (Vector Word64)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) Word64
Mutable Vector (PrimState m) Word64
bs
        Vector Fingerprint -> m (Vector Fingerprint)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Fingerprint -> m (Vector Fingerprint))
-> Vector Fingerprint -> m (Vector Fingerprint)
forall a b. (a -> b) -> a -> b
$ Vector Word64 -> Vector Word64 -> Vector Fingerprint
FingerprintVector Vector Word64
as' Vector Word64
bs'
    {-# INLINE basicUnsafeThaw  #-}
    basicUnsafeThaw :: Vector Fingerprint -> m (Mutable Vector (PrimState m) Fingerprint)
basicUnsafeThaw (FingerprintVector as bs) = do
        MVector (PrimState m) Word64
as' <- Vector Word64 -> m (Mutable Vector (PrimState m) Word64)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector Word64
as
        MVector (PrimState m) Word64
bs' <- Vector Word64 -> m (Mutable Vector (PrimState m) Word64)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector Word64
bs
        MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) Fingerprint
 -> m (MVector (PrimState m) Fingerprint))
-> MVector (PrimState m) Fingerprint
-> m (MVector (PrimState m) Fingerprint)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) Word64
-> MVector (PrimState m) Word64
-> MVector (PrimState m) Fingerprint
forall s.
MVector s Word64 -> MVector s Word64 -> MVector s Fingerprint
MFingerprintVector MVector (PrimState m) Word64
as' MVector (PrimState m) Word64
bs'
    {-# INLINE basicLength  #-}
    basicLength :: Vector Fingerprint -> Int
basicLength (FingerprintVector x _) = Vector Word64 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector Word64
x
    {-# INLINE basicUnsafeSlice  #-}
    basicUnsafeSlice :: Int -> Int -> Vector Fingerprint -> Vector Fingerprint
basicUnsafeSlice Int
i_ Int
m_ (FingerprintVector as bs) =
        Vector Word64 -> Vector Word64 -> Vector Fingerprint
FingerprintVector (Int -> Int -> Vector Word64 -> Vector Word64
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i_ Int
m_ Vector Word64
as) (Int -> Int -> Vector Word64 -> Vector Word64
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i_ Int
m_ Vector Word64
bs)
    {-# INLINE basicUnsafeIndexM  #-}
    basicUnsafeIndexM :: Vector Fingerprint -> Int -> m Fingerprint
basicUnsafeIndexM (FingerprintVector as bs) Int
i_ = do
        Word64
a <- Vector Word64 -> Int -> m Word64
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector Word64
as Int
i_
        Word64
b <- Vector Word64 -> Int -> m Word64
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector Word64
bs Int
i_
        Fingerprint -> m Fingerprint
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Fingerprint
Fingerprint Word64
a Word64
b)
    {-# INLINE basicUnsafeCopy  #-}
    basicUnsafeCopy :: Mutable Vector (PrimState m) Fingerprint
-> Vector Fingerprint -> m ()
basicUnsafeCopy (MFingerprintVector as1 bs1) (FingerprintVector as2 bs2) = do
        Mutable Vector (PrimState m) Word64 -> Vector Word64 -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) Word64
Mutable Vector (PrimState m) Word64
as1 Vector Word64
as2
        Mutable Vector (PrimState m) Word64 -> Vector Word64 -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) Word64
Mutable Vector (PrimState m) Word64
bs1 Vector Word64
bs2
    {-# INLINE elemseq  #-}
    elemseq :: Vector Fingerprint -> Fingerprint -> b -> b
elemseq Vector Fingerprint
_ (Fingerprint Word64
a Word64
b)
        = Vector Word64 -> Word64 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Unboxed.Vector a) Word64
a
        (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> Word64 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Unboxed.Vector b) Word64
b

data TypeRepVector f = TypeRepVect
    { TypeRepVector f -> Vector Fingerprint
fingerprints :: Unboxed.Vector Fingerprint
    , TypeRepVector f -> Vector Any
anys         :: V.Vector Any
    }

fromAny :: Any -> f a
fromAny :: Any -> f a
fromAny = Any -> f a
forall a b. a -> b
unsafeCoerce

-- | Empty structure.
empty :: TypeRepVector f
empty :: TypeRepVector f
empty = Vector Fingerprint -> Vector Any -> TypeRepVector f
forall k (f :: k).
Vector Fingerprint -> Vector Any -> TypeRepVector f
TypeRepVect Vector Fingerprint
forall a. Monoid a => a
mempty Vector Any
forall a. Monoid a => a
mempty

-- | Inserts the value with its type as a key.
insert :: forall a f . a -> TypeRepVector f -> TypeRepVector f
insert :: a -> TypeRepVector f -> TypeRepVector f
insert = a -> TypeRepVector f -> TypeRepVector f
forall a. HasCallStack => a
undefined

-- | Looks up the value at the type.
-- >>> let x = lookup $ insert (11 :: Int) empty
-- >>> x :: Maybe Int
-- Just 11
-- >>> x :: Maybe ()
-- Nothing
lookup :: forall a f . Typeable a => TypeRepVector f -> Maybe (f a)
lookup :: TypeRepVector f -> Maybe (f a)
lookup TypeRepVector f
tVect =  Any -> f a
forall k (f :: k -> *) (a :: k). Any -> f a
fromAny (Any -> f a) -> (Int -> Any) -> Int -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeRepVector f -> Vector Any
forall k (f :: k). TypeRepVector f -> Vector Any
anys TypeRepVector f
tVect Vector Any -> Int -> Any
forall a. Vector a -> Int -> a
V.!)
            (Int -> f a) -> Maybe Int -> Maybe (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fingerprint -> Vector Fingerprint -> Maybe Int
binarySearch (TypeRep -> Fingerprint
typeRepFingerprint (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))) (TypeRepVector f -> Vector Fingerprint
forall k (f :: k). TypeRepVector f -> Vector Fingerprint
fingerprints TypeRepVector f
tVect)

-- | Returns the size of the 'TypeRepVect'.
size :: TypeRepVector f -> Int
size :: TypeRepVector f -> Int
size = Vector Fingerprint -> Int
forall a. Unbox a => Vector a -> Int
Unboxed.length (Vector Fingerprint -> Int)
-> (TypeRepVector f -> Vector Fingerprint)
-> TypeRepVector f
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRepVector f -> Vector Fingerprint
forall k (f :: k). TypeRepVector f -> Vector Fingerprint
fingerprints

data TF f where
  TF :: Typeable a => f a -> TF f

fromF :: f a -> Proxy a
fromF :: f a -> Proxy a
fromF f a
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

fromList :: forall f . [TF f] -> TypeRepVector f
fromList :: [TF f] -> TypeRepVector f
fromList [TF f]
tfs = Vector Fingerprint -> Vector Any -> TypeRepVector f
forall k (f :: k).
Vector Fingerprint -> Vector Any -> TypeRepVector f
TypeRepVect ([Fingerprint] -> Vector Fingerprint
forall a. Unbox a => [a] -> Vector a
Unboxed.fromList [Fingerprint]
fps) ([Any] -> Vector Any
forall a. [a] -> Vector a
V.fromList [Any]
ans)
  where
    ([Fingerprint]
fps, [Any]
ans) = [(Fingerprint, Any)] -> ([Fingerprint], [Any])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Fingerprint, Any)] -> ([Fingerprint], [Any]))
-> [(Fingerprint, Any)] -> ([Fingerprint], [Any])
forall a b. (a -> b) -> a -> b
$ ((Fingerprint, Any) -> Fingerprint)
-> [(Fingerprint, Any)] -> [(Fingerprint, Any)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Fingerprint, Any) -> Fingerprint
forall a b. (a, b) -> a
fst ([(Fingerprint, Any)] -> [(Fingerprint, Any)])
-> [(Fingerprint, Any)] -> [(Fingerprint, Any)]
forall a b. (a -> b) -> a -> b
$ (TF f -> (Fingerprint, Any)) -> [TF f] -> [(Fingerprint, Any)]
forall a b. (a -> b) -> [a] -> [b]
map (TF f -> Fingerprint
fp (TF f -> Fingerprint)
-> (TF f -> Any) -> TF f -> (Fingerprint, Any)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TF f -> Any
an) [TF f]
tfs

    fp :: TF f -> Fingerprint
    fp :: TF f -> Fingerprint
fp (TF f a
x) = TypeRep -> Fingerprint
typeRepFingerprint (TypeRep -> Fingerprint) -> TypeRep -> Fingerprint
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ f a -> Proxy a
forall k (f :: k -> *) (a :: k). f a -> Proxy a
fromF f a
x

    an :: TF f -> Any
    an :: TF f -> Any
an (TF f a
x) = f a -> Any
forall a b. a -> b
unsafeCoerce f a
x

-- | Returns the index is found.
binarySearch :: Fingerprint -> Unboxed.Vector Fingerprint -> Maybe Int
binarySearch :: Fingerprint -> Vector Fingerprint -> Maybe Int
binarySearch Fingerprint
fp Vector Fingerprint
fpVect =
    let
      !(I# Int#
len) = Vector Fingerprint -> Int
forall a. Unbox a => Vector a -> Int
Unboxed.length Vector Fingerprint
fpVect
      ind :: Int
ind = Int# -> Int
I# (Int# -> Int# -> Int#
binSearchHelp (Int#
-1#) Int#
len)
    in
      if Fingerprint
fp Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== (Vector Fingerprint
fpVect Vector Fingerprint -> Int -> Fingerprint
forall a. Unbox a => Vector a -> Int -> a
Unboxed.! Int
ind) then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ind else Maybe Int
forall a. Maybe a
Nothing
  where
    binSearchHelp :: Int# -> Int# -> Int#
    binSearchHelp :: Int# -> Int# -> Int#
binSearchHelp Int#
l Int#
r = case Int#
l Int# -> Int# -> Int#
<# (Int#
r Int# -> Int# -> Int#
-# Int#
1#) of
        Int#
0# -> Int#
r
        Int#
_ ->
            let m :: Int#
m = Int# -> Int# -> Int#
uncheckedIShiftRA# (Int#
l Int# -> Int# -> Int#
+# Int#
r) Int#
1# in
            if Vector Fingerprint -> Int -> Fingerprint
forall a. Unbox a => Vector a -> Int -> a
Unboxed.unsafeIndex Vector Fingerprint
fpVect (Int# -> Int
I# Int#
m) Fingerprint -> Fingerprint -> Bool
forall a. Ord a => a -> a -> Bool
< Fingerprint
fp
                then Int# -> Int# -> Int#
binSearchHelp Int#
m Int#
r
                else Int# -> Int# -> Int#
binSearchHelp Int#
l Int#
m