Make alterF fast

* Perform a worker-wrapper transformation to make lookups (both
  for `alterF` and `lookup`) faster.

* Use rewrite rules to make `alterF` fast when it's used
  (probably via `Control.Lens.At`) to insert or delete, ignoring
  the existing element at the key in question.

* Also catch `alterF` uses that translate very directly to
  `adjust`, and ones very similar to `insertWith`.

* Avoid code duplication by reusing `RULES` helper functions to
  write shorter versions of lazy `adjust` and `insertWith`.

* Use a rewrite rule to improve code very slightly when using
  with `Const` to look things up.

Benchmark results (`alter` vs. `alterF`):

benchmarking HashMap/alterInsert/String
time                 1.854 ms   (1.817 ms .. 1.903 ms)
                     0.996 R²   (0.995 R² .. 0.998 R²)
mean                 1.787 ms   (1.755 ms .. 1.815 ms)
std dev              95.80 μs   (82.16 μs .. 115.6 μs)
variance introduced by outliers: 37% (moderately inflated)

benchmarking HashMap/alterInsert/ByteString
time                 2.052 ms   (2.035 ms .. 2.070 ms)
                     0.999 R²   (0.998 R² .. 0.999 R²)
mean                 1.844 ms   (1.813 ms .. 1.876 ms)
std dev              96.86 μs   (86.53 μs .. 110.2 μs)
variance introduced by outliers: 37% (moderately inflated)

benchmarking HashMap/alterInsert/Int
time                 1.375 ms   (1.333 ms .. 1.413 ms)
                     0.996 R²   (0.995 R² .. 0.998 R²)
mean                 1.235 ms   (1.201 ms .. 1.262 ms)
std dev              95.00 μs   (70.42 μs .. 119.3 μs)
variance introduced by outliers: 58% (severely inflated)

benchmarking HashMap/alterFInsert/String
time                 1.881 ms   (1.838 ms .. 1.914 ms)
                     0.996 R²   (0.993 R² .. 0.998 R²)
mean                 1.656 ms   (1.606 ms .. 1.703 ms)
std dev              150.0 μs   (122.6 μs .. 179.6 μs)
variance introduced by outliers: 63% (severely inflated)

benchmarking HashMap/alterFInsert/ByteString
time                 2.055 ms   (2.033 ms .. 2.074 ms)
                     0.999 R²   (0.998 R² .. 0.999 R²)
mean                 1.854 ms   (1.823 ms .. 1.883 ms)
std dev              93.32 μs   (82.41 μs .. 106.0 μs)
variance introduced by outliers: 35% (moderately inflated)

benchmarking HashMap/alterFInsert/Int
time                 1.314 ms   (1.283 ms .. 1.344 ms)
                     0.997 R²   (0.996 R² .. 0.999 R²)
mean                 1.204 ms   (1.174 ms .. 1.225 ms)
std dev              78.11 μs   (54.60 μs .. 105.8 μs)
variance introduced by outliers: 50% (severely inflated)

benchmarking HashMap/alterInsert-dup/String
time                 953.5 μs   (934.7 μs .. 965.3 μs)
                     0.998 R²   (0.995 R² .. 0.999 R²)
mean                 867.6 μs   (851.1 μs .. 883.1 μs)
std dev              47.95 μs   (40.02 μs .. 56.33 μs)
variance introduced by outliers: 44% (moderately inflated)

benchmarking HashMap/alterInsert-dup/ByteString
time                 454.8 μs   (451.9 μs .. 459.6 μs)
                     0.998 R²   (0.996 R² .. 1.000 R²)
mean                 420.0 μs   (412.1 μs .. 429.1 μs)
std dev              25.71 μs   (20.02 μs .. 33.09 μs)
variance introduced by outliers: 53% (severely inflated)

benchmarking HashMap/alterInsert-dup/Int
time                 594.6 μs   (583.5 μs .. 610.7 μs)
                     0.998 R²   (0.996 R² .. 1.000 R²)
mean                 536.0 μs   (525.8 μs .. 546.6 μs)
std dev              31.76 μs   (25.63 μs .. 45.36 μs)
variance introduced by outliers: 50% (severely inflated)

benchmarking HashMap/alterFInsert-dup/String
time                 851.4 μs   (830.1 μs .. 866.5 μs)
                     0.983 R²   (0.951 R² .. 0.998 R²)
