@@ -6,31 +6,27 @@
66{-# LANGUAGE TypeFamilies #-}
77{-# LANGUAGE TypeOperators #-}
88{-# LANGUAGE UndecidableInstances #-}
9−{-# LANGUAGE ViewPatterns #-}
109
11−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver -fno-warn-orphans #-}
10+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
1211
1312module DMap
1413 ( spec
1514 ) where
1615
17−import Criterion.Main (bench, nf, whnf, env)
16+import Criterion.Main (bench, env, nf, whnf)
1817
1918import Prelude hiding (lookup)
2019
21−import Spec
22−import Control.DeepSeq (NFData(..))
20+import Control.DeepSeq (NFData (..))
2321import Data.Maybe (fromJust)
2422import Data.Proxy (Proxy (..))
25−import Data.Type.Equality ((:~:) (..))
2623import GHC.TypeLits
24+import Spec
2725import Type.Reflection (TypeRep, Typeable, typeRep)
2826import Type.Reflection.Unsafe (typeRepFingerprint)
29−import Unsafe.Coerce (unsafeCoerce)
3027
3128import Data.Dependent.Map (DMap, empty, insert, keys, lookup)
32−import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))
33−import Data.Some (Some (This))
29+import Data.Some (Some (Some))
3430
3531type TypeRepMap = DMap TypeRep
3632
@@ -40,7 +36,7 @@ spec = BenchSpec
4036 { benchLookup = Just $ \name ->
4137 env mkBigMap $ \ ~(DMapNF bigMap) ->
4238 bench name $ nf tenLookups bigMap
43− , benchInsertSmall = Just $ \name ->
39+ , benchInsertSmall = Just $ \name ->
4440 bench name $ whnf (inserts empty 10) (Proxy @ 99999)
4541 , benchInsertBig = Just $ \name ->
4642 env mkBigMap $ \ ~(DMapNF bigMap) ->
@@ -86,20 +82,5 @@ buildBigMap n x = insert (typeRep @a) x
8682newtype DMapNF f = DMapNF (TypeRepMap f)
8783
8884instance NFData (DMapNF f) where
89− rnf (DMapNF x) =
90− rnf . map (\(This t) -> typeRepFingerprint t) $ keys x
91−
92−instance GEq TypeRep where
93− geq :: TypeRep a -> TypeRep b -> Maybe (a :~: b)
94− geq (typeRepFingerprint -> a) (typeRepFingerprint -> b) =
95− if a == b
96− then Just $ unsafeCoerce Refl
97− else Nothing
98−
99−instance GCompare TypeRep where
100− gcompare :: TypeRep a -> TypeRep b -> GOrdering a b
101− gcompare (typeRepFingerprint -> a) (typeRepFingerprint -> b) =
102− case compare a b of
103− EQ -> unsafeCoerce GEQ
104− LT -> GLT
105− GT -> GGT
85+ rnf (DMapNF x) =
86+ rnf . map (\(Some t) -> typeRepFingerprint t) $ keys x