Merge pull request #164 from ethercrow/smallarray

Use SmallArray#

Author: treeowl

.travis.yml

@@ -13,12 +13,6 @@ before_cache:
 
 matrix:
   include:
-    - env: CABALVER=1.24 GHCVER=7.4.2
-      compiler: ": #GHC 7.4.2"
-      addons: {apt: {packages: [cabal-install-1.24,ghc-7.4.2], sources: [hvr-ghc]}}
-    - env: CABALVER=1.24 GHCVER=7.6.3
-      compiler: ": #GHC 7.6.3"
-      addons: {apt: {packages: [cabal-install-1.24,ghc-7.6.3], sources: [hvr-ghc]}}
     - env: CABALVER=1.24 GHCVER=7.8.4
       compiler: ": #GHC 7.8.4"
       addons: {apt: {packages: [cabal-install-1.24,ghc-7.8.4], sources: [hvr-ghc]}}

Data/HashMap/Array.hs

@@ -53,12 +53,7 @@ import qualified Data.Traversable as Traversable
 import Control.Applicative (Applicative)
 #endif
 import Control.DeepSeq
--- GHC 7.7 exports toList/fromList from GHC.Exts
--- In order to avoid warnings on previous GHC versions, we provide
--- an explicit import list instead of only hiding the offending symbols
-import GHC.Exts (Array#, Int(..), newArray#, readArray#, writeArray#,
-                 indexArray#, unsafeFreezeArray#, unsafeThawArray#,
-                 MutableArray#)
+import GHC.Exts(Int(..))
 import GHC.ST (ST(..))
 
 #if __GLASGOW_HASKELL__ >= 709
@@ -67,9 +62,17 @@ import Prelude hiding (filter, foldr, length, map, read, traverse)
 import Prelude hiding (filter, foldr, length, map, read)
 #endif
 
-#if __GLASGOW_HASKELL__ >= 702
-import GHC.Exts (sizeofArray#, copyArray#, thawArray#, sizeofMutableArray#,
-                 copyMutableArray#)
+#if __GLASGOW_HASKELL__ >= 710
+import GHC.Exts (SmallArray#, newSmallArray#, readSmallArray#, writeSmallArray#,
+                 indexSmallArray#, unsafeFreezeSmallArray#, unsafeThawSmallArray#,
+                 SmallMutableArray#, sizeofSmallArray#, copySmallArray#, thawSmallArray#,
+                 sizeofSmallMutableArray#, copySmallMutableArray#)
+
+#else
+import GHC.Exts (Array#, newArray#, readArray#, writeArray#,
+                 indexArray#, unsafeFreezeArray#, unsafeThawArray#,
+                 MutableArray#, sizeofArray#, copyArray#, thawArray#,
+                 sizeofMutableArray#, copyMutableArray#)
 #endif
 
 #if defined(ASSERTS)
@@ -78,6 +81,24 @@ import qualified Prelude
 
 import Data.HashMap.Unsafe (runST)
 
+
+#if __GLASGOW_HASKELL__ >= 710
+type Array# a = SmallArray# a
+type MutableArray# a = SmallMutableArray# a
+
+newArray# = newSmallArray#
+readArray# = readSmallArray#
+writeArray# = writeSmallArray#
+indexArray# = indexSmallArray#
+unsafeFreezeArray# = unsafeFreezeSmallArray#
+unsafeThawArray# = unsafeThawSmallArray#
+sizeofArray# = sizeofSmallArray#
+copyArray# = copySmallArray#
+thawArray# = thawSmallArray#
+sizeofMutableArray# = sizeofSmallMutableArray#
+copyMutableArray# = copySmallMutableArray#
+#endif
+
 ------------------------------------------------------------------------
 
 #if defined(ASSERTS)
@@ -100,49 +121,31 @@ if not ((_lhs_) _op_ (_rhs_)) then error ("Data.HashMap.Array." ++ (_func_) ++ "
 
 data Array a = Array {
       unArray :: !(Array# a)
-#if __GLASGOW_HASKELL__ < 702
-    , length :: !Int
-#endif
     }
 
 instance Show a => Show (Array a) where
     show = show . toList
 
-#if __GLASGOW_HASKELL__ >= 702
 length :: Array a -> Int
 length ary = I# (sizeofArray# (unArray ary))
 {-# INLINE length #-}
-#endif
 
 -- | Smart constructor
 array :: Array# a -> Int -> Array a
-#if __GLASGOW_HASKELL__ >= 702
 array ary _n = Array ary
-#else
-array = Array
-#endif
 {-# INLINE array #-}
 
 data MArray s a = MArray {
       unMArray :: !(MutableArray# s a)
-#if __GLASGOW_HASKELL__ < 702
-    , lengthM :: !Int
-#endif
     }
 
-#if __GLASGOW_HASKELL__ >= 702
 lengthM :: MArray s a -> Int
 lengthM mary = I# (sizeofMutableArray# (unMArray mary))
 {-# INLINE lengthM #-}
-#endif
 
 -- | Smart constructor
 marray :: MutableArray# s a -> Int -> MArray s a
-#if __GLASGOW_HASKELL__ >= 702
 marray mary _n = MArray mary
-#else
-marray = MArray
-#endif
 {-# INLINE marray #-}
 
 ------------------------------------------------------------------------
@@ -237,47 +240,21 @@ run2 k = runST (do
 
 -- | Unsafely copy the elements of an array. Array bounds are not checked.
 copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
-#if __GLASGOW_HASKELL__ >= 702
 copy !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
     CHECK_LE("copy", _sidx + _n, length src)
     CHECK_LE("copy", _didx + _n, lengthM dst)
         ST $ \ s# ->
         case copyArray# (unArray src) sidx# (unMArray dst) didx# n# s# of
             s2 -> (# s2, () #)
-#else
-copy !src !sidx !dst !didx n =
-    CHECK_LE("copy", sidx + n, length src)
-    CHECK_LE("copy", didx + n, lengthM dst)
-        copy_loop sidx didx 0
-  where
-    copy_loop !i !j !c
-        | c >= n = return ()
-        | otherwise = do b <- indexM src i
-                         write dst j b
-                         copy_loop (i+1) (j+1) (c+1)
-#endif
 
 -- | Unsafely copy the elements of an array. Array bounds are not checked.
 copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
-#if __GLASGOW_HASKELL__ >= 702
 copyM !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
     CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)
     CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)
     ST $ \ s# ->
     case copyMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of
         s2 -> (# s2, () #)
-#else
-copyM !src !sidx !dst !didx n =
-    CHECK_BOUNDS("copyM: src", lengthM src, sidx + n - 1)
-    CHECK_BOUNDS("copyM: dst", lengthM dst, didx + n - 1)
-    copy_loop sidx didx 0
-  where
-    copy_loop !i !j !c
-        | c >= n = return ()
-        | otherwise = do b <- read src i
-                         write dst j b
-                         copy_loop (i+1) (j+1) (c+1)
-#endif
 
 -- | /O(n)/ Insert an element at the given position in this array,
 -- increasing its size by one.
@@ -352,18 +329,10 @@ undefinedElem = error "Data.HashMap.Array: Undefined element"
 {-# NOINLINE undefinedElem #-}
 
 thaw :: Array e -> Int -> Int -> ST s (MArray s e)
-#if __GLASGOW_HASKELL__ >= 702
 thaw !ary !_o@(I# o#) !n@(I# n#) =
     CHECK_LE("thaw", _o + n, length ary)
         ST $ \ s -> case thawArray# (unArray ary) o# n# s of
             (# s2, mary# #) -> (# s2, marray mary# n #)
-#else
-thaw !ary !o !n =
-    CHECK_LE("thaw", o + n, length ary)
-        do mary <- new_ n
-           copy ary o mary 0 n
-           return mary
-#endif
 {-# INLINE thaw #-}
 
 -- | /O(n)/ Delete an element at the given position in this array,

Data/HashMap/Base.hs

@@ -1,10 +1,8 @@
 {-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE PatternGuards #-}
-#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeFamilies #-}
-#endif
 {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
 
 module Data.HashMap.Base
@@ -104,7 +102,7 @@ import Data.Semigroup (Semigroup((<>)))
 #endif
 import Control.DeepSeq (NFData(rnf))
 import Control.Monad.ST (ST)
-import Data.Bits ((.&.), (.|.), complement)
+import Data.Bits ((.&.), (.|.), complement, popCount)
 import Data.Data hiding (Typeable)
 import qualified Data.Foldable as Foldable
 import qualified Data.List as L
@@ -115,18 +113,13 @@ import Text.Read hiding (step)
 import qualified Data.HashMap.Array as A
 import qualified Data.Hashable as H
 import Data.Hashable (Hashable)
-import Data.HashMap.PopCount (popCount)
 import Data.HashMap.Unsafe (runST)
 import Data.HashMap.UnsafeShift (unsafeShiftL, unsafeShiftR)
 import Data.HashMap.List (isPermutationBy, unorderedCompare)
 import Data.Typeable (Typeable)
 
-#if __GLASGOW_HASKELL__ >= 707
 import GHC.Exts (isTrue#)
-#endif
-#if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as Exts
-#endif
 
 #if MIN_VERSION_base(4,9,0)
 import Data.Functor.Classes
@@ -162,9 +155,7 @@ data HashMap k v
     | Collision !Hash !(A.Array (Leaf k v))
       deriving (Typeable)
 
-#if __GLASGOW_HASKELL__ >= 708
 type role HashMap nominal representational
-#endif
 
 instance (NFData k, NFData v) => NFData (HashMap k v) where
     rnf Empty                 = ()
@@ -1319,28 +1310,7 @@ update16With' ary idx f = update16 ary idx $! f (A.index ary idx)
 -- array is not checked.
 clone16 :: A.Array e -> ST s (A.MArray s e)
 clone16 ary =
-#if __GLASGOW_HASKELL__ >= 702
     A.thaw ary 0 16
-#else
-    do mary <- A.new_ 16
-       A.indexM ary 0 >>= A.write mary 0
-       A.indexM ary 1 >>= A.write mary 1
-       A.indexM ary 2 >>= A.write mary 2
-       A.indexM ary 3 >>= A.write mary 3
-       A.indexM ary 4 >>= A.write mary 4
-       A.indexM ary 5 >>= A.write mary 5
-       A.indexM ary 6 >>= A.write mary 6
-       A.indexM ary 7 >>= A.write mary 7
-       A.indexM ary 8 >>= A.write mary 8
-       A.indexM ary 9 >>= A.write mary 9
-       A.indexM ary 10 >>= A.write mary 10
-       A.indexM ary 11 >>= A.write mary 11
-       A.indexM ary 12 >>= A.write mary 12
-       A.indexM ary 13 >>= A.write mary 13
-       A.indexM ary 14 >>= A.write mary 14
-       A.indexM ary 15 >>= A.write mary 15
-       return mary
-#endif
 
 ------------------------------------------------------------------------
 -- Bit twiddling
@@ -1375,18 +1345,12 @@ 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
-#if __GLASGOW_HASKELL__ < 707
-ptrEq x y = reallyUnsafePtrEquality# x y ==# 1#
-#else
 ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y ==# 1#)
-#endif
 {-# INLINE ptrEq #-}
 
-#if __GLASGOW_HASKELL__ >= 708
 ------------------------------------------------------------------------
 -- IsList instance
 instance (Eq k, Hashable k) => Exts.IsList (HashMap k v) where
     type Item (HashMap k v) = (k, v)
     fromList = fromList
     toList   = toList
-#endif

Data/HashMap/Lazy.hs

@@ -1,8 +1,5 @@
 {-# LANGUAGE CPP #-}
-
-#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
-#endif
 
 ------------------------------------------------------------------------
 -- |

Data/HashMap/PopCount.hs

@@ -1,8 +1,5 @@
 {-# LANGUAGE BangPatterns, CPP, PatternGuards #-}
-
-#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
-#endif
 
 ------------------------------------------------------------------------
 -- |

Data/HashMap/Strict.hs

@@ -20,7 +20,7 @@ category:       Data
 build-type:     Simple
 cabal-version:  >=1.8
 extra-source-files: CHANGES.md
-tested-with:    GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2
+tested-with:    GHC==8.0.1, GHC==7.10.3, GHC==7.8.4
 
 flag debug
   description:  Enable debug support
@@ -35,7 +35,6 @@ library
     Data.HashMap.Array
     Data.HashMap.Base
     Data.HashMap.List
-    Data.HashMap.PopCount
     Data.HashMap.Unsafe
     Data.HashMap.UnsafeShift
 
@@ -44,17 +43,11 @@ library
     deepseq >= 1.1,
     hashable >= 1.0.1.1 && < 1.3
 
-  if impl(ghc < 7.4)
-    c-sources: cbits/popc.c
-
-  ghc-options: -Wall -O2
-  if impl(ghc >= 6.8)
-    ghc-options: -fwarn-tabs
-  if impl(ghc >= 6.12)
-    -- This is absolutely essential for correctness due to the
-    -- referential-transparency-breaking mutability in unsafeInsertWith. See
-    -- #147 and GHC #13615 for details.
-    ghc-options: -feager-blackholing
+  ghc-options: -Wall -O2 -fwarn-tabs -ferror-spans
+  -- This is absolutely essential for correctness due to the
+  -- referential-transparency-breaking mutability in unsafeInsertWith. See
+  -- #147 and GHC #13615 for details.
+  ghc-options: -feager-blackholing
   if flag(debug)
     cpp-options: -DASSERTS
 
@@ -174,7 +167,6 @@ benchmark benchmarks
     Data.HashMap.Array
     Data.HashMap.Base
     Data.HashMap.Lazy
-    Data.HashMap.PopCount
     Data.HashMap.Strict
     Data.HashMap.Unsafe
     Data.HashMap.UnsafeShift
@@ -195,14 +187,7 @@ benchmark benchmarks
     mtl,
     random
 
-  if impl(ghc < 7.4)
-    c-sources: cbits/popc.c
-
-  ghc-options: -Wall -O2 -rtsopts
-  if impl(ghc >= 6.8)
-    ghc-options: -fwarn-tabs
-  if impl(ghc > 6.10)
-    ghc-options: -fregs-graph
+  ghc-options: -Wall -O2 -rtsopts -fwarn-tabs -ferror-spans
   if flag(debug)
     cpp-options: -DASSERTS