mean                 893.7 μs   (826.2 μs .. 1.140 ms)
std dev              322.0 μs   (110.9 μs .. 673.2 μs)
variance introduced by outliers: 98% (severely inflated)

benchmarking HashMap/alterFInsert-dup/ByteString
time                 431.3 μs   (422.3 μs .. 446.5 μs)
                     0.962 R²   (0.917 R² .. 0.996 R²)
mean                 426.5 μs   (399.8 μs .. 483.1 μs)
std dev              110.2 μs   (54.69 μs .. 171.4 μs)
variance introduced by outliers: 96% (severely inflated)

benchmarking HashMap/alterFInsert-dup/Int
time                 531.4 μs   (509.4 μs .. 564.9 μs)
                     0.947 R²   (0.859 R² .. 0.999 R²)
mean                 495.5 μs   (472.9 μs .. 574.8 μs)
std dev              114.6 μs   (33.32 μs .. 227.2 μs)
variance introduced by outliers: 95% (severely inflated)

benchmarking HashMap/alterDelete/String
time                 1.816 ms   (1.789 ms .. 1.842 ms)
                     0.996 R²   (0.992 R² .. 0.999 R²)
mean                 1.726 ms   (1.689 ms .. 1.786 ms)
std dev              149.1 μs   (108.8 μs .. 199.3 μs)
variance introduced by outliers: 61% (severely inflated)

benchmarking HashMap/alterDelete/ByteString
time                 1.056 ms   (1.049 ms .. 1.063 ms)
                     0.998 R²   (0.994 R² .. 1.000 R²)
mean                 982.4 μs   (965.3 μs .. 1.019 ms)
std dev              67.67 μs   (39.45 μs .. 118.8 μs)
variance introduced by outliers: 54% (severely inflated)

