@@ -27,7 +27,7 @@ import Control.Monad.Zip (mzip)
2727import Data.Function (on)
2828import Data.IntMap.Strict (IntMap)
2929import Data.Kind (Type)
30−import Data.List (nubBy)
30+import Data.List (intercalate, nubBy)
3131import Data.Maybe (fromJust)
3232import Data.Primitive.Array (Array, indexArray, mapArray')
3333import Data.Primitive.PrimArray (PrimArray, indexPrimArray, sizeofPrimArray)
@@ -37,7 +37,7 @@ import GHC.Exts (IsList (..), inline, sortWith)
3737import GHC.Fingerprint (Fingerprint (..))
3838import GHC.Prim (eqWord#, ltWord#)
3939import GHC.Word (Word64 (..))
40−import Type.Reflection (TypeRep, Typeable, typeRep, withTypeable)
40+import Type.Reflection (SomeTypeRep (..), TypeRep, Typeable, typeRep, withTypeable)
4141import Type.Reflection.Unsafe (typeRepFingerprint)
4242import Unsafe.Coerce (unsafeCoerce)
4343
@@ -70,14 +70,17 @@ data TypeRepMap (f :: k -> Type) =
7070 TypeRepMap
7171 { fingerprintAs :: {-# UNPACK #-} !(PrimArray Word64) -- ^ first components of key fingerprints
7272 , fingerprintBs :: {-# UNPACK #-} !(PrimArray Word64) -- ^ second components of key fingerprints
73− , anys :: {-# UNPACK #-} !(Array Any) -- ^ values stored in the map
74− , keys :: {-# UNPACK #-} !(Array Any) -- ^ typerep keys
73+ , trAnys :: {-# UNPACK #-} !(Array Any) -- ^ values stored in the map
74+ , trKeys :: {-# UNPACK #-} !(Array Any) -- ^ typerep keys
7575 }
7676 -- ^ an unsafe constructor for 'TypeRepMap'
7777
78−-- | Shows only 'Fingerprint's.
78+-- | Shows only keys.
7979instance Show (TypeRepMap f) where
80− show = show . toFingerprints
80+ show TypeRepMap{..} = "TypeRepMap [" ++ showKeys ++ "]"
81+ where
82+ showKeys :: String
83+ showKeys = intercalate ", " $ toList $ mapArray' (show . anyToTypeRep) trKeys
8184
8285-- | Uses 'union' to combine 'TypeRepMap's.
8386instance Semigroup (TypeRepMap f) where
@@ -237,7 +240,7 @@ Just (Identity 11)
237240Nothing
238241-}
239242lookup :: forall a f . Typeable a => TypeRepMap f -> Maybe (f a)
240−lookup tVect = fromAny . (anys tVect `indexArray`)
243+lookup tVect = fromAny . (trAnys tVect `indexArray`)
241244 <$> cachedBinarySearch (typeFp @a)
242245 (fingerprintAs tVect)
243246 (fingerprintBs tVect)
@@ -248,6 +251,11 @@ size :: TypeRepMap f -> Int
248251size = sizeofPrimArray . fingerprintAs
249252{-# INLINE size #-}
250253
254+-- | Return the list of 'SomeTypeRep' from the keys.
255+keys :: TypeRepMap f -> [SomeTypeRep]
256+keys TypeRepMap{..} = SomeTypeRep . anyToTypeRep <$> toList trKeys
257+{-# INLINE keys #-}
258+
251259-- | Binary searched based on this article
252260-- http://bannalia.blogspot.com/2015/06/cache-friendly-binary-search.html
253261-- with modification for our two-vector search case.
@@ -281,12 +289,15 @@ toAny = unsafeCoerce
281289fromAny :: Any -> f a
282290fromAny = unsafeCoerce
283291
292+anyToTypeRep :: Any -> TypeRep f
293+anyToTypeRep = unsafeCoerce
294+
284295typeFp :: forall a . Typeable a => Fingerprint
285296typeFp = typeRepFingerprint $ typeRep @a
286297{-# INLINE typeFp #-}
287298
288299toTriples :: TypeRepMap f -> [(Fingerprint, Any, Any)]
289−toTriples tm = zip3 (toFingerprints tm) (GHC.toList $ anys tm) (GHC.toList $ keys tm)
300+toTriples tm = zip3 (toFingerprints tm) (GHC.toList $ trAnys tm) (GHC.toList $ trKeys tm)
290301
291302deleteByFst :: Eq a => a -> [(a, b, c)] -> [(a, b, c)]
292303deleteByFst x = filter ((/= x) . fst3)
@@ -315,8 +326,8 @@ prop> fromList . toList == 'id'
315326
316327Creates 'TypeRepMap' from a list of 'WrapTypeable's.
317328
318−>>> size $ fromList [WrapTypeable $ Identity True, WrapTypeable $ Identity 'a']
319−2
329+>>> show $ fromList [WrapTypeable $ Identity True, WrapTypeable $ Identity 'a']
330+TypeRepMap [Bool, Char]
320331
321332
322333-}