@@ -38,10 +38,99 @@ import GHC.Prim
3838import qualified Data.Vector as V
3939import qualified Data.Vector.Generic as G
4040import qualified Data.Vector.Generic.Mutable as M
41−import qualified Data.Vector.Storable as Storable
41+import qualified Data.Vector.Unboxed as Unboxed
42+
43+data instance Unboxed.MVector s Fingerprint = MFingerprintVector (Unboxed.MVector s Word64) (Unboxed.MVector s Word64)
44+data instance Unboxed.Vector Fingerprint = FingerprintVector (Unboxed.Vector Word64) (Unboxed.Vector Word64)
45+
46+instance Unboxed.Unbox Fingerprint
47+
48+instance M.MVector Unboxed.MVector Fingerprint where
49+ {-# INLINE basicLength #-}
50+ basicLength (MFingerprintVector x _) = M.basicLength x
51+ {-# INLINE basicUnsafeSlice #-}
52+ basicUnsafeSlice i m (MFingerprintVector a b) =
53+ MFingerprintVector (M.basicUnsafeSlice i m a) (M.basicUnsafeSlice i m b)
54+ {-# INLINE basicOverlaps #-}
55+ basicOverlaps (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) =
56+ M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2
57+ {-# INLINE basicUnsafeNew #-}
58+ basicUnsafeNew n_ = do
59+ as <- M.basicUnsafeNew n_
60+ bs <- M.basicUnsafeNew n_
61+ return $ MFingerprintVector as bs
62+ {-# INLINE basicInitialize #-}
63+ basicInitialize (MFingerprintVector as bs) = do
64+ M.basicInitialize as
65+ M.basicInitialize bs
66+ {-# INLINE basicUnsafeReplicate #-}
67+ basicUnsafeReplicate n_ (Fingerprint a b) = do
68+ as <- M.basicUnsafeReplicate n_ a
69+ bs <- M.basicUnsafeReplicate n_ b
70+ return $ MFingerprintVector as bs
71+ {-# INLINE basicUnsafeRead #-}
72+ basicUnsafeRead (MFingerprintVector as bs) i_ = do
73+ a <- M.basicUnsafeRead as i_
74+ b <- M.basicUnsafeRead bs i_
75+ return (Fingerprint a b)
76+ {-# INLINE basicUnsafeWrite #-}
77+ basicUnsafeWrite (MFingerprintVector as bs) i_ (Fingerprint a b) = do
78+ M.basicUnsafeWrite as i_ a
79+ M.basicUnsafeWrite bs i_ b
80+ {-# INLINE basicClear #-}
81+ basicClear (MFingerprintVector as bs) = do
82+ M.basicClear as
83+ M.basicClear bs
84+ {-# INLINE basicSet #-}
85+ basicSet (MFingerprintVector as bs) (Fingerprint a b) = do
86+ M.basicSet as a
87+ M.basicSet bs b
88+ {-# INLINE basicUnsafeCopy #-}
89+ basicUnsafeCopy (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) = do
90+ M.basicUnsafeCopy as1 as2
91+ M.basicUnsafeCopy bs1 bs2
92+ {-# INLINE basicUnsafeMove #-}
93+ basicUnsafeMove (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) = do
94+ M.basicUnsafeMove as1 as2
95+ M.basicUnsafeMove bs1 bs2
96+ {-# INLINE basicUnsafeGrow #-}
97+ basicUnsafeGrow (MFingerprintVector as bs) m_ = do
98+ as' <- M.basicUnsafeGrow as m_
99+ bs' <- M.basicUnsafeGrow bs m_
100+ return $ MFingerprintVector as' bs'
101+
102+instance G.Vector Unboxed.Vector Fingerprint where
103+ {-# INLINE basicUnsafeFreeze #-}
104+ basicUnsafeFreeze (MFingerprintVector as bs) = do
105+ as' <- G.basicUnsafeFreeze as
106+ bs' <- G.basicUnsafeFreeze bs
107+ return $ FingerprintVector as' bs'
108+ {-# INLINE basicUnsafeThaw #-}
109+ basicUnsafeThaw (FingerprintVector as bs) = do
110+ as' <- G.basicUnsafeThaw as
111+ bs' <- G.basicUnsafeThaw bs
112+ return $ MFingerprintVector as' bs'
113+ {-# INLINE basicLength #-}
114+ basicLength (FingerprintVector x _) = G.basicLength x
115+ {-# INLINE basicUnsafeSlice #-}
116+ basicUnsafeSlice i_ m_ (FingerprintVector as bs) =
117+ FingerprintVector (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs)
118+ {-# INLINE basicUnsafeIndexM #-}
119+ basicUnsafeIndexM (FingerprintVector as bs) i_ = do
120+ a <- G.basicUnsafeIndexM as i_
121+ b <- G.basicUnsafeIndexM bs i_
122+ return (Fingerprint a b)
123+ {-# INLINE basicUnsafeCopy #-}
124+ basicUnsafeCopy (MFingerprintVector as1 bs1) (FingerprintVector as2 bs2) = do
125+ G.basicUnsafeCopy as1 as2
126+ G.basicUnsafeCopy bs1 bs2
127+ {-# INLINE elemseq #-}
128+ elemseq _ (Fingerprint a b)
129+ = G.elemseq (undefined :: Unboxed.Vector a) a
130+ . G.elemseq (undefined :: Unboxed.Vector b) b
42131
43132data TypeRepVector f = TypeRepVect
44− { fingerprints :: V.Vector Fingerprint
133+ { fingerprints :: Unboxed.Vector Fingerprint
45134 , anys :: V.Vector Any
46135 }
47136
@@ -68,7 +157,7 @@ lookup tVect = fromAny . (anys tVect V.!)
68157
69158-- | Returns the size of the 'TypeRepVect'.
70159size :: TypeRepVector f -> Int
71−size = V.length . fingerprints
160+size = Unboxed.length . fingerprints
72161
73162data TF f where
74163 TF :: Typeable a => f a -> TF f
@@ -77,7 +166,7 @@ fromF :: Typeable a => f a -> Proxy a
77166fromF _ = Proxy
78167
79168fromList :: forall f . [TF f] -> TypeRepVector f
80−fromList tfs = TypeRepVect (V.fromList fps) (V.fromList ans)
169+fromList tfs = TypeRepVect (Unboxed.fromList fps) (V.fromList ans)
81170 where
82171 (fps, ans) = unzip $ sortWith fst $ map (fp &&& an) tfs
83172
@@ -88,19 +177,19 @@ fromList tfs = TypeRepVect (V.fromList fps) (V.fromList ans)
88177 an (TF x) = unsafeCoerce x
89178
90179-- | Returns the index is found.
91−binarySearch :: Fingerprint -> V.Vector Fingerprint -> Maybe Int
180+binarySearch :: Fingerprint -> Unboxed.Vector Fingerprint -> Maybe Int
92181binarySearch fp fpVect =
93182 let
94− !(I# len) = V.length fpVect
183+ !(I# len) = Unboxed.length fpVect
95184 ind = I# (binSearchHelp (-1#) len)
96185 in
97− if fp == (fpVect V.! ind) then Just ind else Nothing
186+ if fp == (fpVect Unboxed.! ind) then Just ind else Nothing
98187 where
99188 binSearchHelp :: Int# -> Int# -> Int#
100189 binSearchHelp l r = case l <# (r -# 1#) of
101190 0# -> r
102191 _ ->
103192 let m = uncheckedIShiftRA# (l +# r) 1# in
104− if V.unsafeIndex fpVect (I# m) < fp
193+ if Unboxed.unsafeIndex fpVect (I# m) < fp
105194 then binSearchHelp m r
106195 else binSearchHelp l m