benchmarking HashMap/alterDelete/Int
time                 770.4 μs   (764.0 μs .. 776.6 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 708.1 μs   (696.3 μs .. 717.9 μs)
std dev              30.60 μs   (25.88 μs .. 37.36 μs)
variance introduced by outliers: 32% (moderately inflated)

benchmarking HashMap/alterFDelete/String
time                 1.784 ms   (1.777 ms .. 1.792 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 1.648 ms   (1.624 ms .. 1.671 ms)
std dev              71.23 μs   (59.30 μs .. 88.08 μs)
variance introduced by outliers: 29% (moderately inflated)

benchmarking HashMap/alterFDelete/ByteString
time                 1.023 ms   (1.019 ms .. 1.030 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 939.9 μs   (926.2 μs .. 952.0 μs)
std dev              42.31 μs   (35.06 μs .. 51.34 μs)
variance introduced by outliers: 33% (moderately inflated)

benchmarking HashMap/alterFDelete/Int
time                 768.1 μs   (764.5 μs .. 773.5 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 707.9 μs   (697.7 μs .. 716.9 μs)
std dev              30.63 μs   (25.34 μs .. 37.08 μs)
variance introduced by outliers: 32% (moderately inflated)

benchmarking HashMap/alterDelete-miss/String
time                 405.8 μs   (369.0 μs .. 435.0 μs)
                     0.978 R²   (0.974 R² .. 1.000 R²)
mean                 348.9 μs   (338.7 μs .. 365.7 μs)
std dev              38.88 μs   (24.11 μs .. 56.02 μs)
variance introduced by outliers: 80% (severely inflated)

benchmarking HashMap/alterDelete-miss/ByteString
time                 261.1 μs   (260.2 μs .. 262.1 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 239.1 μs   (235.3 μs .. 242.4 μs)
std dev              10.39 μs   (8.635 μs .. 12.65 μs)
variance introduced by outliers: 39% (moderately inflated)

benchmarking HashMap/alterDelete-miss/Int
time                 422.4 μs   (418.1 μs .. 434.1 μs)
                     0.961 R²   (0.880 R² .. 1.000 R²)
mean                 409.7 μs   (388.2 μs .. 500.2 μs)
std dev              107.0 μs   (21.27 μs .. 235.0 μs)
variance introduced by outliers: 96% (severely inflated)

benchmarking HashMap/alterFDelete-miss/String
time                 334.1 μs   (327.1 μs .. 349.7 μs)
                     0.991 R²   (0.975 R² .. 1.000 R²)
mean                 306.1 μs   (300.4 μs .. 319.4 μs)
std dev              24.28 μs   (10.72 μs .. 49.18 μs)
variance introduced by outliers: 68% (severely inflated)

benchmarking HashMap/alterFDelete-miss/ByteString
time                 250.9 μs   (238.1 μs .. 265.7 μs)
                     0.988 R²   (0.983 R² .. 1.000 R²)
mean                 222.0 μs   (216.8 μs .. 231.6 μs)
std dev              19.08 μs   (9.775 μs .. 30.63 μs)
variance introduced by outliers: 72% (severely inflated)

benchmarking HashMap/alterFDelete-miss/Int
time                 420.3 μs   (406.2 μs .. 441.9 μs)
                     0.989 R²   (0.985 R² .. 0.995 R²)
mean                 414.8 μs   (404.8 μs .. 444.1 μs)
std dev              49.20 μs   (20.07 μs .. 96.97 μs)
variance introduced by outliers: 82% (severely inflated)

Author: treeowl

Data/HashMap/Array.hs

@@ -31,6 +31,7 @@ module Data.HashMap.Array
 
     , unsafeFreeze
     , unsafeThaw
+    , unsafeSameArray
     , run
     , run2
     , copy
@@ -53,7 +54,7 @@ import qualified Data.Traversable as Traversable
 import Control.Applicative (Applicative)
 #endif
 import Control.DeepSeq
-import GHC.Exts(Int(..))
+import GHC.Exts(Int(..), Int#, reallyUnsafePtrEquality#, tagToEnum#, unsafeCoerce#, State#)
 import GHC.ST (ST(..))
 
 #if __GLASGOW_HASKELL__ >= 709
@@ -86,16 +87,57 @@ import Data.HashMap.Unsafe (runST)
 type Array# a = SmallArray# a
 type MutableArray# a = SmallMutableArray# a
 
+newArray# :: Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
 newArray# = newSmallArray#
+
+unsafeFreezeArray# :: SmallMutableArray# d a
+                   -> State# d -> (# State# d, SmallArray# a #)
+unsafeFreezeArray# = unsafeFreezeSmallArray#
+
+readArray# :: SmallMutableArray# d a
+           -> Int# -> State# d -> (# State# d, a #)
 readArray# = readSmallArray#
+
+writeArray# :: SmallMutableArray# d a
+            -> Int# -> a -> State# d -> State# d
 writeArray# = writeSmallArray#
+
+indexArray# :: SmallArray# a -> Int# -> (# a #)
 indexArray# = indexSmallArray#
-unsafeFreezeArray# = unsafeFreezeSmallArray#
+
+unsafeThawArray# :: SmallArray# a
+                 -> State# d -> (# State# d, SmallMutableArray# d a #)
 unsafeThawArray# = unsafeThawSmallArray#
+
+sizeofArray# :: SmallArray# a -> Int#
 sizeofArray# = sizeofSmallArray#
+
+copyArray# :: SmallArray# a
+           -> Int#
+           -> SmallMutableArray# d a
+           -> Int#
+           -> Int#
+           -> State# d
+           -> State# d
 copyArray# = copySmallArray#
+
+thawArray# :: SmallArray# a
+           -> Int#
+           -> Int#
+           -> State# d
+           -> (# State# d, SmallMutableArray# d a #)
 thawArray# = thawSmallArray#
+
+sizeofMutableArray# :: SmallMutableArray# s a -> Int#
 sizeofMutableArray# = sizeofSmallMutableArray#
+
+copyMutableArray# :: SmallMutableArray# d a
+                  -> Int#
+                  -> SmallMutableArray# d a
+                  -> Int#
+                  -> Int#
+                  -> State# d
+                  -> State# d
 copyMutableArray# = copySmallMutableArray#
 #endif
 
@@ -126,6 +168,13 @@ data Array a = Array {
 instance Show a => Show (Array a) where
     show = show . toList
 
+-- Determines whether two arrays have the same memory address.
+-- This is more reliable than testing pointer equality on the
+-- Array wrappers, but it's still somewhat bogus.
+unsafeSameArray :: Array a -> Array b -> Bool
+unsafeSameArray (Array xs) (Array ys) =
+  tagToEnum# (unsafeCoerce# reallyUnsafePtrEquality# xs ys)
+
 length :: Array a -> Int
 length ary = I# (sizeofArray# (unArray ary))
 {-# INLINE length #-}