@@ -8,6 +8,8 @@
88{-# LANGUAGE RankNTypes #-}
99{-# LANGUAGE ScopedTypeVariables #-}
1010{-# LANGUAGE TypeFamilies #-}
11+{-# LANGUAGE TypeApplications #-}
12+{-# LANGUAGE MagicHash, BangPatterns #-}
1113
1214
1315module Data.TypeRep.Vector
@@ -26,107 +28,20 @@ import Control.Arrow ((&&&))
2628import Data.Proxy (Proxy (..))
2729import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
2830import Data.Word (Word64)
29−import GHC.Base (Any)
31+import GHC.Base hiding (empty)
3032import GHC.Exts (sortWith)
3133import GHC.Fingerprint (Fingerprint (..))
3234import Unsafe.Coerce (unsafeCoerce)
35+import Control.Monad.ST
36+import GHC.Prim
3337
3438import qualified Data.Vector as V
3539import qualified Data.Vector.Generic as G
3640import qualified Data.Vector.Generic.Mutable as M
37−import qualified Data.Vector.Unboxed as Unboxed
38−
39−data instance Unboxed.MVector s Fingerprint = MFingerprintVector (Unboxed.MVector s Word64) (Unboxed.MVector s Word64)
40−data instance Unboxed.Vector Fingerprint = FingerprintVector (Unboxed.Vector Word64) (Unboxed.Vector Word64)
41−
42−instance Unboxed.Unbox Fingerprint
43−
44−instance M.MVector Unboxed.MVector Fingerprint where
45− {-# INLINE basicLength #-}
46− basicLength (MFingerprintVector x _) = M.basicLength x
47− {-# INLINE basicUnsafeSlice #-}
48− basicUnsafeSlice i m (MFingerprintVector a b) =
49− MFingerprintVector (M.basicUnsafeSlice i m a) (M.basicUnsafeSlice i m b)
50− {-# INLINE basicOverlaps #-}
51− basicOverlaps (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) =
52− M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2
53− {-# INLINE basicUnsafeNew #-}
54− basicUnsafeNew n_ = do
55− as <- M.basicUnsafeNew n_
56− bs <- M.basicUnsafeNew n_
57− return $ MFingerprintVector as bs
58− {-# INLINE basicInitialize #-}
59− basicInitialize (MFingerprintVector as bs) = do
60− M.basicInitialize as
61− M.basicInitialize bs
62− {-# INLINE basicUnsafeReplicate #-}
63− basicUnsafeReplicate n_ (Fingerprint a b) = do
64− as <- M.basicUnsafeReplicate n_ a
65− bs <- M.basicUnsafeReplicate n_ b
66− return $ MFingerprintVector as bs
67− {-# INLINE basicUnsafeRead #-}
68− basicUnsafeRead (MFingerprintVector as bs) i_ = do
69− a <- M.basicUnsafeRead as i_
70− b <- M.basicUnsafeRead bs i_
71− return (Fingerprint a b)
72− {-# INLINE basicUnsafeWrite #-}
73− basicUnsafeWrite (MFingerprintVector as bs) i_ (Fingerprint a b) = do
74− M.basicUnsafeWrite as i_ a
75− M.basicUnsafeWrite bs i_ b
76− {-# INLINE basicClear #-}
77− basicClear (MFingerprintVector as bs) = do
78− M.basicClear as
79− M.basicClear bs
80− {-# INLINE basicSet #-}
81− basicSet (MFingerprintVector as bs) (Fingerprint a b) = do
82− M.basicSet as a
83− M.basicSet bs b
84− {-# INLINE basicUnsafeCopy #-}
85− basicUnsafeCopy (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) = do
86− M.basicUnsafeCopy as1 as2
87− M.basicUnsafeCopy bs1 bs2
88− {-# INLINE basicUnsafeMove #-}
89− basicUnsafeMove (MFingerprintVector as1 bs1) (MFingerprintVector as2 bs2) = do
90− M.basicUnsafeMove as1 as2
91− M.basicUnsafeMove bs1 bs2
92− {-# INLINE basicUnsafeGrow #-}
93− basicUnsafeGrow (MFingerprintVector as bs) m_ = do
94− as' <- M.basicUnsafeGrow as m_
95− bs' <- M.basicUnsafeGrow bs m_
96− return $ MFingerprintVector as' bs'
97−
98−instance G.Vector Unboxed.Vector Fingerprint where
99− {-# INLINE basicUnsafeFreeze #-}
100− basicUnsafeFreeze (MFingerprintVector as bs) = do
101− as' <- G.basicUnsafeFreeze as
102− bs' <- G.basicUnsafeFreeze bs
103− return $ FingerprintVector as' bs'
104− {-# INLINE basicUnsafeThaw #-}
105− basicUnsafeThaw (FingerprintVector as bs) = do
106− as' <- G.basicUnsafeThaw as
107− bs' <- G.basicUnsafeThaw bs
108− return $ MFingerprintVector as' bs'
109− {-# INLINE basicLength #-}
110− basicLength (FingerprintVector x _) = G.basicLength x
111− {-# INLINE basicUnsafeSlice #-}
112− basicUnsafeSlice i_ m_ (FingerprintVector as bs) =
113− FingerprintVector (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs)
114− {-# INLINE basicUnsafeIndexM #-}
115− basicUnsafeIndexM (FingerprintVector as bs) i_ = do
116− a <- G.basicUnsafeIndexM as i_
117− b <- G.basicUnsafeIndexM bs i_
118− return (Fingerprint a b)
119− {-# INLINE basicUnsafeCopy #-}
120− basicUnsafeCopy (MFingerprintVector as1 bs1) (FingerprintVector as2 bs2) = do
121− G.basicUnsafeCopy as1 as2
122− G.basicUnsafeCopy bs1 bs2
123− {-# INLINE elemseq #-}
124− elemseq _ (Fingerprint a b)
125− = G.elemseq (undefined :: Unboxed.Vector a) a
126− . G.elemseq (undefined :: Unboxed.Vector b) b
41+import qualified Data.Vector.Storable as Storable
12742
12843data TypeRepVector f = TypeRepVect
129− { fingerprints :: Unboxed.Vector Fingerprint
44+ { fingerprints :: V.Vector Fingerprint
13045 , anys :: V.Vector Any
13146 }
13247
@@ -144,7 +59,7 @@ insert = undefined
14459-- | Looks up the value at the type.
14560-- >>> let x = lookup $ insert (11 :: Int) empty
14661-- >>> x :: Maybe Int
147−-- Just 11a Ty
62+-- Just 11
14863-- >>> x :: Maybe ()
14964-- Nothing
15065lookup :: forall a f . Typeable a => TypeRepVector f -> Maybe (f a)
@@ -153,7 +68,7 @@ lookup tVect = fromAny . (anys tVect V.!)
15368
15469-- | Returns the size of the 'TypeRepVect'.
15570size :: TypeRepVector f -> Int
156−size = Unboxed.length . fingerprints
71+size = V.length . fingerprints
15772
15873data TF f where
15974 TF :: Typeable a => f a -> TF f
@@ -162,7 +77,7 @@ fromF :: Typeable a => f a -> Proxy a
16277fromF _ = Proxy
16378
16479fromList :: forall f . [TF f] -> TypeRepVector f
165−fromList tfs = TypeRepVect (Unboxed.fromList fps) (V.fromList ans)
80+fromList tfs = TypeRepVect (V.fromList fps) (V.fromList ans)
16681 where
16782 (fps, ans) = unzip $ sortWith fst $ map (fp &&& an) tfs
16883
@@ -173,16 +88,19 @@ fromList tfs = TypeRepVect (Unboxed.fromList fps) (V.fromList ans)
17388 an (TF x) = unsafeCoerce x
17489
17590-- | Returns the index is found.
176−binarySearch :: Fingerprint -> Unboxed.Vector Fingerprint -> Maybe Int
91+binarySearch :: Fingerprint -> V.Vector Fingerprint -> Maybe Int
17792binarySearch fp fpVect =
178− let ind = binSearchHelp (-1) (Unboxed.length fpVect) in
179− if fp == (fpVect Unboxed.! ind) then Just ind else Nothing
93+ let
94+ !(I# len) = V.length fpVect
95+ ind = I# (binSearchHelp (-1#) len)
96+ in
97+ if fp == (fpVect V.! ind) then Just ind else Nothing
18098 where
181− binSearchHelp :: Int -> Int -> Int
182− binSearchHelp l r = if l < r - 1
183− then (
184− let m = (l + r) `div` 2 in
185− if fpVect Unboxed.! m < fp
99+ binSearchHelp :: Int# -> Int# -> Int#
100+ binSearchHelp l r = case l <# (r -# 1#) of
101+ 0# -> r
102+ _ ->
103+ let m = uncheckedIShiftRA# (l +# r) 1# in
104+ if V.unsafeIndex fpVect (I# m) < fp
186105 then binSearchHelp m r
187− else binSearchHelp l m )
188− else r
106+ else binSearchHelp l m