@@ -38,10 +38,99 @@ import GHC.Prim
38import qualified Data.Vector as V
38import qualified Data.Vector as V
39import qualified Data.Vector.Generic as G
39import qualified Data.Vector.Generic as G
40import qualified Data.Vector.Generic.Mutable as M
40import qualified Data.Vector.Generic.Mutable as M
41−import qualified Data.Vector.Storable as Storable
41+import qualified Data.Vector.Unboxed as Unboxed
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)
46+instance Unboxed.Unbox Fingerprint
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
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
84+ {-# INLINE basicSet #-}
85+ basicSet (MFingerprintVector as bs) (Fingerprint a b) = do
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'
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
43data TypeRepVector f = TypeRepVect
132data TypeRepVector f = TypeRepVect
44− { fingerprints :: V.Vector Fingerprint
133+ { fingerprints :: Unboxed.Vector Fingerprint
45 , anys :: V.Vector Any
134 , anys :: V.Vector Any
@@ -68,7 +157,7 @@ lookup tVect = fromAny . (anys tVect V.!)
69-- | Returns the size of the 'TypeRepVect'.
158-- | Returns the size of the 'TypeRepVect'.
70size :: TypeRepVector f -> Int
159size :: TypeRepVector f -> Int
71−size = V.length . fingerprints
160+size = Unboxed.length . fingerprints
73data TF f where
162data TF f where
74 TF :: Typeable a => f a -> TF f
163 TF :: Typeable a => f a -> TF f
@@ -77,7 +166,7 @@ fromF :: Typeable a => f a -> Proxy a
77fromF _ = Proxy
166fromF _ = Proxy
79fromList :: forall f . [TF f] -> TypeRepVector f
168fromList :: 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)
82 (fps, ans) = unzip $ sortWith fst $ map (fp &&& an) tfs
171 (fps, ans) = unzip $ sortWith fst $ map (fp &&& an) tfs
@@ -88,19 +177,19 @@ fromList tfs = TypeRepVect (V.fromList fps) (V.fromList ans)
88 an (TF x) = unsafeCoerce x
177 an (TF x) = unsafeCoerce x
90-- | Returns the index is found.
179-- | Returns the index is found.
91−binarySearch :: Fingerprint -> V.Vector Fingerprint -> Maybe Int
180+binarySearch :: Fingerprint -> Unboxed.Vector Fingerprint -> Maybe Int
92binarySearch fp fpVect =
181binarySearch fp fpVect =
94− !(I# len) = V.length fpVect
183+ !(I# len) = Unboxed.length fpVect
95 ind = I# (binSearchHelp (-1#) len)
184 ind = I# (binSearchHelp (-1#) len)
97− if fp == (fpVect V.! ind) then Just ind else Nothing
186+ if fp == (fpVect Unboxed.! ind) then Just ind else Nothing
99 binSearchHelp :: Int# -> Int# -> Int#
188 binSearchHelp :: Int# -> Int# -> Int#
100 binSearchHelp l r = case l <# (r -# 1#) of
189 binSearchHelp l r = case l <# (r -# 1#) of
103 let m = uncheckedIShiftRA# (l +# r) 1# in
192 let m = uncheckedIShiftRA# (l +# r) 1# in
104− if V.unsafeIndex fpVect (I# m) < fp
193+ if Unboxed.unsafeIndex fpVect (I# m) < fp
105 then binSearchHelp m r
194 then binSearchHelp m r
106 else binSearchHelp l m
195 else binSearchHelp l m