From 42a25dbc19babf7c1153ae19bdef609f8308de04 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Fri, 4 Mar 2022 17:10:54 +0100 Subject: [PATCH] Style imports and pragmas with stylish-haskell (#356) Also: * Tweak some module abbreviations * Properties.HashMapLazy: Tweak CPP for stylish-haskell * CONTRIBUTING.md: Add code style section --- .stylish-haskell.yaml | 9 ++ CONTRIBUTING.md | 16 ++++ Data/HashMap/Internal.hs | 153 ++++++++++++++++---------------- Data/HashMap/Internal/Array.hs | 39 ++++---- Data/HashMap/Internal/List.hs | 10 ++- Data/HashMap/Internal/Strict.hs | 47 +++++----- Data/HashMap/Lazy.hs | 7 +- Data/HashMap/Strict.hs | 5 +- Data/HashSet.hs | 4 +- Data/HashSet/Internal.hs | 57 ++++++------ benchmarks/Benchmarks.hs | 41 +++++---- benchmarks/Util/ByteString.hs | 5 +- tests/Main.hs | 2 +- tests/Properties/HashMapLazy.hs | 78 ++++++++-------- tests/Properties/HashSet.hs | 44 ++++----- tests/Properties/List.hs | 11 ++- tests/Regressions.hs | 55 ++++++------ tests/Strictness.hs | 25 +++--- utils/Stats.hs | 9 +- 19 files changed, 332 insertions(+), 285 deletions(-) create mode 100644 .stylish-haskell.yaml diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml new file mode 100644 index 00000000..3131af78 --- /dev/null +++ b/.stylish-haskell.yaml @@ -0,0 +1,9 @@ +steps: + - imports: + align: group + pad_module_names: true + long_list_align: inline + - language_pragmas: + align: true + remove_redundant: true + language_prefix: LANGUAGE diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index fd91a78e..007230bd 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -58,3 +58,19 @@ cpp-options: -DBENCH_containers_Map -DBENCH_containers_IntMap -DBENCH_hashmap_Ma * [Documentation for `cabal`](https://cabal.readthedocs.io/en/latest/) * [Documentation for our testing framework, `tasty`](https://github.com/UnkindPartition/tasty#readme) * [Documentation for our benchmark framework, `tasty-bench`](https://github.com/Bodigrim/tasty-bench#readme) + + +## Code style + +This package uses [`stylish-haskell`](https://hackage.haskell.org/package/stylish-haskell) +to format language pragmas and import sections. To format a specific file, run + +``` +stylish-haskell -i FILENAME +``` + +To format all the Haskell files under a specific directory, run + +``` +stylish-haskell -ir DIRNAME +``` diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs index 0f3a3c86..826af55f 100644 --- a/Data/HashMap/Internal.hs +++ b/Data/HashMap/Internal.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveLift #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskellQuotes #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -140,39 +140,36 @@ module Data.HashMap.Internal , adjust# ) where -import Data.Semigroup (Semigroup(..), stimesIdempotentMonoid) -import Control.DeepSeq (NFData(rnf)) -import Control.Monad.ST (ST, runST) -import Data.Bits ((.&.), (.|.), complement, popCount, unsafeShiftL, unsafeShiftR) -import Data.Data -import qualified Data.Foldable as Foldable -import Data.Bifoldable -import qualified Data.List as L -import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, inline) -import Prelude hiding (filter, foldl, foldr, lookup, map, null, pred) -import Text.Read hiding (step) - -import qualified Data.HashMap.Internal.Array as A -import qualified Data.Hashable as H -import Data.Hashable (Hashable) +import Control.Applicative (Const (..)) +import Control.DeepSeq (NFData (..), NFData1 (..), NFData2 (..)) +import Control.Monad.ST (ST, runST) +import Data.Bifoldable (Bifoldable (..)) +import Data.Bits (complement, popCount, unsafeShiftL, + unsafeShiftR, (.&.), (.|.)) +import Data.Coerce (coerce) +import Data.Data (Constr, Data (..), DataType) +import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), + Read1 (..), Show1 (..), Show2 (..)) +import Data.Functor.Identity (Identity (..)) import Data.HashMap.Internal.List (isPermutationBy, unorderedCompare) - -import GHC.Exts (isTrue#) -import qualified GHC.Exts as Exts - -import Data.Functor.Classes -import GHC.Stack - -import qualified Data.Hashable.Lifted as H - -import qualified Control.DeepSeq as NF - -import GHC.Exts (TYPE, Int (..), Int#) - -import Data.Functor.Identity (Identity (..)) -import Control.Applicative (Const (..)) -import Data.Coerce (coerce) -import qualified Language.Haskell.TH.Syntax as TH +import Data.Hashable (Hashable) +import Data.Hashable.Lifted (Hashable1, Hashable2) +import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid) +import GHC.Exts (Int (..), Int#, TYPE, (==#)) +import GHC.Stack (HasCallStack) +import Prelude hiding (filter, foldl, foldr, lookup, map, + null, pred) +import Text.Read hiding (step) + +import qualified Data.Data as Data +import qualified Data.Foldable as Foldable +import qualified Data.Functor.Classes as FC +import qualified Data.HashMap.Internal.Array as A +import qualified Data.Hashable as H +import qualified Data.Hashable.Lifted as H +import qualified Data.List as List +import qualified GHC.Exts as Exts +import qualified Language.Haskell.TH.Syntax as TH -- | A set of values. A set cannot contain duplicate values. ------------------------------------------------------------------------ @@ -196,11 +193,11 @@ instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where #endif -- | @since 0.2.14.0 -instance NFData k => NF.NFData1 (Leaf k) where - liftRnf rnf2 = NF.liftRnf2 rnf rnf2 +instance NFData k => NFData1 (Leaf k) where + liftRnf rnf2 = liftRnf2 rnf rnf2 -- | @since 0.2.14.0 -instance NF.NFData2 Leaf where +instance NFData2 Leaf where liftRnf2 rnf1 rnf2 (L k v) = rnf1 k `seq` rnf2 v -- Invariant: The length of the 1st argument to 'Full' is @@ -228,16 +225,16 @@ instance (NFData k, NFData v) => NFData (HashMap k v) where rnf (Collision _ ary) = rnf ary -- | @since 0.2.14.0 -instance NFData k => NF.NFData1 (HashMap k) where - liftRnf rnf2 = NF.liftRnf2 rnf rnf2 +instance NFData k => NFData1 (HashMap k) where + liftRnf rnf2 = liftRnf2 rnf rnf2 -- | @since 0.2.14.0 -instance NF.NFData2 HashMap where +instance NFData2 HashMap where liftRnf2 _ _ Empty = () - liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary - liftRnf2 rnf1 rnf2 (Leaf _ l) = NF.liftRnf2 rnf1 rnf2 l - liftRnf2 rnf1 rnf2 (Full ary) = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary - liftRnf2 rnf1 rnf2 (Collision _ ary) = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary + liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary + liftRnf2 rnf1 rnf2 (Leaf _ l) = liftRnf2 rnf1 rnf2 l + liftRnf2 rnf1 rnf2 (Full ary) = liftRnf (liftRnf2 rnf1 rnf2) ary + liftRnf2 rnf1 rnf2 (Collision _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary instance Functor (HashMap k) where fmap = map @@ -300,18 +297,18 @@ instance (Eq k, Hashable k) => Monoid (HashMap k v) where instance (Data k, Data v, Eq k, Hashable k) => Data (HashMap k v) where gfoldl f z m = z fromList `f` toList m toConstr _ = fromListConstr - gunfold k z c = case constrIndex c of + gunfold k z c = case Data.constrIndex c of 1 -> k (z fromList) _ -> error "gunfold" dataTypeOf _ = hashMapDataType - dataCast1 f = gcast1 f - dataCast2 f = gcast2 f + dataCast1 f = Data.gcast1 f + dataCast2 f = Data.gcast2 f fromListConstr :: Constr -fromListConstr = mkConstr hashMapDataType "fromList" [] Prefix +fromListConstr = Data.mkConstr hashMapDataType "fromList" [] Data.Prefix hashMapDataType :: DataType -hashMapDataType = mkDataType "Data.HashMap.Internal.HashMap" [fromListConstr] +hashMapDataType = Data.mkDataType "Data.HashMap.Internal.HashMap" [fromListConstr] type Hash = Word type Bitmap = Word @@ -319,7 +316,7 @@ type Shift = Int instance Show2 HashMap where liftShowsPrec2 spk slk spv slv d m = - showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m) + FC.showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m) where sp = liftShowsPrec2 spk slk spv slv sl = liftShowList2 spk slk spv slv @@ -328,8 +325,8 @@ instance Show k => Show1 (HashMap k) where liftShowsPrec = liftShowsPrec2 showsPrec showList instance (Eq k, Hashable k, Read k) => Read1 (HashMap k) where - liftReadsPrec rp rl = readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList + liftReadsPrec rp rl = FC.readsData $ + FC.readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl @@ -484,7 +481,7 @@ equalKeys = go leafEq (L k1 _) (L k2 _) = k1 == k2 -instance H.Hashable2 HashMap where +instance Hashable2 HashMap where liftHashWithSalt2 hk hv salt hm = go salt (toList' hm []) where -- go :: Int -> [HashMap k v] -> Int @@ -502,12 +499,12 @@ instance H.Hashable2 HashMap where -- hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int hashCollisionWithSalt s - = L.foldl' H.hashWithSalt s . arrayHashesSorted s + = List.foldl' H.hashWithSalt s . arrayHashesSorted s -- arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int] - arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList + arrayHashesSorted s = List.sort . List.map (hashLeafWithSalt s) . A.toList -instance (Hashable k) => H.Hashable1 (HashMap k) where +instance (Hashable k) => Hashable1 (HashMap k) where liftHashWithSalt = H.liftHashWithSalt2 H.hashWithSalt instance (Hashable k, Hashable v) => Hashable (HashMap k v) where @@ -529,10 +526,10 @@ instance (Hashable k, Hashable v) => Hashable (HashMap k v) where hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int hashCollisionWithSalt s - = L.foldl' H.hashWithSalt s . arrayHashesSorted s + = List.foldl' H.hashWithSalt s . arrayHashesSorted s arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int] - arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList + arrayHashesSorted s = List.sort . List.map (hashLeafWithSalt s) . A.toList -- Helper to get 'Leaf's and 'Collision's as a list. toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v] @@ -1410,7 +1407,7 @@ alterFEager f !k m = (<$> f mv) $ \fres -> -- -- @since 0.2.12 isSubmapOf :: (Eq k, Hashable k, Eq v) => HashMap k v -> HashMap k v -> Bool -isSubmapOf = (inline isSubmapOfBy) (==) +isSubmapOf = (Exts.inline isSubmapOfBy) (==) {-# INLINABLE isSubmapOf #-} -- | /O(n*log m)/ Inclusion of maps with value comparison. A map is included in @@ -1652,7 +1649,7 @@ unionArrayBy f b1 b2 ary1 ary2 = A.run $ do -- | Construct a set containing all elements from a list of sets. unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v -unions = L.foldl' union empty +unions = List.foldl' union empty {-# INLINE unions #-} @@ -2020,13 +2017,13 @@ filter p = filterWithKey (\_ v -> p v) -- | /O(n)/ Return a list of this map's keys. The list is produced -- lazily. keys :: HashMap k v -> [k] -keys = L.map fst . toList +keys = List.map fst . toList {-# INLINE keys #-} -- | /O(n)/ Return a list of this map's values. The list is produced -- lazily. elems :: HashMap k v -> [v] -elems = L.map snd . toList +elems = List.map snd . toList {-# INLINE elems #-} ------------------------------------------------------------------------ @@ -2035,13 +2032,13 @@ elems = L.map snd . toList -- | /O(n)/ Return a list of this map's elements. The list is -- produced lazily. The order of its elements is unspecified. toList :: HashMap k v -> [(k, v)] -toList t = build (\ c z -> foldrWithKey (curry c) z t) +toList t = Exts.build (\ c z -> foldrWithKey (curry c) z t) {-# INLINE toList #-} -- | /O(n)/ Construct a map with the supplied mappings. If the list -- contains duplicate mappings, the later mappings take precedence. fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v -fromList = L.foldl' (\ m (k, v) -> unsafeInsert k v m) empty +fromList = List.foldl' (\ m (k, v) -> unsafeInsert k v m) empty {-# INLINABLE fromList #-} -- | /O(n*log n)/ Construct a map from a list of elements. Uses @@ -2075,7 +2072,7 @@ fromList = L.foldl' (\ m (k, v) -> unsafeInsert k v m) empty -- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] -- > = fromList [(k, f d (f c (f b a)))] fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v -fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty +fromListWith f = List.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty {-# INLINE fromListWith #-} -- | /O(n*log n)/ Construct a map from a list of elements. Uses @@ -2105,7 +2102,7 @@ fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty -- -- @since 0.2.11 fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v -fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty +fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty {-# INLINE fromListWithKey #-} ------------------------------------------------------------------------ @@ -2282,7 +2279,7 @@ fullNodeMask = complement (complement 0 `unsafeShiftL` maxChildren) -- | Check if two the two arguments are the same value. N.B. This -- function might give false negatives (due to GC moving objects.) ptrEq :: a -> a -> Bool -ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y ==# 1#) +ptrEq x y = Exts.isTrue# (Exts.reallyUnsafePtrEquality# x y ==# 1#) {-# INLINE ptrEq #-} ------------------------------------------------------------------------ diff --git a/Data/HashMap/Internal/Array.hs b/Data/HashMap/Internal/Array.hs index 00010bc8..78059ba9 100644 --- a/Data/HashMap/Internal/Array.hs +++ b/Data/HashMap/Internal/Array.hs @@ -1,5 +1,10 @@ -{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -74,27 +79,27 @@ module Data.HashMap.Internal.Array ) where import Control.Applicative (liftA2) -import Control.DeepSeq (NFData (..)) -import GHC.Exts(Int(..), reallyUnsafePtrEquality#, tagToEnum#, unsafeCoerce#) -import GHC.ST (ST(..)) -import Control.Monad.ST (runST, stToIO) - -import Prelude hiding (filter, foldMap, foldr, foldl, length, map, read, traverse, all) - -import GHC.Exts (SmallArray#, newSmallArray#, readSmallArray#, writeSmallArray#, - indexSmallArray#, unsafeFreezeSmallArray#, unsafeThawSmallArray#, - SmallMutableArray#, sizeofSmallArray#, copySmallArray#, thawSmallArray#, - sizeofSmallMutableArray#, copySmallMutableArray#, cloneSmallMutableArray#) +import Control.DeepSeq (NFData (..), NFData1 (..)) +import Control.Monad ((>=>)) +import Control.Monad.ST (runST, stToIO) +import GHC.Exts (Int (..), SmallArray#, SmallMutableArray#, + cloneSmallMutableArray#, copySmallArray#, + copySmallMutableArray#, indexSmallArray#, + newSmallArray#, readSmallArray#, + reallyUnsafePtrEquality#, sizeofSmallArray#, + sizeofSmallMutableArray#, tagToEnum#, + thawSmallArray#, unsafeCoerce#, + unsafeFreezeSmallArray#, unsafeThawSmallArray#, + writeSmallArray#) +import GHC.ST (ST (..)) +import Prelude hiding (all, filter, foldMap, foldl, foldr, length, + map, read, traverse) import qualified Language.Haskell.TH.Syntax as TH - #if defined(ASSERTS) import qualified Prelude #endif -import qualified Control.DeepSeq as NF - -import Control.Monad ((>=>)) #if defined(ASSERTS) -- This fugly hack is brought by GHC's apparent reluctance to deal @@ -172,7 +177,7 @@ rnfArray ary0 = go ary0 n0 0 {-# INLINE rnfArray #-} -- | @since 0.2.14.0 -instance NF.NFData1 Array where +instance NFData1 Array where liftRnf = liftRnfArray liftRnfArray :: (a -> ()) -> Array a -> () diff --git a/Data/HashMap/Internal/List.hs b/Data/HashMap/Internal/List.hs index 8c0b639b..01b1d92c 100644 --- a/Data/HashMap/Internal/List.hs +++ b/Data/HashMap/Internal/List.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -25,10 +26,11 @@ module Data.HashMap.Internal.List , unorderedCompare ) where +import Data.List (sortBy) import Data.Maybe (fromMaybe) -import Data.List (sortBy) -import Data.Monoid -import Prelude +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup ((<>)) +#endif -- Note: previous implemenation isPermutation = null (as // bs) -- was O(n^2) too. @@ -68,7 +70,7 @@ unorderedCompare c as bs = go (sortBy cmpA as) (sortBy cmpB bs) go [] [] = EQ go [] (_ : _) = LT go (_ : _) [] = GT - go (x : xs) (y : ys) = c x y `mappend` go xs ys + go (x : xs) (y : ys) = c x y <> go xs ys cmpA a a' = compare (inB a) (inB a') cmpB b b' = compare (inA b) (inA b') diff --git a/Data/HashMap/Internal/Strict.hs b/Data/HashMap/Internal/Strict.hs index ef74a30f..8f8effcb 100644 --- a/Data/HashMap/Internal/Strict.hs +++ b/Data/HashMap/Internal/Strict.hs @@ -1,5 +1,9 @@ -{-# LANGUAGE BangPatterns, CPP, PatternGuards, MagicHash, UnboxedTuples #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_HADDOCK not-home #-} ------------------------------------------------------------------------ @@ -117,24 +121,23 @@ module Data.HashMap.Internal.Strict , fromListWithKey ) where -import Control.Monad.ST (runST) -import Data.Bits ((.&.), (.|.)) - -import qualified Data.List as L -import Data.Hashable (Hashable) -import Prelude hiding (map, lookup) - +import Control.Applicative (Const (..)) +import Control.Monad.ST (runST) +import Data.Bits ((.&.), (.|.)) +import Data.Coerce (coerce) +import Data.Functor.Identity (Identity (..)) +import Data.HashMap.Internal hiding (adjust, alter, alterF, differenceWith, + fromList, fromListWith, fromListWithKey, insert, + insertWith, intersectionWith, intersectionWithKey, + map, mapMaybe, mapMaybeWithKey, mapWithKey, + singleton, traverseWithKey, unionWith, + unionWithKey, update) +import Data.Hashable (Hashable) +import Prelude hiding (lookup, map) + +import qualified Data.HashMap.Internal as HM import qualified Data.HashMap.Internal.Array as A -import qualified Data.HashMap.Internal as HM -import Data.HashMap.Internal hiding ( - alter, alterF, adjust, fromList, fromListWith, fromListWithKey, - insert, insertWith, - differenceWith, intersectionWith, intersectionWithKey, map, mapWithKey, - mapMaybe, mapMaybeWithKey, singleton, update, unionWith, unionWithKey, - traverseWithKey) -import Data.Functor.Identity -import Control.Applicative (Const (..)) -import Data.Coerce +import qualified Data.List as List -- $strictness -- @@ -627,7 +630,7 @@ intersectionWithKey f a b = foldlWithKey' go empty a -- list contains duplicate mappings, the later mappings take -- precedence. fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v -fromList = L.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) empty +fromList = List.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) empty {-# INLINABLE fromList #-} -- | /O(n*log n)/ Construct a map from a list of elements. Uses @@ -661,7 +664,7 @@ fromList = L.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) empty -- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] -- > = fromList [(k, f d (f c (f b a)))] fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v -fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty +fromListWith f = List.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty {-# INLINE fromListWith #-} -- | /O(n*log n)/ Construct a map from a list of elements. Uses @@ -691,7 +694,7 @@ fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty -- -- @since 0.2.11 fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v -fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty +fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty {-# INLINE fromListWithKey #-} ------------------------------------------------------------------------ diff --git a/Data/HashMap/Lazy.hs b/Data/HashMap/Lazy.hs index 27759b67..0b54115c 100644 --- a/Data/HashMap/Lazy.hs +++ b/Data/HashMap/Lazy.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} ------------------------------------------------------------------------ @@ -106,9 +106,10 @@ module Data.HashMap.Lazy , HS.keysSet ) where -import Data.HashMap.Internal as HM +import Data.HashMap.Internal +import Prelude () + import qualified Data.HashSet.Internal as HS -import Prelude () -- $strictness -- diff --git a/Data/HashMap/Strict.hs b/Data/HashMap/Strict.hs index 0ba674ec..c2e9263c 100644 --- a/Data/HashMap/Strict.hs +++ b/Data/HashMap/Strict.hs @@ -105,9 +105,10 @@ module Data.HashMap.Strict , HS.keysSet ) where -import Data.HashMap.Internal.Strict as HM +import Data.HashMap.Internal.Strict +import Prelude () + import qualified Data.HashSet.Internal as HS -import Prelude () -- $strictness -- diff --git a/Data/HashSet.hs b/Data/HashSet.hs index 88cc3bec..dfa95d86 100644 --- a/Data/HashSet.hs +++ b/Data/HashSet.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} ------------------------------------------------------------------------ @@ -137,4 +137,4 @@ module Data.HashSet ) where import Data.HashSet.Internal -import Prelude () +import Prelude () diff --git a/Data/HashSet/Internal.hs b/Data/HashSet/Internal.hs index 2676d6ce..9b628d02 100644 --- a/Data/HashSet/Internal.hs +++ b/Data/HashSet/Internal.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveLift #-} -{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_HADDOCK not-home #-} ------------------------------------------------------------------------ @@ -90,25 +90,22 @@ module Data.HashSet.Internal , keysSet ) where -import Control.DeepSeq (NFData(..)) -import Data.Data +import Control.DeepSeq (NFData (..), NFData1 (..), liftRnf2) +import Data.Data (Constr, Data (..), DataType) import Data.Functor.Classes -import Data.HashMap.Internal - ( HashMap, foldMapWithKey, foldlWithKey, foldrWithKey - , equalKeys, equalKeys1) -import Data.Hashable (Hashable(hashWithSalt)) -import Data.Semigroup (Semigroup(..), stimesIdempotentMonoid) -import GHC.Exts (build) -import qualified GHC.Exts as Exts -import Prelude hiding (filter, foldr, foldl, map, null) -import qualified Data.Foldable as Foldable -import qualified Data.HashMap.Internal as H -import qualified Data.List as List +import Data.HashMap.Internal (HashMap, equalKeys, equalKeys1, foldMapWithKey, + foldlWithKey, foldrWithKey) +import Data.Hashable (Hashable (hashWithSalt)) +import Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..)) +import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid) +import Prelude hiding (filter, foldl, foldr, map, null) import Text.Read -import qualified Data.Hashable.Lifted as H - -import qualified Control.DeepSeq as NF +import qualified Data.Data as Data +import qualified Data.Foldable as Foldable +import qualified Data.HashMap.Internal as H +import qualified Data.List as List +import qualified GHC.Exts as Exts import qualified Language.Haskell.TH.Syntax as TH -- | A set of values. A set cannot contain duplicate values. @@ -126,8 +123,8 @@ instance (NFData a) => NFData (HashSet a) where {-# INLINE rnf #-} -- | @since 0.2.14.0 -instance NF.NFData1 HashSet where - liftRnf rnf1 = NF.liftRnf2 rnf1 rnf . asMap +instance NFData1 HashSet where + liftRnf rnf1 = liftRnf2 rnf1 rnf . asMap -- | Note that, in the presence of hash collisions, equal @HashSet@s may -- behave differently, i.e. substitutivity may be violated: @@ -233,23 +230,23 @@ instance (Show a) => Show (HashSet a) where instance (Data a, Eq a, Hashable a) => Data (HashSet a) where gfoldl f z m = z fromList `f` toList m toConstr _ = fromListConstr - gunfold k z c = case constrIndex c of + gunfold k z c = case Data.constrIndex c of 1 -> k (z fromList) _ -> error "gunfold" dataTypeOf _ = hashSetDataType - dataCast1 f = gcast1 f + dataCast1 f = Data.gcast1 f -instance H.Hashable1 HashSet where - liftHashWithSalt h s = H.liftHashWithSalt2 h hashWithSalt s . asMap +instance Hashable1 HashSet where + liftHashWithSalt h s = liftHashWithSalt2 h hashWithSalt s . asMap instance (Hashable a) => Hashable (HashSet a) where hashWithSalt salt = hashWithSalt salt . asMap fromListConstr :: Constr -fromListConstr = mkConstr hashSetDataType "fromList" [] Prefix +fromListConstr = Data.mkConstr hashSetDataType "fromList" [] Data.Prefix hashSetDataType :: DataType -hashSetDataType = mkDataType "Data.HashSet.Internal.HashSet" [fromListConstr] +hashSetDataType = Data.mkDataType "Data.HashSet.Internal.HashSet" [fromListConstr] -- | /O(1)/ Construct an empty set. -- @@ -445,7 +442,7 @@ filter p = HashSet . H.filterWithKey q . asMap -- | /O(n)/ Return a list of this set's elements. The list is -- produced lazily. toList :: HashSet a -> [a] -toList t = build (\ c z -> foldrWithKey ((const .) c) z (asMap t)) +toList t = Exts.build (\ c z -> foldrWithKey ((const .) c) z (asMap t)) {-# INLINE toList #-} -- | /O(n*min(W, n))/ Construct a set from a list of elements. diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs index 486fda58..8f148035 100644 --- a/benchmarks/Benchmarks.hs +++ b/benchmarks/Benchmarks.hs @@ -1,25 +1,30 @@ -{-# LANGUAGE CPP, DeriveAnyClass, DeriveGeneric, GADTs, PackageImports, RecordWildCards #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RecordWildCards #-} module Main where -import Control.DeepSeq -import Data.Bits ((.&.)) -import Data.Functor.Identity -import Data.Hashable (Hashable, hash) -import qualified Data.ByteString as BS +import Control.DeepSeq (NFData (..)) +import Data.Bits ((.&.)) +import Data.Functor.Identity (Identity (..)) +import Data.Hashable (Hashable, hash) +import Data.List (foldl') +import Data.Maybe (fromMaybe) +import GHC.Generics (Generic) +import Prelude hiding (lookup) +import Test.Tasty.Bench (bench, bgroup, defaultMain, env, nf, whnf) + +import qualified Data.ByteString as BS import qualified "hashmap" Data.HashMap as IHM -import qualified Data.HashMap.Strict as HM -import qualified Data.IntMap as IM -import qualified Data.Map as M -import Data.List (foldl') -import Data.Maybe (fromMaybe) -import GHC.Generics (Generic) -import Prelude hiding (lookup) -import Test.Tasty.Bench (bench, bgroup, defaultMain, env, nf, whnf) - -import qualified Util.ByteString as UBS -import qualified Util.Int as UI -import qualified Util.String as US +import qualified Data.HashMap.Strict as HM +import qualified Data.IntMap as IM +import qualified Data.Map as M +import qualified Util.ByteString as UBS +import qualified Util.Int as UI +import qualified Util.String as US data B where B :: NFData a => a -> B diff --git a/benchmarks/Util/ByteString.hs b/benchmarks/Util/ByteString.hs index 6359889b..45eb9aab 100644 --- a/benchmarks/Util/ByteString.hs +++ b/benchmarks/Util/ByteString.hs @@ -2,10 +2,9 @@ -- random 'ByteString's. module Util.ByteString where -import qualified Data.ByteString as S +import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C - -import Util.String as String +import qualified Util.String as String -- | Generate a number of fixed length 'ByteString's where the content -- of the strings are letters in ascending order. diff --git a/tests/Main.hs b/tests/Main.hs index c18ae77d..9e337ad2 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -2,8 +2,8 @@ module Main (main) where import Test.Tasty (defaultMain, testGroup) -import qualified Regressions import qualified Properties +import qualified Regressions import qualified Strictness main :: IO () diff --git a/tests/Properties/HashMapLazy.hs b/tests/Properties/HashMapLazy.hs index b783c4f1..8b712da3 100644 --- a/tests/Properties/HashMapLazy.hs +++ b/tests/Properties/HashMapLazy.hs @@ -1,38 +1,44 @@ -{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- because of Arbitrary (HashMap k v) -- | Tests for the 'Data.HashMap.Lazy' module. We test functions by -- comparing them to @Map@ from @containers@. #if defined(STRICT) -module Properties.HashMapStrict (tests) where +#define MODULE_NAME Properties.HashMapStrict #else -module Properties.HashMapLazy (tests) where +#define MODULE_NAME Properties.HashMapLazy #endif -import Control.Monad ( guard ) -import qualified Data.Foldable as Foldable +module MODULE_NAME (tests) where + +import Control.Applicative (Const (..)) +import Control.Monad (guard) import Data.Bifoldable -import Data.Function (on) -import Data.Hashable (Hashable(hashWithSalt)) -import qualified Data.List as L -import Data.Ord (comparing) +import Data.Function (on) +import Data.Functor.Identity (Identity (..)) +import Data.Hashable (Hashable (hashWithSalt)) +import Data.Ord (comparing) +import Test.QuickCheck (Arbitrary (..), Property, elements, forAll, + (===), (==>)) +import Test.QuickCheck.Function (Fun, apply) +import Test.QuickCheck.Poly (A, B) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import qualified Data.Foldable as Foldable +import qualified Data.List as List + #if defined(STRICT) -import Data.HashMap.Strict (HashMap) +import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM -import qualified Data.Map.Strict as M +import qualified Data.Map.Strict as M #else -import Data.HashMap.Lazy (HashMap) +import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HM -import qualified Data.Map.Lazy as M +import qualified Data.Map.Lazy as M #endif -import Test.QuickCheck (Arbitrary(..), Property, (==>), (===), forAll, elements) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) -import Data.Functor.Identity (Identity (..)) -import Control.Applicative (Const (..)) -import Test.QuickCheck.Function (Fun, apply) -import Test.QuickCheck.Poly (A, B) -- Key type that generates more hash collisions. newtype Key = K { unK :: Int } @@ -102,22 +108,22 @@ pFunctor :: [(Key, Int)] -> Bool pFunctor = fmap (+ 1) `eq_` fmap (+ 1) pFoldable :: [(Int, Int)] -> Bool -pFoldable = (L.sort . Foldable.foldr (:) []) `eq` - (L.sort . Foldable.foldr (:) []) +pFoldable = (List.sort . Foldable.foldr (:) []) `eq` + (List.sort . Foldable.foldr (:) []) pHashable :: [(Key, Int)] -> [Int] -> Int -> Property pHashable xs is salt = x == y ==> hashWithSalt salt x === hashWithSalt salt y where - xs' = L.nubBy (\(k,_) (k',_) -> k == k') xs + xs' = List.nubBy (\(k,_) (k',_) -> k == k') xs ys = shuffle is xs' x = HM.fromList xs' y = HM.fromList ys -- Shuffle the list using indexes in the second shuffle :: [Int] -> [a] -> [a] - shuffle idxs = L.map snd - . L.sortBy (comparing fst) - . L.zip (idxs ++ [L.maximum (0:is) + 1 ..]) + shuffle idxs = List.map snd + . List.sortBy (comparing fst) + . List.zip (idxs ++ [List.maximum (0:is) + 1 ..]) ------------------------------------------------------------------------ -- ** Basic interface @@ -292,8 +298,8 @@ pMap = M.map (+ 1) `eq_` HM.map (+ 1) pTraverse :: [(Key, Int)] -> Bool pTraverse xs = - L.sort (fmap (L.sort . M.toList) (M.traverseWithKey (\_ v -> [v + 1, v + 2]) (M.fromList (take 10 xs)))) - == L.sort (fmap (L.sort . HM.toList) (HM.traverseWithKey (\_ v -> [v + 1, v + 2]) (HM.fromList (take 10 xs)))) + List.sort (fmap (List.sort . M.toList) (M.traverseWithKey (\_ v -> [v + 1, v + 2]) (M.fromList (take 10 xs)))) + == List.sort (fmap (List.sort . HM.toList) (HM.traverseWithKey (\_ v -> [v + 1, v + 2]) (HM.fromList (take 10 xs)))) pMapKeys :: [(Int, Int)] -> Bool pMapKeys = M.mapKeys (+1) `eq_` HM.mapKeys (+1) @@ -330,10 +336,10 @@ pIntersectionWithKey xs ys = M.intersectionWithKey go (M.fromList xs) `eq_` -- ** Folds pFoldr :: [(Int, Int)] -> Bool -pFoldr = (L.sort . M.foldr (:) []) `eq` (L.sort . HM.foldr (:) []) +pFoldr = (List.sort . M.foldr (:) []) `eq` (List.sort . HM.foldr (:) []) pFoldl :: [(Int, Int)] -> Bool -pFoldl = (L.sort . M.foldl (flip (:)) []) `eq` (L.sort . HM.foldl (flip (:)) []) +pFoldl = (List.sort . M.foldl (flip (:)) []) `eq` (List.sort . HM.foldl (flip (:)) []) pBifoldMap :: [(Int, Int)] -> Bool pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m @@ -376,10 +382,10 @@ pFoldlWithKey' = (sortByKey . M.foldlWithKey' f []) `eq` where f z k v = (k, v) : z pFoldl' :: [(Int, Int)] -> Bool -pFoldl' = (L.sort . M.foldl' (flip (:)) []) `eq` (L.sort . HM.foldl' (flip (:)) []) +pFoldl' = (List.sort . M.foldl' (flip (:)) []) `eq` (List.sort . HM.foldl' (flip (:)) []) pFoldr' :: [(Int, Int)] -> Bool -pFoldr' = (L.sort . M.foldr' (:) []) `eq` (L.sort . HM.foldr' (:) []) +pFoldr' = (List.sort . M.foldr' (:) []) `eq` (List.sort . HM.foldr' (:) []) ------------------------------------------------------------------------ -- ** Filter @@ -432,10 +438,10 @@ pToList :: [(Key, Int)] -> Bool pToList = M.toAscList `eq` toAscList pElems :: [(Key, Int)] -> Bool -pElems = (L.sort . M.elems) `eq` (L.sort . HM.elems) +pElems = (List.sort . M.elems) `eq` (List.sort . HM.elems) pKeys :: [(Key, Int)] -> Bool -pKeys = (L.sort . M.keys) `eq` (L.sort . HM.keys) +pKeys = (List.sort . M.keys) `eq` (List.sort . HM.keys) ------------------------------------------------------------------------ -- * Test list @@ -579,7 +585,7 @@ infix 4 `eq_` -- * Helpers sortByKey :: Ord k => [(k, v)] -> [(k, v)] -sortByKey = L.sortBy (compare `on` fst) +sortByKey = List.sortBy (compare `on` fst) toAscList :: Ord k => HM.HashMap k v -> [(k, v)] -toAscList = L.sortBy (compare `on` fst) . HM.toList +toAscList = List.sortBy (compare `on` fst) . HM.toList diff --git a/tests/Properties/HashSet.hs b/tests/Properties/HashSet.hs index 5564057b..6af5d5fb 100644 --- a/tests/Properties/HashSet.hs +++ b/tests/Properties/HashSet.hs @@ -1,20 +1,22 @@ -{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Tests for the 'Data.HashSet' module. We test functions by -- comparing them to @Set@ from @containers@. module Properties.HashSet (tests) where -import qualified Data.Foldable as Foldable -import Data.Hashable (Hashable(hashWithSalt)) -import qualified Data.List as L -import qualified Data.HashSet as S -import qualified Data.Set as Set -import Data.Ord (comparing) -import Test.QuickCheck (Arbitrary, Property, (==>), (===)) -import Test.Tasty (TestTree, testGroup) +import Data.Hashable (Hashable (hashWithSalt)) +import Data.Ord (comparing) +import Test.QuickCheck (Arbitrary, Property, (===), (==>)) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) +import qualified Data.Foldable as Foldable +import qualified Data.HashSet as S +import qualified Data.List as List +import qualified Data.Set as Set + -- Key type that generates more hash collisions. newtype Key = K { unK :: Int } deriving (Arbitrary, Enum, Eq, Integral, Num, Ord, Read, Show, Real) @@ -77,28 +79,28 @@ pReadShow :: [Key] -> Bool pReadShow xs = Set.fromList xs == read (show (Set.fromList xs)) pFoldable :: [Int] -> Bool -pFoldable = (L.sort . Foldable.foldr (:) []) `eq` - (L.sort . Foldable.foldr (:) []) +pFoldable = (List.sort . Foldable.foldr (:) []) `eq` + (List.sort . Foldable.foldr (:) []) pPermutationEq :: [Key] -> [Int] -> Bool pPermutationEq xs is = S.fromList xs == S.fromList ys where ys = shuffle is xs - shuffle idxs = L.map snd - . L.sortBy (comparing fst) - . L.zip (idxs ++ [L.maximum (0:is) + 1 ..]) + shuffle idxs = List.map snd + . List.sortBy (comparing fst) + . List.zip (idxs ++ [List.maximum (0:is) + 1 ..]) pHashable :: [Key] -> [Int] -> Int -> Property pHashable xs is salt = x == y ==> hashWithSalt salt x === hashWithSalt salt y where - xs' = L.nub xs + xs' = List.nub xs ys = shuffle is xs' x = S.fromList xs' y = S.fromList ys - shuffle idxs = L.map snd - . L.sortBy (comparing fst) - . L.zip (idxs ++ [L.maximum (0:is) + 1 ..]) + shuffle idxs = List.map snd + . List.sortBy (comparing fst) + . List.zip (idxs ++ [List.maximum (0:is) + 1 ..]) ------------------------------------------------------------------------ -- ** Basic interface @@ -132,8 +134,8 @@ pMap = Set.map (+ 1) `eq_` S.map (+ 1) -- ** Folds pFoldr :: [Int] -> Bool -pFoldr = (L.sort . foldrSet (:) []) `eq` - (L.sort . S.foldr (:) []) +pFoldr = (List.sort . foldrSet (:) []) `eq` + (List.sort . S.foldr (:) []) foldrSet :: (a -> b -> b) -> b -> Set.Set a -> b foldrSet = Set.foldr @@ -231,4 +233,4 @@ eq_ f g = (Set.toAscList . f) `eq` (toAscList . g) -- * Helpers toAscList :: Ord a => S.HashSet a -> [a] -toAscList = L.sort . S.toList +toAscList = List.sort . S.toList diff --git a/tests/Properties/List.hs b/tests/Properties/List.hs index 1e3f87ba..b4294783 100644 --- a/tests/Properties/List.hs +++ b/tests/Properties/List.hs @@ -1,12 +1,11 @@ module Properties.List (tests) where import Data.HashMap.Internal.List -import Data.List (nub, sort, sortBy) -import Data.Ord (comparing) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck ((==>), (===), property, Property) +import Data.List (nub, sort, sortBy) +import Data.Ord (comparing) +import Test.QuickCheck (Property, property, (===), (==>)) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) tests :: TestTree tests = testGroup "Data.HashMap.Internal.List" diff --git a/tests/Regressions.hs b/tests/Regressions.hs index 51d72ad9..808a96e3 100644 --- a/tests/Regressions.hs +++ b/tests/Regressions.hs @@ -1,32 +1,33 @@ +{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnboxedTuples #-} module Regressions (tests) where -import Control.Exception (evaluate) -import Control.Monad (replicateM) -import Data.Hashable (Hashable(..)) -import qualified Data.HashMap.Strict as HM -import qualified Data.HashMap.Lazy as HML -import Data.List (delete) -import Data.Maybe -import GHC.Exts (touch#) -import GHC.IO (IO (..)) -import System.Mem (performGC) -import System.Mem.Weak (mkWeakPtr, deRefWeak) -import System.Random (randomIO) -import Test.HUnit (Assertion, assert) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase) -import Test.Tasty.QuickCheck (testProperty) +import Control.Exception (evaluate) +import Control.Monad (replicateM) +import Data.Hashable (Hashable (..)) +import Data.List (delete) +import Data.Maybe (isJust, isNothing) +import GHC.Exts (touch#) +import GHC.IO (IO (..)) +import System.Mem (performGC) +import System.Mem.Weak (deRefWeak, mkWeakPtr) +import System.Random (randomIO) +import Test.HUnit (Assertion, assert) import Test.QuickCheck +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase) +import Test.Tasty.QuickCheck (testProperty) + +import qualified Data.HashMap.Lazy as HML +import qualified Data.HashMap.Strict as HMS issue32 :: Assertion -issue32 = assert $ isJust $ HM.lookup 7 m' +issue32 = assert $ isJust $ HMS.lookup 7 m' where ns = [0..16] :: [Int] - m = HM.fromList (zip ns (repeat [])) - m' = HM.delete 10 m + m = HMS.fromList (zip ns (repeat [])) + m' = HMS.delete 10 m ------------------------------------------------------------------------ -- Issue #39 @@ -36,8 +37,8 @@ issue32 = assert $ isJust $ HM.lookup 7 m' issue39 :: Assertion issue39 = assert $ hm1 == hm2 where - hm1 = HM.fromList ([a, b] `zip` [1, 1 :: Int ..]) - hm2 = HM.fromList ([b, a] `zip` [1, 1 :: Int ..]) + hm1 = HMS.fromList ([a, b] `zip` [1, 1 :: Int ..]) + hm2 = HMS.fromList ([b, a] `zip` [1, 1 :: Int ..]) a = (1, -1) :: (Int, Int) b = (-1, 1) :: (Int, Int) @@ -76,10 +77,10 @@ propEqAfterDelete :: Keys -> Bool propEqAfterDelete (Keys keys) = let keyMap = mapFromKeys keys k = head keys - in HM.delete k keyMap == mapFromKeys (delete k keys) + in HMS.delete k keyMap == mapFromKeys (delete k keys) -mapFromKeys :: [Int] -> HM.HashMap Int () -mapFromKeys keys = HM.fromList (zip keys (repeat ())) +mapFromKeys :: [Int] -> HMS.HashMap Int () +mapFromKeys keys = HMS.fromList (zip keys (repeat ())) ------------------------------------------------------------------------ -- Issue #254 @@ -117,7 +118,7 @@ issue254Strict = do i :: Int <- randomIO let oldV = show i weakV <- mkWeakPtr oldV Nothing - mp <- evaluate $ HM.insert (KC 1) "3" $ HM.fromList [(KC 0, "1"), (KC 1, oldV)] + mp <- evaluate $ HMS.insert (KC 1) "3" $ HMS.fromList [(KC 0, "1"), (KC 1, oldV)] performGC res <- deRefWeak weakV touch mp diff --git a/tests/Strictness.hs b/tests/Strictness.hs index f80e1bb6..255851e9 100644 --- a/tests/Strictness.hs +++ b/tests/Strictness.hs @@ -1,21 +1,24 @@ -{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Strictness (tests) where -import Data.Hashable (Hashable(hashWithSalt)) +import Control.Arrow (second) +import Control.Monad (guard) +import Data.Foldable (foldl') +import Data.HashMap.Strict (HashMap) +import Data.Hashable (Hashable (hashWithSalt)) +import Data.Maybe (fromMaybe, isJust) import Test.ChasingBottoms.IsBottom -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck (Arbitrary(arbitrary), Property, (===), (.&&.)) +import Test.QuickCheck (Arbitrary (arbitrary), Property, (.&&.), + (===)) import Test.QuickCheck.Function -import Test.QuickCheck.Poly (A) -import Data.Maybe (fromMaybe, isJust) -import Control.Arrow (second) -import Control.Monad (guard) -import Data.Foldable (foldl') +import Test.QuickCheck.Poly (A) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) -import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM -- Key type that generates more hash collisions. diff --git a/utils/Stats.hs b/utils/Stats.hs index c0150c82..7278ecc3 100644 --- a/utils/Stats.hs +++ b/utils/Stats.hs @@ -1,13 +1,14 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -funbox-strict-fields #-} module Stats where -import qualified Data.HashMap.Internal.Array as A -import Data.HashMap.Internal (HashMap(..)) -import qualified Data.HashMap.Internal as HM +import Data.HashMap.Internal (HashMap (..)) import Data.Semigroup +import qualified Data.HashMap.Internal as HM +import qualified Data.HashMap.Internal.Array as A + data Histogram = H { empty :: !Int , leaf :: !Int