hashtables 1.1.2.1 → 1.2.0.0
raw patch · 24 files changed
+1926/−1595 lines, 24 filesdep ~base
Dependency ranges changed: base
Files
- LICENSE +1/−1
- benchmark/hashtable-benchmark.cabal +5/−5
- benchmark/src/Criterion/Collection/Sample.hs +10/−10
- cbits/Makefile +14/−0
- cbits/cfuncs.c +0/−517
- cbits/check.c +185/−0
- cbits/common.c +83/−0
- cbits/default.c +202/−0
- cbits/defs.h +35/−0
- cbits/sse-42-check.c +38/−0
- cbits/sse-42.c +172/−0
- hashtables.cabal +29/−22
- src/Data/HashTable/IO.hs +3/−2
- src/Data/HashTable/Internal/CacheLine.hs +806/−844
- src/Data/HashTable/Internal/IntArray.hs +54/−13
- src/Data/HashTable/Internal/Linear/Bucket.hs +3/−0
- src/Data/HashTable/Internal/UnsafeTricks.hs +10/−2
- src/Data/HashTable/Internal/Utils.hs +13/−16
- src/Data/HashTable/ST/Basic.hs +114/−67
- src/Data/HashTable/ST/Cuckoo.hs +90/−66
- src/Data/HashTable/ST/Linear.hs +7/−7
- test/hashtables-test.cabal +26/−18
- test/runTestsAndCoverage.sh +1/−1
- test/suite/Data/HashTable/Test/Common.hs +25/−4
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2011-2012, Google, Inc.+Copyright (c) 2011-2013, Google, Inc. All rights reserved.
benchmark/hashtable-benchmark.cabal view
@@ -15,20 +15,20 @@ Executable hashtable-benchmark main-is: Main.hs- hs-source-dirs: src ../src+ hs-source-dirs: src build-depends: base >= 4 && <5, base16-bytestring == 0.1.*, bytestring >= 0.9 && <0.11, containers >= 0.4 && <0.6,- criterion >= 0.5 && <0.7,+ criterion >= 0.8 && <0.9, csv == 0.1.*, deepseq >= 1.1 && <1.4, filepath == 1.*,- hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3,- hashtables >= 1.0 && <1.3,+ hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3,+ hashtables >= 1.2 && <1.3, mtl == 2.*,- mwc-random >= 0.8 && <0.13,+ mwc-random >= 0.8 && <0.14, primitive, statistics >= 0.8 && <0.11, threads >= 0.4 && <0.6,
benchmark/src/Criterion/Collection/Sample.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RankNTypes #-} module Criterion.Collection.Sample ( Benchmark(..)@@ -16,23 +16,23 @@ import Control.DeepSeq import Control.Monad import Control.Monad.Trans-import Criterion hiding (Benchmark)+import Criterion hiding (Benchmark)+import Criterion.Collection.Internal.Types import Criterion.Config import Criterion.Environment-import Criterion.IO+import Criterion.IO.Printf import Criterion.Measurement import Criterion.Monad-import Criterion.Collection.Internal.Types import Data.IORef-import Data.List (foldl')+import Data.List (foldl') import Data.Monoid-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import Statistics.Quantile (continuousBy, cadpw)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import Statistics.Quantile (cadpw, continuousBy) import Statistics.Sample-import System.Mem (performGC)+import System.Mem (performGC) import System.Random.MWC-import Text.Printf (printf)+import Text.Printf (printf) ------------------------------------------------------------------------------ data MeasurementMode = PerBatch | PerOperation
+ cbits/Makefile view
@@ -0,0 +1,14 @@+check: default.c common.c check.c sse-42.c+ @echo "Testing portable version..."+ @gcc -o check -O3 default.c common.c check.c+ @./check+ @rm check++ @echo+ @echo "Testing SSE 4.2 version..."+ @gcc -o check -O3 -msse4.2 sse-42.c common.c check.c sse-42-check.c+ @./check+ @rm check++clean:+ rm -f *.o check
− cbits/cfuncs.c
@@ -1,517 +0,0 @@-#include <signal.h>-#include <stdint.h>-#include <stdio.h>-#ifdef WIN32-#include <windows.h>-#else-#include <unistd.h>-#endif--#if defined(USE_SSE_4_1)-#include <smmintrin.h>-#endif--#if defined(__GNUC__)-#define PREFETCH_READ(x) (__builtin_prefetch(x, 0, 3))-#define PREFETCH_WRITE(x) (__builtin_prefetch(x, 1, 3))-#else-#define PREFETCH_READ(x)-#define PREFETCH_WRITE(x)-#endif--void prefetchCacheLine32_write(uint32_t* line, int start)-{- PREFETCH_WRITE((void*)(&line[start]));-}---void prefetchCacheLine64_write(uint64_t* line, int start)-{- PREFETCH_WRITE((void*)(&line[start]));-}---void prefetchCacheLine32_read(uint32_t* line, int start)-{- PREFETCH_READ((void*)(&line[start]));-}---void prefetchCacheLine64_read(uint64_t* line, int start)-{- PREFETCH_READ((void*)(&line[start]));-}---int forwardSearch32_2(uint32_t* array, int start, int end,- uint32_t x1, uint32_t x2) {- uint32_t* ep = array + end;- uint32_t* p = array + start;- int wrapped = 0;- while (1) {- if (p == ep) {- if (wrapped) return -1;- ep = array + start;- p = array;- wrapped = 1;- }- if (*p == x1 || *p == x2) return p - array;- ++p;- }-}---int forwardSearch32_3(uint32_t* array, int start, int end,- uint32_t x1, uint32_t x2, uint32_t x3) {- uint32_t* ep = array + end;- uint32_t* p = array + start;- int wrapped = 0;- while (1) {- if (p == ep) {- if (wrapped) return -1;- ep = array + start;- p = array;- wrapped = 1;- }- if (*p == x1 || *p == x2 || *p == x3) return p - array;- ++p;- }-}---int forwardSearch64_2(uint64_t* array, int start, int end,- uint64_t x1, uint64_t x2) {- uint64_t* ep = array + end;- uint64_t* p = array + start;- int wrapped = 0;- while (1) {- if (p == ep) {- if (wrapped) return -1;- ep = array + start;- p = array;- wrapped = 1;- }- if (*p == x1 || *p == x2) return p - array;- ++p;- }-}---int forwardSearch64_3(uint64_t* array, int start, int end,- uint64_t x1, uint64_t x2, uint64_t x3) {- uint64_t* ep = array + end;- uint64_t* p = array + start;- int wrapped = 0;- while (1) {- if (p == ep) {- if (wrapped) return -1;- ep = array + start;- p = array;- wrapped = 1;- }- if (*p == x1 || *p == x2 || *p == x3) return p - array;- ++p;- }-}---//-----------------------------------------------------------------------------// cache line search functions-// First: 32 bit--inline int mask(int a, int b) { return -(a == b); }---uint8_t deBruijnBitPositions[] = {- 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,- 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9-};---int firstBitSet(int a) {- int zeroCase = mask(0, a);- uint32_t x = (uint32_t) (a & -a);- x *= 0x077CB531;- x >>= 27;- return zeroCase | deBruijnBitPositions[x];-}---int32_t lineResult32(int m, int start) {- int p = firstBitSet(m);- int32_t mm = mask(p, -1);- return mm | (~mm & (start + p));-}---uint32_t lineMask32(uint32_t* array, int start, uint32_t value) {- uint32_t* p = array + start;- uint32_t m = 0;- int offset = start & 0xf;-- switch (offset) {- case 0: m |= mask(*p++, value) & 0x1;- case 1: m |= mask(*p++, value) & 0x2;- case 2: m |= mask(*p++, value) & 0x4;- case 3: m |= mask(*p++, value) & 0x8;- case 4: m |= mask(*p++, value) & 0x10;- case 5: m |= mask(*p++, value) & 0x20;- case 6: m |= mask(*p++, value) & 0x40;- case 7: m |= mask(*p++, value) & 0x80;- case 8: m |= mask(*p++, value) & 0x100;- case 9: m |= mask(*p++, value) & 0x200;- case 10: m |= mask(*p++, value) & 0x400;- case 11: m |= mask(*p++, value) & 0x800;- case 12: m |= mask(*p++, value) & 0x1000;- case 13: m |= mask(*p++, value) & 0x2000;- case 14: m |= mask(*p++, value) & 0x4000;- case 15: m |= mask(*p++, value) & 0x8000;- }-- return m >> offset;-}---int lineSearch32(uint32_t* array, int start, uint32_t value) {- uint32_t m = lineMask32(array, start, value);- return lineResult32((int)m, start);-}---uint32_t lineMask32_2(uint32_t* array, int start, uint32_t x1, uint32_t x2) {- uint32_t* p = array + start;- uint32_t m = 0;- int offset = start & 0xf;-- switch (offset) {- case 0: m |= (mask(*p, x1) | mask(*p, x2)) & 0x1; ++p;- case 1: m |= (mask(*p, x1) | mask(*p, x2)) & 0x2; ++p;- case 2: m |= (mask(*p, x1) | mask(*p, x2)) & 0x4; ++p;- case 3: m |= (mask(*p, x1) | mask(*p, x2)) & 0x8; ++p;- case 4: m |= (mask(*p, x1) | mask(*p, x2)) & 0x10; ++p;- case 5: m |= (mask(*p, x1) | mask(*p, x2)) & 0x20; ++p;- case 6: m |= (mask(*p, x1) | mask(*p, x2)) & 0x40; ++p;- case 7: m |= (mask(*p, x1) | mask(*p, x2)) & 0x80; ++p;- case 8: m |= (mask(*p, x1) | mask(*p, x2)) & 0x100; ++p;- case 9: m |= (mask(*p, x1) | mask(*p, x2)) & 0x200; ++p;- case 10: m |= (mask(*p, x1) | mask(*p, x2)) & 0x400; ++p;- case 11: m |= (mask(*p, x1) | mask(*p, x2)) & 0x800; ++p;- case 12: m |= (mask(*p, x1) | mask(*p, x2)) & 0x1000; ++p;- case 13: m |= (mask(*p, x1) | mask(*p, x2)) & 0x2000; ++p;- case 14: m |= (mask(*p, x1) | mask(*p, x2)) & 0x4000; ++p;- case 15: m |= (mask(*p, x1) | mask(*p, x2)) & 0x8000; ++p;- }-- return m >> offset;-}---int lineSearch32_2(uint32_t* array, int start, uint32_t x1, uint32_t x2) {- uint32_t m = lineMask32_2(array, start, x1, x2);- return lineResult32((int)m, start);-}---uint32_t lineMask32_3(uint32_t* array, int start,- uint32_t x1, uint32_t x2, uint32_t x3) {- uint32_t* p = array + start;- uint32_t m = 0;- int offset = start & 0xf;-- switch (offset) {- case 0: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x1; ++p;- case 1: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x2; ++p;- case 2: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x4; ++p;- case 3: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x8; ++p;- case 4: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x10; ++p;- case 5: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x20; ++p;- case 6: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x40; ++p;- case 7: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x80; ++p;- case 8: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x100; ++p;- case 9: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x200; ++p;- case 10: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x400; ++p;- case 11: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x800; ++p;- case 12: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x1000; ++p;- case 13: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x2000; ++p;- case 14: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x4000; ++p;- case 15: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x8000; ++p;- }-- return m >> offset;-}---int lineSearch32_3(uint32_t* array, int start,- uint32_t x1, uint32_t x2, uint32_t x3) {- uint32_t m = lineMask32_3(array, start, x1, x2, x3);- return lineResult32((int)m, start);-}---//-----------------------------------------------------------------------------// Now: 64-bit. If USE_SSE_4_1 is on, we will use SSE4.1 SIMD instructions to-// search the cache line super-efficiently.--#if defined(USE_SSE_4_1)--inline uint64_t mask_to_mask2(__m128i m) {- int mask16 = _mm_movemask_epi8(m);- // output of _mm_movemask_epi8 is a 16-bit word where bit i is 1 iff the- // most significant bit of byte i of the mask is 1- int m1 = mask16 & 0x1;- int m2 = (mask16 & 0x100) >> 7;- return (uint64_t) (m1 | m2);-}---inline uint64_t cmp_and_mask(__m128i val, __m128i x0) {- __m128i mask1 = _mm_cmpeq_epi64(val, x0);- return mask_to_mask2(mask1);-}---inline uint64_t cmp_and_mask_2(__m128i val, __m128i x0, __m128i x1) {- __m128i mask1 = _mm_cmpeq_epi64(val, x0);- __m128i mask2 = _mm_cmpeq_epi64(val, x1);- mask1 = _mm_or_si128(mask1, mask2);- return mask_to_mask2(mask1);-}---inline uint64_t cmp_and_mask_3(__m128i val, __m128i x0, __m128i x1,- __m128i x2) {- __m128i mask1 = _mm_cmpeq_epi64(val, x0);- __m128i mask2 = _mm_cmpeq_epi64(val, x1);- __m128i mask3 = _mm_cmpeq_epi64(val, x2);- mask1 = _mm_or_si128(mask1, mask2);- mask1 = _mm_or_si128(mask1, mask3);- return mask_to_mask2(mask1);-}---uint64_t lineMask64(uint64_t* array, int start0, uint64_t v1) {- int offset = start0 & 0x7;- int start = start0 & ~0x7;-- __m128i* p = (__m128i*) (&array[start]);- __m128i x1 = _mm_cvtsi32_si128(0);- x1 = _mm_insert_epi64(x1, v1, 0);- x1 = _mm_insert_epi64(x1, v1, 1);- uint64_t dest_mask = 0;-- // x1 contains two 64-bit copies of the value to look for-- // words 0, 1- __m128i x = _mm_load_si128(p);- dest_mask = cmp_and_mask(x, x1);- p = (__m128i*) (&array[start+2]);-- // words 2, 3- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask(x, x1) << 2);- p = (__m128i*) (&array[start+4]);-- // words 4, 5- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask(x, x1) << 4);- p = (__m128i*) (&array[start+6]);-- // words 6, 7- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask(x, x1) << 6);-- return dest_mask >> offset;-}---uint64_t lineMask64_2(uint64_t* array, int start0, uint64_t v1, uint64_t v2) {- int offset = start0 & 0x7;- int start = start0 & ~0x7;-- __m128i* p = (__m128i*) (&array[start]);- __m128i x1 = _mm_cvtsi32_si128(0);- x1 = _mm_insert_epi64(x1, v1, 0);- x1 = _mm_insert_epi64(x1, v1, 1);-- __m128i x2 = _mm_cvtsi32_si128(0);- x2 = _mm_insert_epi64(x2, v2, 0);- x2 = _mm_insert_epi64(x2, v2, 1);-- uint64_t dest_mask = 0;-- // words 0, 1- __m128i x = _mm_load_si128(p);- dest_mask = cmp_and_mask_2(x, x1, x2);- p = (__m128i*) (&array[start+2]);-- // words 2, 3- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask_2(x, x1, x2) << 2);- p = (__m128i*) (&array[start+4]);-- // words 4, 5- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask_2(x, x1, x2) << 4);- p = (__m128i*) (&array[start+6]);-- // words 6, 7- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask_2(x, x1, x2) << 6);-- return dest_mask >> offset;-}---uint64_t lineMask64_3(uint64_t* array, int start0,- uint64_t v1, uint64_t v2, uint64_t v3) {- int offset = start0 & 0x7;- int start = start0 & ~0x7;-- __m128i* p = (__m128i*) (&array[start]);- __m128i x1 = _mm_cvtsi32_si128(0);- x1 = _mm_insert_epi64(x1, v1, 0);- x1 = _mm_insert_epi64(x1, v1, 1);-- __m128i x2 = _mm_cvtsi32_si128(0);- x2 = _mm_insert_epi64(x2, v2, 0);- x2 = _mm_insert_epi64(x2, v2, 1);-- __m128i x3 = _mm_cvtsi32_si128(0);- x3 = _mm_insert_epi64(x3, v3, 0);- x3 = _mm_insert_epi64(x3, v3, 1);-- uint64_t dest_mask = 0;-- // words 0, 1- __m128i x = _mm_load_si128(p);- dest_mask = cmp_and_mask_3(x, x1, x2, x3);- p = (__m128i*) (&array[start+2]);-- // words 2, 3- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask_3(x, x1, x2, x3) << 2);- p = (__m128i*) (&array[start+4]);-- // words 4, 5- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask_3(x, x1, x2, x3) << 4);- p = (__m128i*) (&array[start+6]);-- // words 6, 7- x = _mm_load_si128(p);- dest_mask |= (cmp_and_mask_3(x, x1, x2, x3) << 6);-- return dest_mask >> offset;-}---#else----uint64_t lineMask64(uint64_t* array, int start, uint64_t value) {- uint64_t* p = array + start;- uint64_t m = 0;- int offset = start & 0x7;-- switch (offset) {- case 0: m |= mask(*p++, value) & 0x1;- case 1: m |= mask(*p++, value) & 0x2;- case 2: m |= mask(*p++, value) & 0x4;- case 3: m |= mask(*p++, value) & 0x8;- case 4: m |= mask(*p++, value) & 0x10;- case 5: m |= mask(*p++, value) & 0x20;- case 6: m |= mask(*p++, value) & 0x40;- case 7: m |= mask(*p++, value) & 0x80;- }-- return m >> offset;-}---uint64_t lineMask64_2(uint64_t* array, int start, uint64_t x1, uint64_t x2) {- uint64_t* p = array + start;- uint64_t m = 0;- int offset = start & 0x7;-- switch (offset) {- case 0: m |= (mask(*p, x1) | mask(*p, x2)) & 0x1; ++p;- case 1: m |= (mask(*p, x1) | mask(*p, x2)) & 0x2; ++p;- case 2: m |= (mask(*p, x1) | mask(*p, x2)) & 0x4; ++p;- case 3: m |= (mask(*p, x1) | mask(*p, x2)) & 0x8; ++p;- case 4: m |= (mask(*p, x1) | mask(*p, x2)) & 0x10; ++p;- case 5: m |= (mask(*p, x1) | mask(*p, x2)) & 0x20; ++p;- case 6: m |= (mask(*p, x1) | mask(*p, x2)) & 0x40; ++p;- case 7: m |= (mask(*p, x1) | mask(*p, x2)) & 0x80; ++p;- }-- return m >> offset;-}---uint64_t lineMask64_3(uint64_t* array, int start,- uint64_t x1, uint64_t x2, uint64_t x3) {- uint64_t* p = array + start;- uint64_t m = 0;- int offset = start & 0x7;-- switch (offset) {- case 0: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x1; ++p;- case 1: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x2; ++p;- case 2: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x4; ++p;- case 3: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x8; ++p;- case 4: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x10; ++p;- case 5: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x20; ++p;- case 6: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x40; ++p;- case 7: m |= (mask(*p, x1) | mask(*p, x2) | mask(*p, x3)) & 0x80; ++p;- }-- return m >> offset;-}---#endif // USE_SSE_4_1---int64_t lineResult64(int64_t m, int64_t start) {- int p = firstBitSet((int)m);- int64_t mm = (int64_t) mask(p, -1);- return mm | (~mm & (start + p));-}---int lineSearch64(uint64_t* array, int start, uint64_t value) {- uint64_t m = lineMask64(array, start, value);- return lineResult64((int)m, start);-}---int lineSearch64_2(uint64_t* array, int start, uint64_t x1, uint64_t x2) {- uint64_t m = lineMask64_2(array, start, x1, x2);- return lineResult64((int)m, start);-}---int lineSearch64_3(uint64_t* array, int start,- uint64_t x1, uint64_t x2, uint64_t x3) {- uint64_t m = lineMask64_3(array, start, x1, x2, x3);- return lineResult64((int)m, start);-}--void suicide(volatile int* check, int t) {- int secs = (3*t + 999999) / 1000000;- if (secs < 1) secs = 1;-#ifdef WIN32- Sleep(secs * 1000);-#else- sleep(secs);-#endif- if (*check) {- printf("timeout expired, dying!!\n");-#ifdef WIN32- abort();-#else- raise(SIGKILL);-#endif- }-}
+ cbits/check.c view
@@ -0,0 +1,185 @@+#include <stdlib.h>+#include <stdio.h>+#include "defs.h"++static const int NUMH = 64 / sizeof(small_hash_t);++static small_hash_t t_sevens[32] =+ { 7,7,7,7,7,7,7,7,+ 7,7,7,7,7,7,7,7,+ 7,7,7,7,7,7,7,7,+ 7,7,7,7,7,7,7,7 };++static small_hash_t t_zeroes[32] =+ { 0,0,0,0,0,0,0,0,+ 0,0,0,0,0,0,0,0,+ 0,0,0,0,0,0,0,0,+ 0,0,0,0,0,0,0,0 };++static small_hash_t t_mixed[32] =+ { 7,1,7,7,2,7,7,7,+ 7,7,3,7,7,7,7,7,+ 7,7,7,7,1,7,7,7,+ 7,7,7,7,3,7,7,9 };++static int num_tests = 0;+static int num_errors = 0;++void CHECK(int actual, int expected, char* what) {+ ++num_tests;+ if (actual != expected) {+ fprintf(stderr, "%s: expected %d, got %d\n", what, expected, actual);++ ++num_errors;+ }+}+++void check_forward_search_2() {+ /* forward_search_2 */+ /* - offset zero */+ CHECK(forward_search_2(t_sevens, 0, NUMH, 0, 7 ), 0, "fs2-sevens-ok-1" );+ CHECK(forward_search_2(t_sevens, 0, NUMH, 7, 0 ), 0, "fs2-sevens-ok-2" );+ CHECK(forward_search_2(t_sevens, 0, NUMH, 7, 7 ), 0, "fs2-sevens-ok-3" );+ CHECK(forward_search_2(t_sevens, 0, NUMH, 3, 0 ), -1, "fs2-sevens-fail-1");+ CHECK(forward_search_2(t_zeroes, 0, NUMH, 0, 1 ), 0, "fs2-zeroes-ok-1" );+ CHECK(forward_search_2(t_zeroes, 0, NUMH, 2, 0 ), 0, "fs2-zeroes-ok-2" );+ CHECK(forward_search_2(t_zeroes, 0, NUMH, 2, 0xf0), -1, "fs2-zeroes-fail-1");++ /* - offset 5 */+ CHECK(forward_search_2(t_sevens, 5, NUMH, 0, 7), 5, "fs2-o-sevens-ok-1" );+ CHECK(forward_search_2(t_sevens, 5, NUMH, 7, 0), 5, "fs2-o-sevens-ok-2" );+ CHECK(forward_search_2(t_sevens, 5, NUMH, 7, 7), 5, "fs2-o-sevens-ok-3" );+ CHECK(forward_search_2(t_sevens, 5, NUMH, 3, 0), -1, "fs2-o-sevens-fail-1");+ CHECK(forward_search_2(t_zeroes, 5, NUMH, 0, 1), 5, "fs2-o-zeroes-ok-1" );+ CHECK(forward_search_2(t_zeroes, 5, NUMH, 2, 0), 5, "fs2-o-zeroes-ok-2" );+ CHECK(forward_search_2(t_zeroes, 5, NUMH, 2, 0xf0), -1, "fs2-o-zeroes-fail-1");++ /* - mixed, offset zero */+ CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 0xf0), 4, "fs2-mixed-ok-1" );+ CHECK(forward_search_2(t_mixed, 0, NUMH, 4, 0xf0), -1, "fs2-mixed-fail-1");+ CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 1), 1, "fs2-mixed-ok-2" );+ CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 7), 0, "fs2-mixed-ok-3" );+ CHECK(forward_search_2(t_mixed, 0, NUMH, 2, 3), 4, "fs2-mixed-ok-4" );+ CHECK(forward_search_2(t_mixed, 0, NUMH, 9, 3), 10, "fs2-mixed-ok-5" );+ CHECK(forward_search_2(t_mixed, 0, NUMH, 3, 9), 10, "fs2-mixed-ok-5" );+ CHECK(forward_search_2(t_mixed, 0, NUMH, 8, 9), 31, "fs2-mixed-ok-6" );++ /* - mixed, offset 16 */+ CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 0xf0), 4, "fs2-o-mixed-ok-1" );+ CHECK(forward_search_2(t_mixed, 16, NUMH, 4, 0xf0), -1, "fs2-o-mixed-fail-1");+ CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 1), 20, "fs2-o-mixed-ok-2" );+ CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 7), 16, "fs2-o-mixed-ok-3" );+ CHECK(forward_search_2(t_mixed, 16, NUMH, 2, 3), 28, "fs2-o-mixed-ok-4" );+ CHECK(forward_search_2(t_mixed, 16, NUMH, 9, 3), 28, "fs2-o-mixed-ok-5" );+ CHECK(forward_search_2(t_mixed, 16, NUMH, 3, 9), 28, "fs2-o-mixed-ok-5" );+ CHECK(forward_search_2(t_mixed, 16, NUMH, 8, 9), 31, "fs2-o-mixed-ok-6" );+}++void check_forward_search_3() {+ /* forward_search_3 */+ /* - offset zero */+ CHECK(forward_search_3(t_sevens, 0, NUMH, 0, 7, 88), 0, "fs3-sevens-ok-1" );+ CHECK(forward_search_3(t_sevens, 0, NUMH, 7, 0, 88), 0, "fs3-sevens-ok-2" );+ CHECK(forward_search_3(t_sevens, 0, NUMH, 7, 7, 88), 0, "fs3-sevens-ok-3" );+ CHECK(forward_search_3(t_sevens, 0, NUMH, 3, 0, 88), -1, "fs3-sevens-fail-1");+ CHECK(forward_search_3(t_zeroes, 0, NUMH, 0, 1, 88), 0, "fs3-zeroes-ok-1" );+ CHECK(forward_search_3(t_zeroes, 0, NUMH, 2, 0, 88), 0, "fs3-zeroes-ok-2" );+ CHECK(forward_search_3(t_zeroes, 0, NUMH, 2, 11, 0 ), 0, "fs3-zeroes-ok-3" );+ CHECK(forward_search_3(t_zeroes, 0, NUMH, 2, 32, 88), -1, "fs3-zeroes-fail-1");++ /* - offset 5 */+ CHECK(forward_search_3(t_sevens, 5, NUMH, 0, 7, 7 ), 5, "fs3-o-sevens-ok-1" );+ CHECK(forward_search_3(t_sevens, 5, NUMH, 7, 0, 21), 5, "fs3-o-sevens-ok-2" );+ CHECK(forward_search_3(t_sevens, 5, NUMH, 7, 7, 21), 5, "fs3-o-sevens-ok-3" );+ CHECK(forward_search_3(t_sevens, 5, NUMH, 3, 0, 21), -1, "fs3-o-sevens-fail-1");+ CHECK(forward_search_3(t_zeroes, 5, NUMH, 0, 1, 21), 5, "fs3-o-zeroes-ok-1" );+ CHECK(forward_search_3(t_zeroes, 5, NUMH, 2, 0, 21), 5, "fs3-o-zeroes-ok-2" );+ CHECK(forward_search_3(t_zeroes, 5, NUMH, 2, 0xf0, 21), -1, "fs3-o-zeroes-fail-1");++ /* - mixed, offset zero */+ CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 0xf0, -1), 4, "fs3-mixed-ok-1" );+ CHECK(forward_search_3(t_mixed, 0, NUMH, 4, 0xf0, -1), -1, "fs3-mixed-fail-1");+ CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 1, -1), 1, "fs3-mixed-ok-2" );+ CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 7, -1), 0, "fs3-mixed-ok-3" );+ CHECK(forward_search_3(t_mixed, 0, NUMH, 2, 3, -1), 4, "fs3-mixed-ok-4" );+ CHECK(forward_search_3(t_mixed, 0, NUMH, 9, 3, -1), 10, "fs3-mixed-ok-5" );+ CHECK(forward_search_3(t_mixed, 0, NUMH, 3, 9, -1), 10, "fs3-mixed-ok-5" );+ CHECK(forward_search_3(t_mixed, 0, NUMH, 8, 9, -1), 31, "fs3-mixed-ok-6" );++ /* - mixed, offset 16 */+ CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 96, 33), 4, "fs3-o-mixed-ok-1" );+ CHECK(forward_search_3(t_mixed, 16, NUMH, 4, 96, 33), -1, "fs3-o-mixed-fail-1");+ CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 1, 33), 20, "fs3-o-mixed-ok-2" );+ CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 7, 33), 16, "fs3-o-mixed-ok-3" );+ CHECK(forward_search_3(t_mixed, 16, NUMH, 2, 3, 33), 28, "fs3-o-mixed-ok-4" );+ CHECK(forward_search_3(t_mixed, 16, NUMH, 9, 3, 33), 28, "fs3-o-mixed-ok-5" );+ CHECK(forward_search_3(t_mixed, 16, NUMH, 3, 9, 33), 28, "fs3-o-mixed-ok-5" );+ CHECK(forward_search_3(t_mixed, 16, NUMH, 8, 9, 33), 31, "fs3-o-mixed-ok-6" );+ CHECK(forward_search_3(t_mixed, 16, NUMH, 8, 33, 9 ), 31, "fs3-o-mixed-ok-7" );+}++void check_line_search() {+ CHECK(line_search(t_sevens, 0, 7), 0, "ls-7s-ok-1");+ CHECK(line_search(t_sevens, 5, 7), 5, "ls-7s-ok-2");+ CHECK(line_search(t_sevens, 31, 7), 31, "ls-7s-ok-3");+ CHECK(line_search(t_sevens, 0, 1), -1, "ls-7s-fail-1");+ CHECK(line_search(t_sevens, 31, 1), -1, "ls-7s-fail-2");++ CHECK(line_search(t_mixed, 0, 7), 0, "ls-m-ok-1");+ CHECK(line_search(t_mixed, 0, 1), 1, "ls-m-ok-2");+ CHECK(line_search(t_mixed, 1, 7), 2, "ls-m-ok-3");+ CHECK(line_search(t_mixed, 0, 9), 31, "ls-m-ok-4");+ CHECK(line_search(t_mixed, 0, 8), -1, "ls-m-fail-1");++ CHECK(line_search(t_mixed, 16, 1), 20, "ls-m-ok-5");+}++void check_line_search_2() {+ CHECK(line_search_2(t_sevens, 0, 7, 3), 0, "ls2-7s-ok-1");+ CHECK(line_search_2(t_sevens, 5, 7, 9), 5, "ls2-7s-ok-2");+ CHECK(line_search_2(t_sevens, 31, 0, 7), 31, "ls2-7s-ok-3");+ CHECK(line_search_2(t_sevens, 0, 1, 3), -1, "ls2-7s-fail-1");+ CHECK(line_search_2(t_sevens, 31, 6, 1), -1, "ls2-7s-fail-2");++ CHECK(line_search_2(t_mixed, 0, 7, 9), 0, "ls2-m-ok-1");+ CHECK(line_search_2(t_mixed, 0, 9, 1), 1, "ls2-m-ok-2");+ CHECK(line_search_2(t_mixed, 1, 7, 9), 2, "ls2-m-ok-3");+ CHECK(line_search_2(t_mixed, 0, 8, 9), 31, "ls2-m-ok-4");+ CHECK(line_search_2(t_mixed, 0, 8, 4), -1, "ls2-m-fail-1");++ CHECK(line_search_2(t_mixed, 16, 3, 1), 20, "ls2-m-ok-5");+}++void check_line_search_3() {+ CHECK(line_search_3(t_sevens, 0, 4, 7, 3), 0, "ls2-7s-ok-1");+ CHECK(line_search_3(t_sevens, 5, 7, 4, 9), 5, "ls2-7s-ok-2");+ CHECK(line_search_3(t_sevens, 31, 0, 7, 4), 31, "ls2-7s-ok-3");+ CHECK(line_search_3(t_sevens, 0, 1, 4, 3), -1, "ls2-7s-fail-1");+ CHECK(line_search_3(t_sevens, 31, 4, 6, 1), -1, "ls2-7s-fail-2");++ CHECK(line_search_3(t_mixed, 0, 4, 7, 9), 0, "ls2-m-ok-1");+ CHECK(line_search_3(t_mixed, 0, 9, 4, 1), 1, "ls2-m-ok-2");+ CHECK(line_search_3(t_mixed, 1, 7, 9, 4), 2, "ls2-m-ok-3");+ CHECK(line_search_3(t_mixed, 0, 8, 4, 9), 31, "ls2-m-ok-4");+ CHECK(line_search_3(t_mixed, 0, 8, 4, 6), -1, "ls2-m-fail-1");++ CHECK(line_search_3(t_mixed, 16, 3, 1, 6), 20, "ls2-m-ok-5");+}+++int main() {+ check_forward_search_2();+ check_forward_search_3();+ check_line_search();+ check_line_search_2();+ check_line_search_3();+ check_impl_specific();++ if (num_errors > 0) {+ printf("\n*** %d/%d tests failed.\n", num_errors, num_tests);+ } else {+ printf("All %d tests passed.\n", num_tests);+ }+ exit(num_errors < 255 ? num_errors : 255);+}
+ cbits/common.c view
@@ -0,0 +1,83 @@+#include "defs.h"++#ifdef WIN32+#include <windows.h>+#else+#include <signal.h>+#include <unistd.h>+#endif++#include <stdio.h>++void suicide(volatile int* check, int t) {+ int secs = (3*t + 999999) / 1000000;+ if (secs < 1) secs = 1;+#ifdef WIN32+ Sleep(secs * 1000);+#else+ sleep(secs);+#endif+ if (*check) {+ printf("timeout expired, dying!!\n");+#ifdef WIN32+ abort();+#else+ raise(SIGKILL);+#endif+ }+}++#if defined(__GNUC__)+#define PREFETCH_READ(x) (__builtin_prefetch(x, 0, 3))+#define PREFETCH_WRITE(x) (__builtin_prefetch(x, 1, 3))+#else+#define PREFETCH_READ(x)+#define PREFETCH_WRITE(x)+#endif++void prefetch_cacheline_read(small_hash_t* line, int start)+{+ PREFETCH_READ((void*)(&line[start]));+}++void prefetch_cacheline_write(small_hash_t* line, int start)+{+ PREFETCH_WRITE((void*)(&line[start]));+}++int forward_search_2(small_hash_t* array, int start, int end,+ small_hash_t x1, small_hash_t x2) {+ small_hash_t* ep = array + end;+ small_hash_t* p = array + start;+ int wrapped = 0;+ while (1) {+ if (p >= ep) {+ if (wrapped) return -1;+ ep = array + start;+ p = array;+ wrapped = 1;+ continue;+ }+ if (*p == x1 || *p == x2) return p - array;+ ++p;+ }+}++int forward_search_3(small_hash_t* array, int start, int end,+ small_hash_t x1, small_hash_t x2, small_hash_t x3) {+ small_hash_t* ep = array + end;+ small_hash_t* p = array + start;+ int wrapped = 0;+ while (1) {+ if (p >= ep) {+ if (wrapped) return -1;+ ep = array + start;+ p = array;+ wrapped = 1;+ continue;+ }+ if (*p == x1 || *p == x2 || *p == x3) return p - array;+ ++p;+ }+}+
+ cbits/default.c view
@@ -0,0 +1,202 @@+// Specialized i686 versions of the cache line search functions.++#include "defs.h"++inline int32_t mask(int32_t a, int32_t b) { return -(a == b); }++#if defined(__GNUC__)+inline int32_t first_bit_set(int32_t a) {+ return __builtin_ffs(a) - 1;+}+#else+static uint8_t de_bruijn_table[] = {+ 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,+ 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9+};++inline int32_t first_bit_set(int32_t a) {+ int32_t zero_case = mask(0, a);+ uint32_t x = (uint32_t) (a & -a);+ x *= 0x077CB531;+ x >>= 27;+ return zero_case | de_bruijn_table[x];+}+#endif++inline uint32_t line_mask(small_hash_t* array, int start, small_hash_t x1) {+ small_hash_t* p = array + start;+ uint32_t m1 = 0;+ uint32_t m2 = 0;+ uint32_t m3 = 0;+ int offset = start & 0x1f;++#define M (mask(*p, x1))++ switch (offset) {+ case 0: m1 |= M & 0x1; ++p;+ case 1: m2 |= M & 0x2; ++p;+ case 2: m3 |= M & 0x4; ++p;+ case 3: m1 |= M & 0x8; ++p;+ case 4: m2 |= M & 0x10; ++p;+ case 5: m3 |= M & 0x20; ++p;+ case 6: m1 |= M & 0x40; ++p;+ case 7: m2 |= M & 0x80; ++p;+ case 8: m3 |= M & 0x100; ++p;+ case 9: m1 |= M & 0x200; ++p;+ case 10: m2 |= M & 0x400; ++p;+ case 11: m3 |= M & 0x800; ++p;+ case 12: m1 |= M & 0x1000; ++p;+ case 13: m2 |= M & 0x2000; ++p;+ case 14: m3 |= M & 0x4000; ++p;+ case 15: m1 |= M & 0x8000; ++p;+ case 16: m2 |= M & 0x10000; ++p;+ case 17: m3 |= M & 0x20000; ++p;+ case 18: m1 |= M & 0x40000; ++p;+ case 19: m2 |= M & 0x80000; ++p;+ case 20: m3 |= M & 0x100000; ++p;+ case 21: m1 |= M & 0x200000; ++p;+ case 22: m2 |= M & 0x400000; ++p;+ case 23: m3 |= M & 0x800000; ++p;+ case 24: m1 |= M & 0x1000000; ++p;+ case 25: m2 |= M & 0x2000000; ++p;+ case 26: m3 |= M & 0x4000000; ++p;+ case 27: m1 |= M & 0x8000000; ++p;+ case 28: m2 |= M & 0x10000000; ++p;+ case 29: m3 |= M & 0x20000000; ++p;+ case 30: m1 |= M & 0x40000000; ++p;+ case 31: m2 |= M & 0x80000000; ++p;+ }++#undef M++ return (m1 | m2 | m3) >> offset;+}++inline uint32_t line_mask_2(small_hash_t* array, int start,+ small_hash_t x1, small_hash_t x2) {+ small_hash_t* p = array + start;+ uint32_t m1 = 0;+ uint32_t m2 = 0;+ uint32_t m3 = 0;+ int offset = start & 0x1f;++#define M (mask(*p, x1) | mask(*p, x2))++ switch (offset) {+ case 0: m1 |= M & 0x1; ++p;+ case 1: m2 |= M & 0x2; ++p;+ case 2: m3 |= M & 0x4; ++p;+ case 3: m1 |= M & 0x8; ++p;+ case 4: m2 |= M & 0x10; ++p;+ case 5: m3 |= M & 0x20; ++p;+ case 6: m1 |= M & 0x40; ++p;+ case 7: m2 |= M & 0x80; ++p;+ case 8: m3 |= M & 0x100; ++p;+ case 9: m1 |= M & 0x200; ++p;+ case 10: m2 |= M & 0x400; ++p;+ case 11: m3 |= M & 0x800; ++p;+ case 12: m1 |= M & 0x1000; ++p;+ case 13: m2 |= M & 0x2000; ++p;+ case 14: m3 |= M & 0x4000; ++p;+ case 15: m1 |= M & 0x8000; ++p;+ case 16: m2 |= M & 0x10000; ++p;+ case 17: m3 |= M & 0x20000; ++p;+ case 18: m1 |= M & 0x40000; ++p;+ case 19: m2 |= M & 0x80000; ++p;+ case 20: m3 |= M & 0x100000; ++p;+ case 21: m1 |= M & 0x200000; ++p;+ case 22: m2 |= M & 0x400000; ++p;+ case 23: m3 |= M & 0x800000; ++p;+ case 24: m1 |= M & 0x1000000; ++p;+ case 25: m2 |= M & 0x2000000; ++p;+ case 26: m3 |= M & 0x4000000; ++p;+ case 27: m1 |= M & 0x8000000; ++p;+ case 28: m2 |= M & 0x10000000; ++p;+ case 29: m3 |= M & 0x20000000; ++p;+ case 30: m1 |= M & 0x40000000; ++p;+ case 31: m2 |= M & 0x80000000; ++p;+ }++#undef M++ return (m1 | m2 | m3) >> offset;+}++inline uint32_t line_mask_3(small_hash_t* array, int start,+ small_hash_t x1, small_hash_t x2,+ small_hash_t x3) {+ small_hash_t* p = array + start;+ uint32_t m1 = 0;+ uint32_t m2 = 0;+ uint32_t m3 = 0;+ int offset = start & 0x1f;++#define M (mask(*p, x1) | mask(*p, x2) | mask(*p, x3))++ switch (offset) {+ case 0: m1 |= M & 0x1; ++p;+ case 1: m2 |= M & 0x2; ++p;+ case 2: m3 |= M & 0x4; ++p;+ case 3: m1 |= M & 0x8; ++p;+ case 4: m2 |= M & 0x10; ++p;+ case 5: m3 |= M & 0x20; ++p;+ case 6: m1 |= M & 0x40; ++p;+ case 7: m2 |= M & 0x80; ++p;+ case 8: m3 |= M & 0x100; ++p;+ case 9: m1 |= M & 0x200; ++p;+ case 10: m2 |= M & 0x400; ++p;+ case 11: m3 |= M & 0x800; ++p;+ case 12: m1 |= M & 0x1000; ++p;+ case 13: m2 |= M & 0x2000; ++p;+ case 14: m3 |= M & 0x4000; ++p;+ case 15: m1 |= M & 0x8000; ++p;+ case 16: m2 |= M & 0x10000; ++p;+ case 17: m3 |= M & 0x20000; ++p;+ case 18: m1 |= M & 0x40000; ++p;+ case 19: m2 |= M & 0x80000; ++p;+ case 20: m3 |= M & 0x100000; ++p;+ case 21: m1 |= M & 0x200000; ++p;+ case 22: m2 |= M & 0x400000; ++p;+ case 23: m3 |= M & 0x800000; ++p;+ case 24: m1 |= M & 0x1000000; ++p;+ case 25: m2 |= M & 0x2000000; ++p;+ case 26: m3 |= M & 0x4000000; ++p;+ case 27: m1 |= M & 0x8000000; ++p;+ case 28: m2 |= M & 0x10000000; ++p;+ case 29: m3 |= M & 0x20000000; ++p;+ case 30: m1 |= M & 0x40000000; ++p;+ case 31: m2 |= M & 0x80000000; ++p;+ }+#undef M++ return (m1 | m2 | m3) >> offset;+}+++inline int32_t line_result(uint32_t m, int start) {+ int32_t p = first_bit_set((int32_t) m);+ int32_t mm = mask(p, -1);+ return mm | (start + p);+}+++int line_search(small_hash_t* array, int start, small_hash_t x1) {+ uint32_t m = line_mask(array, start, x1);+ return line_result(m, start);+}++int line_search_2(small_hash_t* array, int start, small_hash_t x1,+ small_hash_t x2) {+ uint32_t m = line_mask_2(array, start, x1, x2);+ return line_result(m, start);+}++int line_search_3(small_hash_t* array, int start, small_hash_t x1,+ small_hash_t x2, small_hash_t x3) {+ uint32_t m = line_mask_3(array, start, x1, x2, x3);+ return line_result(m, start);+}++void check_impl_specific(int* num_tests, int* num_errors) {++}
+ cbits/defs.h view
@@ -0,0 +1,35 @@+#ifndef HASHTABLES_DEFS_H+#define HASHTABLES_DEFS_H++#include <stdint.h>+#include <strings.h>++typedef uintptr_t full_hash_t;+typedef uint16_t small_hash_t;++void prefetch_cacheline_write(small_hash_t* line, int start);+void prefetch_cacheline_read(small_hash_t* line, int start);++int forward_search_2(small_hash_t* array,+ int start,+ int end,+ small_hash_t x1,+ small_hash_t x2);+int forward_search_3(small_hash_t* array,+ int start,+ int end,+ small_hash_t x1,+ small_hash_t x2,+ small_hash_t x3);++int line_search(small_hash_t* array, int start, small_hash_t x1);+int line_search_2(small_hash_t* array, int start, small_hash_t x1,+ small_hash_t x2);+int line_search_3(small_hash_t* array, int start, small_hash_t x1,+ small_hash_t x2, small_hash_t x3);+void suicide(volatile int* check, int i);++void CHECK(int actual, int expected, char* what);+void check_impl_specific();++#endif /* HASHTABLES_DEFS_H */
+ cbits/sse-42-check.c view
@@ -0,0 +1,38 @@+#include "defs.h"++#include <smmintrin.h>+#include <stdio.h>++extern __m128i fill(small_hash_t v);++static void check_fill(small_hash_t v) {+ int i;+ char buf[256];+ small_hash_t v2;++ __m128i x = fill(v);++#define F(i) do { \+ v2 = _mm_extract_epi16(x, i); \+ sprintf(buf, "fill-%x-%d-of-8", (int) v, i+1); \+ CHECK(v2, v, buf); \+ } while(0);++ F(0);+ F(1);+ F(2);+ F(3);+ F(4);+ F(5);+ F(6);+ F(7);+#undef F+}++void check_impl_specific() {+ check_fill(0);+ check_fill((small_hash_t) (-1));+ check_fill((small_hash_t) (-5));+ check_fill(7);+ check_fill(0xff);+}
+ cbits/sse-42.c view
@@ -0,0 +1,172 @@+#include "defs.h"++#include <smmintrin.h>+#include <stdio.h>++/* Straight-line branchless SSE 4.2 code for searching an array of uint16_t+ hash codes. */++static inline int32_t mask(int32_t a, int32_t b) { return -(a == b); }++#if defined(__GNUC__)+static inline int32_t first_bit_set(int32_t a) {+ return __builtin_ffs(a) - 1;+}+#else+static uint8_t de_bruijn_table[] = {+ 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,+ 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9+};++static inline int32_t first_bit_set(int32_t a) {+ int32_t zero_case = mask(0, a);+ uint32_t x = (uint32_t) (a & -a);+ x *= 0x077CB531;+ x >>= 27;+ return zero_case | de_bruijn_table[x];+}+#endif++inline __m128i fill(small_hash_t v) {+ int32_t v1 = (((int)v) << 16) | v;+ __m128i x = _mm_cvtsi32_si128(0);+ x = _mm_insert_epi32(x, v1, 0);+ return _mm_shuffle_epi32(x, _MM_SHUFFLE(0,0,0,0));+}++#ifndef SIDD_UWORD_OPS+#define SIDD_UWORD_OPS _SIDD_UWORD_OPS+#endif++#ifndef SIDD_CMP_EQUAL_EACH+#define SIDD_CMP_EQUAL_EACH _SIDD_CMP_EQUAL_EACH+#endif++#ifndef SIDD_BIT_MASK+#define SIDD_BIT_MASK _SIDD_BIT_MASK+#endif++#define _MODE (SIDD_UWORD_OPS | SIDD_CMP_EQUAL_EACH)++static inline __m128i cmp_mask(__m128i a, __m128i b) {+ const int mode = SIDD_UWORD_OPS | SIDD_CMP_EQUAL_EACH | SIDD_BIT_MASK;+ return _mm_cmpistrm(a, b, mode);+}++static inline int32_t line_result(uint32_t m, int start) {+ int32_t p = first_bit_set((int32_t) m);+ int32_t mm = mask(p, -1);+ return mm | (start + p);+}++#define DUMP(xval) do { \+ uint16_t xval##_x0 = _mm_extract_epi16(xval, 0); \+ uint16_t xval##_x1 = _mm_extract_epi16(xval, 1); \+ uint16_t xval##_x2 = _mm_extract_epi16(xval, 2); \+ uint16_t xval##_x3 = _mm_extract_epi16(xval, 3); \+ uint16_t xval##_x4 = _mm_extract_epi16(xval, 4); \+ uint16_t xval##_x5 = _mm_extract_epi16(xval, 5); \+ uint16_t xval##_x6 = _mm_extract_epi16(xval, 6); \+ uint16_t xval##_x7 = _mm_extract_epi16(xval, 7); \+ printf(" % 10s: %04x-%04x-%04x-%04x-%04x-%04x-%04x-%04x\n", \+ #xval, xval##_x0, xval##_x1, xval##_x2, xval##_x3, \+ xval##_x4, xval##_x5, xval##_x6, xval##_x7); \+ } while(0);+++int line_search(small_hash_t* array, int start0, small_hash_t v1) {+ int offset = start0 & 31;+ int start = start0 & ~31;+ __m128i* p = (__m128i*) &array[start];+ __m128i x1, val1, val2, val3, val4;+ __m128i m1, m2, m3, m4, dmask;++ x1 = fill(v1);++ val1 = *p++;+ m1 = cmp_mask(x1, val1);+ val2 = *p++;+ m2 = _mm_slli_si128(cmp_mask(x1, val2), 1);+ val3 = *p++;+ m3 = _mm_slli_si128(cmp_mask(x1, val3), 2);+ val4 = *p;+ m4 = _mm_slli_si128(cmp_mask(x1, val4), 3);++ dmask = _mm_or_si128(_mm_or_si128(m1, m2),+ _mm_or_si128(m3, m4));+ uint32_t imask = _mm_extract_epi32(dmask, 0);++ const uint32_t p2 = 1 << offset;+ const uint32_t dest_mask = imask & ~(p2 - 1);++ return line_result(dest_mask, start);+}++int line_search_2(small_hash_t* array, int start0, small_hash_t v1,+ small_hash_t v2) {+ int offset = start0 & 31;+ int start = start0 & ~31;+ __m128i* p = (__m128i*) &array[start];+ __m128i x1, x2, val1, val2, val3, val4;+ __m128i m1, m2, m3, m4, dmask;++ x1 = fill(v1);+ x2 = fill(v2);++#define M(v) _mm_or_si128(cmp_mask(x1,(v)), \+ cmp_mask(x2,(v)))+ val1 = *p++;+ m1 = M(val1);+ val2 = *p++;+ m2 = _mm_slli_si128(M(val2), 1);+ val3 = *p++;+ m3 = _mm_slli_si128(M(val3), 2);+ val4 = *p;+ m4 = _mm_slli_si128(M(val4), 3);+#undef M++ dmask = _mm_or_si128(_mm_or_si128(m1, m2),+ _mm_or_si128(m3, m4));+ uint32_t imask = _mm_extract_epi32(dmask, 0);++ const uint32_t p2 = 1 << offset;+ const uint32_t dest_mask = imask & ~(p2 - 1);++ return line_result(dest_mask, start);+}++int line_search_3(small_hash_t* array, int start0, small_hash_t v1,+ small_hash_t v2, small_hash_t v3) {+ int offset = start0 & 31;+ int start = start0 & ~31;+ __m128i* p = (__m128i*) &array[start];+ __m128i x1, x2, x3, val1, val2, val3, val4;+ __m128i m1, m2, m3, m4, dmask;++ x1 = fill(v1);+ x2 = fill(v2);+ x3 = fill(v3);++#define M(v) _mm_or_si128( \+ cmp_mask(x1,(v)), \+ _mm_or_si128(cmp_mask(x2,(v)), \+ cmp_mask(x3,(v))))+ val1 = *p++;+ m1 = M(val1);+ val2 = *p++;+ m2 = _mm_slli_si128(M(val2), 1);+ val3 = *p++;+ m3 = _mm_slli_si128(M(val3), 2);+ val4 = *p;+ m4 = _mm_slli_si128(M(val4), 3);+#undef M++ dmask = _mm_or_si128(_mm_or_si128(m1, m2),+ _mm_or_si128(m3, m4));+ uint32_t imask = _mm_extract_epi32(dmask, 0);++ const uint32_t p2 = 1 << offset;+ const uint32_t dest_mask = imask & ~(p2 - 1);++ return line_result(dest_mask, start);+}
hashtables.cabal view
@@ -1,12 +1,12 @@ Name: hashtables-Version: 1.1.2.1+Version: 1.2.0.0 Synopsis: Mutable hash tables in the ST monad Homepage: http://github.com/gregorycollins/hashtables License: BSD3 License-file: LICENSE Author: Gregory Collins Maintainer: greg@gregorycollins.net-Copyright: (c) 2011-2013, Google, Inc.+Copyright: (c) 2011-2014, Google, Inc. Category: Data Build-type: Simple Cabal-version: >= 1.8@@ -22,18 +22,11 @@ . This package currently contains three hash table implementations: .- 1. "Data.HashTable.ST.Basic" contains a basic open-addressing hash table- using linear probing as the collision strategy. On a pure speed basis it- should currently be the fastest available Haskell hash table- implementation for lookups, although it has a higher memory overhead- than the other tables and can suffer from long delays when the table is- resized because all of the elements in the table need to be rehashed.- .- 2. "Data.HashTable.ST.Cuckoo" contains an implementation of \"cuckoo+ 1. "Data.HashTable.ST.Cuckoo" contains an implementation of \"cuckoo hashing\" as introduced by Pagh and Rodler in 2001 (see <http://en.wikipedia.org/wiki/Cuckoo_hashing>). Cuckoo hashing has worst-case /O(1)/ lookups and can reach a high \"load factor\", in which- the table can perform acceptably well even when more than 90% full.+ the table can perform acceptably well even when approaching 90% full. Randomized testing shows this implementation of cuckoo hashing to be slightly faster on insert and slightly slower on lookup than "Data.Hashtable.ST.Basic", while being more space efficient by about a@@ -41,6 +34,13 @@ table implementation using linear probing, can suffer from long delays when the table is resized. .+ 2. "Data.HashTable.ST.Basic" contains a basic open-addressing hash table+ using linear probing as the collision strategy. On a pure speed basis it+ should currently be the fastest available Haskell hash table+ implementation for lookups, although it has a higher memory overhead+ than the other tables and can suffer from long delays when the table is+ resized because all of the elements in the table need to be rehashed.+ . 3. "Data.HashTable.ST.Linear" contains a linear hash table (see <http://en.wikipedia.org/wiki/Linear_hashing>), which trades some insert and lookup performance for higher space efficiency and much shorter@@ -76,7 +76,7 @@ dangerous. Caveat emptor. In particular, these techniques are incompatible with HPC code coverage reports. .- * @sse41@, default /OFF/. If this flag is enabled, we use some SSE 4.1+ * @sse42@, default /OFF/. If this flag is enabled, we use some SSE 4.2 instructions (see <http://en.wikipedia.org/wiki/SSE4>, first available on Intel Core 2 processors) to speed up cache-line searches for cuckoo hashing.@@ -89,7 +89,7 @@ . * @portable@, default /OFF/. If this flag is enabled, we use only pure Haskell code and try not to use unportable GHC extensions. Turning this- flag on forces @unsafe-tricks@ and @sse41@ /OFF/.+ flag on forces @unsafe-tricks@ and @sse42@ /OFF/. . This package has been tested with GHC 7.0.3, on: .@@ -118,6 +118,10 @@ benchmark/src/Data/Vector/Algorithms/Shuffle.hs, benchmark/src/Data/Benchmarks/UnorderedCollections/Distributions.hs, benchmark/src/Data/Benchmarks/UnorderedCollections/Types.hs,+ cbits/Makefile,+ cbits/check.c,+ cbits/defs.h,+ cbits/sse-42-check.c, test/compute-overhead/ComputeOverhead.hs, test/hashtables-test.cabal, test/runTestsAndCoverage.sh,@@ -139,8 +143,8 @@ Description: if on, spew debugging output to stdout Default: False -Flag sse41- Description: if on, use SSE 4.1 extensions to search cache lines very+Flag sse42+ Description: if on, use SSE 4.2 extensions to search cache lines very efficiently. The portable flag forces this off. Default: False @@ -152,8 +156,16 @@ Library hs-source-dirs: src + if flag(sse42) && !flag(portable)+ cc-options: -DUSE_SSE_4_2 -msse4.2+ cpp-options: -DUSE_SSE_4_2+ C-sources: cbits/sse-42.c++ if !flag(portable) && !flag(sse42)+ C-sources: cbits/default.c+ if !flag(portable)- C-sources: cbits/cfuncs.c+ C-sources: cbits/common.c Exposed-modules: Data.HashTable.Class, Data.HashTable.IO,@@ -179,7 +191,7 @@ if !flag(portable) && flag(unsafe-tricks) && impl(ghc) build-depends: ghc-prim- cpp-options = -DUNSAFETRICKS+ cpp-options: -DUNSAFETRICKS if flag(debug) cpp-options: -DDEBUG@@ -187,10 +199,6 @@ if flag(bounds-checking) cpp-options: -DBOUNDS_CHECKING - if flag(sse41) && !flag(portable)- cc-options: -DUSE_SSE_4_1 -msse4.1- cpp-options: -DUSE_SSE_4_1- ghc-prof-options: -prof -auto-all if impl(ghc >= 6.12.0)@@ -198,4 +206,3 @@ -fno-warn-unused-do-bind else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2-
src/Data/HashTable/IO.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ExplicitForAll #-} -- | This module provides wrappers in 'IO' around the functions from -- "Data.HashTable.Class".@@ -61,7 +62,7 @@ import Control.Monad.ST (stToIO) import Control.Monad.ST.Unsafe (unsafeIOToST) #else-import Control.Monad.ST (stToIO, unsafeIOToST)+import Control.Monad.ST (stToIO, unsafeIOToST) #endif import Data.Hashable (Hashable) import qualified Data.HashTable.Class as C@@ -113,7 +114,7 @@ --------------------------------------------------------------------------------- | See the documentation for this function in "Data.HashTable.Class#v:update".+-- | See the documentation for this function in "Data.HashTable.Class#v:insert". insert :: (C.HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () insert h k v = stToIO $ C.insert h k v
src/Data/HashTable/Internal/CacheLine.hs view
@@ -19,847 +19,809 @@ , maskw# ) where -#if MIN_VERSION_base(4,4,0)-import Control.Monad.ST (ST)-import Control.Monad.ST.Unsafe-#else-import Control.Monad.ST-#endif--import Data.HashTable.Internal.IntArray (IntArray)-import qualified Data.HashTable.Internal.IntArray as M--#ifndef NO_C_SEARCH-import Control.Monad-import Foreign.C.Types-#else-import Data.Bits-import Data.Int-import qualified Data.Vector.Unboxed as U-import GHC.Int-#endif--import Data.HashTable.Internal.Utils-import GHC.Exts--#if __GLASGOW_HASKELL__ >= 707-import GHC.Exts (isTrue#)-#else-isTrue# :: Bool -> Bool-isTrue# = id-#endif---{-# INLINE prefetchRead #-}-{-# INLINE prefetchWrite #-}-prefetchRead :: IntArray s -> Int -> ST s ()-prefetchWrite :: IntArray s -> Int -> ST s ()--#ifndef NO_C_SEARCH-foreign import ccall unsafe "lineSearch32"- c_lineSearch32 :: Ptr a -> CInt -> CUInt -> IO CInt--foreign import ccall unsafe "lineSearch64"- c_lineSearch64 :: Ptr a -> CInt -> CULong -> IO CInt--foreign import ccall unsafe "lineSearch32_2"- c_lineSearch32_2 :: Ptr a -> CInt -> CUInt -> CUInt -> IO CInt--foreign import ccall unsafe "lineSearch64_2"- c_lineSearch64_2 :: Ptr a -> CInt -> CULong -> CULong -> IO CInt--foreign import ccall unsafe "lineSearch32_3"- c_lineSearch32_3 :: Ptr a -> CInt -> CUInt -> CUInt -> CUInt -> IO CInt--foreign import ccall unsafe "lineSearch64_3"- c_lineSearch64_3 :: Ptr a -> CInt -> CULong -> CULong -> CULong -> IO CInt--foreign import ccall unsafe "forwardSearch32_2"- c_forwardSearch32_2 :: Ptr a -> CInt -> CInt -> CUInt -> CUInt -> IO CInt--foreign import ccall unsafe "forwardSearch32_3"- c_forwardSearch32_3 :: Ptr a -> CInt -> CInt -> CUInt -> CUInt -> CUInt- -> IO CInt--foreign import ccall unsafe "forwardSearch64_2"- c_forwardSearch64_2 :: Ptr a -> CInt -> CInt -> CULong -> CULong -> IO CInt--foreign import ccall unsafe "forwardSearch64_3"- c_forwardSearch64_3 :: Ptr a -> CInt -> CInt -> CULong -> CULong -> CULong- -> IO CInt--foreign import ccall unsafe "prefetchCacheLine32_read"- prefetchCacheLine32_read :: Ptr a -> CInt -> IO ()--foreign import ccall unsafe "prefetchCacheLine64_read"- prefetchCacheLine64_read :: Ptr a -> CInt -> IO ()--foreign import ccall unsafe "prefetchCacheLine32_write"- prefetchCacheLine32_write :: Ptr a -> CInt -> IO ()--foreign import ccall unsafe "prefetchCacheLine64_write"- prefetchCacheLine64_write :: Ptr a -> CInt -> IO ()---fI :: (Num b, Integral a) => a -> b-fI = fromIntegral---prefetchRead a i = unsafeIOToST c- where- v = M.toPtr a- x = fI i- c32 = prefetchCacheLine32_read v x- c64 = prefetchCacheLine64_read v x- c = if wordSize == 32 then c32 else c64---prefetchWrite a i = unsafeIOToST c- where- v = M.toPtr a- x = fI i- c32 = prefetchCacheLine32_write v x- c64 = prefetchCacheLine64_write v x- c = if wordSize == 32 then c32 else c64---{-# INLINE forwardSearch2 #-}-forwardSearch2 :: IntArray s -> Int -> Int -> Int -> Int -> ST s Int-forwardSearch2 !vec !start !end !x1 !x2 =- liftM fromEnum $! unsafeIOToST c- where- c32 = c_forwardSearch32_2 (M.toPtr vec) (fI start) (fI end) (fI x1) (fI x2)- c64 = c_forwardSearch64_2 (M.toPtr vec) (fI start) (fI end) (fI x1) (fI x2)- c = if wordSize == 32 then c32 else c64---{-# INLINE forwardSearch3 #-}-forwardSearch3 :: IntArray s -> Int -> Int -> Int -> Int -> Int -> ST s Int-forwardSearch3 !vec !start !end !x1 !x2 !x3 =- liftM fromEnum $! unsafeIOToST c- where- c32 = c_forwardSearch32_3 (M.toPtr vec) (fI start) (fI end)- (fI x1) (fI x2) (fI x3)- c64 = c_forwardSearch64_3 (M.toPtr vec) (fI start) (fI end)- (fI x1) (fI x2) (fI x3)- c = if wordSize == 32 then c32 else c64---{-# INLINE lineSearch #-}-lineSearch :: IntArray s -> Int -> Int -> ST s Int-lineSearch !vec !start !value =- liftM fromEnum $! unsafeIOToST c- where- c32 = c_lineSearch32 (M.toPtr vec) (fI start) (fI value)- c64 = c_lineSearch64 (M.toPtr vec) (fI start) (fI value)- c = if wordSize == 32 then c32 else c64--{-# INLINE lineSearch2 #-}-lineSearch2 :: IntArray s -> Int -> Int -> Int -> ST s Int-lineSearch2 !vec !start !x1 !x2 =- liftM fromEnum $! unsafeIOToST c- where- c32 = c_lineSearch32_2 (M.toPtr vec) (fI start) (fI x1) (fI x2)- c64 = c_lineSearch64_2 (M.toPtr vec) (fI start) (fI x1) (fI x2)- c = if wordSize == 32 then c32 else c64--{-# INLINE lineSearch3 #-}-lineSearch3 :: IntArray s -> Int -> Int -> Int -> Int -> ST s Int-lineSearch3 !vec !start !x1 !x2 !x3 =- liftM fromEnum $! unsafeIOToST c- where- c32 = c_lineSearch32_3 (M.toPtr vec) (fI start) (fI x1) (fI x2) (fI x3)- c64 = c_lineSearch64_3 (M.toPtr vec) (fI start) (fI x1) (fI x2) (fI x3)- c = if wordSize == 32 then c32 else c64-#endif--{-# INLINE advanceByCacheLineSize #-}-advanceByCacheLineSize :: Int -> Int -> Int-advanceByCacheLineSize !(I# start0#) !(I# vecSize#) = out- where- !(I# clm#) = cacheLineIntMask- !clmm# = not# (int2Word# clm#)- !start# = word2Int# (clmm# `and#` int2Word# start0#)- !(I# nw#) = numWordsInCacheLine- !start'# = start# +# nw#- !s# = sign# (vecSize# -# start'# -# 1#)- !m# = not# (int2Word# s#)- !r# = int2Word# start'# `and#` m#- !out = I# (word2Int# r#)---{-# INLINE isCacheLineAligned #-}-isCacheLineAligned :: Int -> Bool-isCacheLineAligned (I# x#) = isTrue# (r# ==# 0#)- where- !(I# m#) = cacheLineIntMask- !mw# = int2Word# m#- !w# = int2Word# x#- !r# = word2Int# (mw# `and#` w#)---{-# INLINE sign# #-}--- | Returns 0 if x is positive, -1 otherwise-sign# :: Int# -> Int#-sign# !x# = x# `uncheckedIShiftRA#` wordSizeMinus1#- where- !(I# wordSizeMinus1#) = wordSize-1---{-# INLINE bl_abs# #-}--- | Abs of an integer, branchless-bl_abs# :: Int# -> Int#-bl_abs# !x# = word2Int# r#- where- !m# = sign# x#- !r# = (int2Word# (m# +# x#)) `xor#` int2Word# m#---{-# INLINE mask# #-}--- | Returns 0xfff..fff (aka -1) if a# == b#, 0 otherwise.-mask# :: Int# -> Int# -> Int#-mask# !a# !b# = dest#- where- !d# = a# -# b#- !r# = bl_abs# d# -# 1#- !dest# = sign# r#---{- note: this code should be:--mask# :: Int# -> Int# -> Int#-mask# !a# !b# = let !(I# z#) = fromEnum (a# ==# b#)- !q# = negateInt# z#- in q#--but GHC doesn't properly optimize this as straight-line code at the moment.---}---{-# INLINE maskw# #-}-maskw# :: Int# -> Int# -> Word#-maskw# !a# !b# = int2Word# (mask# a# b#)---#ifdef NO_C_SEARCH-prefetchRead _ _ = return ()-prefetchWrite _ _ = return ()--{-# INLINE forwardSearch2 #-}-forwardSearch2 :: IntArray s -> Int -> Int -> Int -> Int -> ST s Int-forwardSearch2 !vec !start !end !x1 !x2 = go start end False- where- next !i !e !b = let !j = i+1- in if j == e- then (if b then (-1,e,True) else (0,start,True))- else (j,e,b)-- go !i !e !b = do- h <- M.readArray vec i- if h == x1 || h == x2- then return i- else do- let (!i',!e',!b') = next i e b- if (i' < 0) then return (-1) else go i' e' b'---{-# INLINE forwardSearch3 #-}-forwardSearch3 :: IntArray s -> Int -> Int -> Int -> Int -> Int -> ST s Int-forwardSearch3 !vec !start !end !x1 !x2 !x3 = go start end False- where- next !i !e !b = let !j = i+1- in if j == e- then (if b then (-1,e,True) else (0,start,True))- else (j,e,b)-- go !i !e !b = do- h <- M.readArray vec i- if h == x1 || h == x2 || h == x3- then return i- else do- let (!i',!e',!b') = next i e b- if (i' < 0) then return (-1) else go i' e' b'---deBruijnBitPositions :: U.Vector Int8-deBruijnBitPositions =- U.fromList [- 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,- 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9- ]---{-# INLINE firstBitSet# #-}--- only works with 32-bit values -- ok for us here-firstBitSet# :: Int# -> Int#-firstBitSet# i# = word2Int# ((or# zeroCase# posw#))- where- !zeroCase# = int2Word# (mask# 0# i#)- !w# = int2Word# i#- !iLowest# = word2Int# (and# w# (int2Word# (negateInt# i#)))- !idxW# = uncheckedShiftRL#- (narrow32Word# (timesWord# (int2Word# iLowest#)- (int2Word# 0x077CB531#)))- 27#- !idx = I# (word2Int# idxW#)- !(I8# pos8#) = U.unsafeIndex deBruijnBitPositions idx- !posw# = int2Word# pos8#--#endif------------------------------------------------------------------------------------ | Search through a mutable vector for a given int value, cache-line aligned.--- If the start index is cache-line aligned, and there is more than a--- cache-line's room between the start index and the end of the vector, we will--- search the cache-line all at once using an efficient branchless--- bit-twiddling technique. Otherwise, we will use a typical loop.----cacheLineSearch :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-cacheLineSearch !vec !start !value = do-#ifdef NO_C_SEARCH- let !vlen = M.length vec- let !st1 = vlen - start- let !nvlen = numWordsInCacheLine - st1- let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask- let st2 = adv - start--- if nvlen > 0 || not (isCacheLineAligned start)- then naiveSearch vec start (min st1 st2) value- else lineSearch vec start value-#else- lineSearch vec start value-#endif-{-# INLINE cacheLineSearch #-}---#ifdef NO_C_SEARCH--- | Search through a mutable vector for a given int value. The number of--- things to search for must be at most the number of things remaining in the--- vector.-naiveSearch :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ number of things to search- -> Int -- ^ value to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-naiveSearch !vec !start !nThings !value = go start- where- !doneIdx = start + nThings-- go !i | i >= doneIdx = return (-1)- | otherwise = do- x <- M.readArray vec i- if x == value then return i else go (i+1)-{-# INLINE naiveSearch #-}---lineResult# :: Word# -- ^ mask- -> Int -- ^ start value- -> Int-lineResult# bitmask# (I# start#) = I# (word2Int# rv#)- where- !p# = firstBitSet# (word2Int# bitmask#)- !mm# = maskw# p# (-1#)- !nmm# = not# mm#- !rv# = mm# `or#` (nmm# `and#` (int2Word# (start# +# p#)))-{-# INLINE lineResult# #-}---lineSearch :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch | wordSize == 32 = lineSearch32- | otherwise = lineSearch64-{-# INLINE lineSearch #-}---lineSearch64 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch64 !vec !start !(I# v#) = do- (I# x1#) <- M.readArray vec $! start + 0- let !p1# = maskw# x1# v# `and#` int2Word# 0x1#-- (I# x2#) <- M.readArray vec $! start + 1- let !p2# = p1# `or#` (maskw# x2# v# `and#` int2Word# 0x2#)-- (I# x3#) <- M.readArray vec $! start + 2- let !p3# = p2# `or#` (maskw# x3# v# `and#` int2Word# 0x4#)-- (I# x4#) <- M.readArray vec $! start + 3- let !p4# = p3# `or#` (maskw# x4# v# `and#` int2Word# 0x8#)-- (I# x5#) <- M.readArray vec $! start + 4- let !p5# = p4# `or#` (maskw# x5# v# `and#` int2Word# 0x10#)-- (I# x6#) <- M.readArray vec $! start + 5- let !p6# = p5# `or#` (maskw# x6# v# `and#` int2Word# 0x20#)-- (I# x7#) <- M.readArray vec $! start + 6- let !p7# = p6# `or#` (maskw# x7# v# `and#` int2Word# 0x40#)-- (I# x8#) <- M.readArray vec $! start + 7- let !p8# = p7# `or#` (maskw# x8# v# `and#` int2Word# 0x80#)-- return $! lineResult# p8# start-{-# INLINE lineSearch64 #-}----lineSearch32 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch32 !vec !start !(I# v#) = do- (I# x1#) <- M.readArray vec $! start + 0- let !p1# = maskw# x1# v# `and#` int2Word# 0x1#-- (I# x2#) <- M.readArray vec $! start + 1- let !p2# = p1# `or#` (maskw# x2# v# `and#` int2Word# 0x2#)-- (I# x3#) <- M.readArray vec $! start + 2- let !p3# = p2# `or#` (maskw# x3# v# `and#` int2Word# 0x4#)-- (I# x4#) <- M.readArray vec $! start + 3- let !p4# = p3# `or#` (maskw# x4# v# `and#` int2Word# 0x8#)-- (I# x5#) <- M.readArray vec $! start + 4- let !p5# = p4# `or#` (maskw# x5# v# `and#` int2Word# 0x10#)-- (I# x6#) <- M.readArray vec $! start + 5- let !p6# = p5# `or#` (maskw# x6# v# `and#` int2Word# 0x20#)-- (I# x7#) <- M.readArray vec $! start + 6- let !p7# = p6# `or#` (maskw# x7# v# `and#` int2Word# 0x40#)-- (I# x8#) <- M.readArray vec $! start + 7- let !p8# = p7# `or#` (maskw# x8# v# `and#` int2Word# 0x80#)-- (I# x9#) <- M.readArray vec $! start + 8- let !p9# = p8# `or#` (maskw# x9# v# `and#` int2Word# 0x100#)-- (I# x10#) <- M.readArray vec $! start + 9- let !p10# = p9# `or#` (maskw# x10# v# `and#` int2Word# 0x200#)-- (I# x11#) <- M.readArray vec $! start + 10- let !p11# = p10# `or#` (maskw# x11# v# `and#` int2Word# 0x400#)-- (I# x12#) <- M.readArray vec $! start + 11- let !p12# = p11# `or#` (maskw# x12# v# `and#` int2Word# 0x800#)-- (I# x13#) <- M.readArray vec $! start + 12- let !p13# = p12# `or#` (maskw# x13# v# `and#` int2Word# 0x1000#)-- (I# x14#) <- M.readArray vec $! start + 13- let !p14# = p13# `or#` (maskw# x14# v# `and#` int2Word# 0x2000#)-- (I# x15#) <- M.readArray vec $! start + 14- let !p15# = p14# `or#` (maskw# x15# v# `and#` int2Word# 0x4000#)-- (I# x16#) <- M.readArray vec $! start + 15- let !p16# = p15# `or#` (maskw# x16# v# `and#` int2Word# 0x8000#)-- return $! lineResult# p16# start-{-# INLINE lineSearch32 #-}--#endif----------------------------------------------------------------------------------- | Search through a mutable vector for one of two given int values,--- cache-line aligned. If the start index is cache-line aligned, and there is--- more than a cache-line's room between the start index and the end of the--- vector, we will search the cache-line all at once using an efficient--- branchless bit-twiddling technique. Otherwise, we will use a typical loop.----cacheLineSearch2 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-cacheLineSearch2 !vec !start !value !value2 = do-#ifdef NO_C_SEARCH- let !vlen = M.length vec- let !st1 = vlen - start- let !nvlen = numWordsInCacheLine - st1- let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask- let st2 = adv - start-- if nvlen > 0 || not (isCacheLineAligned start)- then naiveSearch2 vec start (min st1 st2) value value2- else lineSearch2 vec start value value2-#else- lineSearch2 vec start value value2-#endif-{-# INLINE cacheLineSearch2 #-}---#ifdef NO_C_SEARCH--naiveSearch2 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ number of things to search- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-naiveSearch2 !vec !start !nThings !value1 !value2 = go start- where- !doneIdx = start + nThings-- go !i | i >= doneIdx = return (-1)- | otherwise = do- x <- M.readArray vec i- if x == value1 || x == value2 then return i else go (i+1)-{-# INLINE naiveSearch2 #-}---lineSearch2 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch2 | wordSize == 32 = lineSearch32_2- | otherwise = lineSearch64_2----lineSearch64_2 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch64_2 !vec !start !(I# v#) !(I# v2#) = do- (I# x1#) <- M.readArray vec $! start + 0- let !p1# = (maskw# x1# v# `or#` maskw# x1# v2#) `and#` int2Word# 0x1#-- (I# x2#) <- M.readArray vec $! start + 1- let !p2# = p1# `or#` ((maskw# x2# v# `or#` maskw# x2# v2#)- `and#` int2Word# 0x2#)-- (I# x3#) <- M.readArray vec $! start + 2- let !p3# = p2# `or#` ((maskw# x3# v# `or#` maskw# x3# v2#)- `and#` int2Word# 0x4#)-- (I# x4#) <- M.readArray vec $! start + 3- let !p4# = p3# `or#` ((maskw# x4# v# `or#` maskw# x4# v2#)- `and#` int2Word# 0x8#)-- (I# x5#) <- M.readArray vec $! start + 4- let !p5# = p4# `or#` ((maskw# x5# v# `or#` maskw# x5# v2#)- `and#` int2Word# 0x10#)-- (I# x6#) <- M.readArray vec $! start + 5- let !p6# = p5# `or#` ((maskw# x6# v# `or#` maskw# x6# v2#)- `and#` int2Word# 0x20#)-- (I# x7#) <- M.readArray vec $! start + 6- let !p7# = p6# `or#` ((maskw# x7# v# `or#` maskw# x7# v2#)- `and#` int2Word# 0x40#)-- (I# x8#) <- M.readArray vec $! start + 7- let !p8# = p7# `or#` ((maskw# x8# v# `or#` maskw# x8# v2#)- `and#` int2Word# 0x80#)-- return $! lineResult# p8# start-{-# INLINE lineSearch64_2 #-}---lineSearch32_2 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch32_2 !vec !start !(I# v#) !(I# v2#) = do- (I# x1#) <- M.readArray vec $! start + 0- let !p1# = (maskw# x1# v# `or#` maskw# x1# v2#) `and#` int2Word# 0x1#-- (I# x2#) <- M.readArray vec $! start + 1- let !p2# = p1# `or#` ((maskw# x2# v# `or#` maskw# x2# v2#)- `and#` int2Word# 0x2#)-- (I# x3#) <- M.readArray vec $! start + 2- let !p3# = p2# `or#` ((maskw# x3# v# `or#` maskw# x3# v2#)- `and#` int2Word# 0x4#)-- (I# x4#) <- M.readArray vec $! start + 3- let !p4# = p3# `or#` ((maskw# x4# v# `or#` maskw# x4# v2#)- `and#` int2Word# 0x8#)-- (I# x5#) <- M.readArray vec $! start + 4- let !p5# = p4# `or#` ((maskw# x5# v# `or#` maskw# x5# v2#)- `and#` int2Word# 0x10#)-- (I# x6#) <- M.readArray vec $! start + 5- let !p6# = p5# `or#` ((maskw# x6# v# `or#` maskw# x6# v2#)- `and#` int2Word# 0x20#)-- (I# x7#) <- M.readArray vec $! start + 6- let !p7# = p6# `or#` ((maskw# x7# v# `or#` maskw# x7# v2#)- `and#` int2Word# 0x40#)-- (I# x8#) <- M.readArray vec $! start + 7- let !p8# = p7# `or#` ((maskw# x8# v# `or#` maskw# x8# v2#)- `and#` int2Word# 0x80#)-- (I# x9#) <- M.readArray vec $! start + 8- let !p9# = p8# `or#` ((maskw# x9# v# `or#` maskw# x9# v2#)- `and#` int2Word# 0x100#)-- (I# x10#) <- M.readArray vec $! start + 9- let !p10# = p9# `or#` ((maskw# x10# v# `or#` maskw# x10# v2#)- `and#` int2Word# 0x200#)-- (I# x11#) <- M.readArray vec $! start + 10- let !p11# = p10# `or#` ((maskw# x11# v# `or#` maskw# x11# v2#)- `and#` int2Word# 0x400#)-- (I# x12#) <- M.readArray vec $! start + 11- let !p12# = p11# `or#` ((maskw# x12# v# `or#` maskw# x12# v2#)- `and#` int2Word# 0x800#)-- (I# x13#) <- M.readArray vec $! start + 12- let !p13# = p12# `or#` ((maskw# x13# v# `or#` maskw# x13# v2#)- `and#` int2Word# 0x1000#)-- (I# x14#) <- M.readArray vec $! start + 13- let !p14# = p13# `or#` ((maskw# x14# v# `or#` maskw# x14# v2#)- `and#` int2Word# 0x2000#)-- (I# x15#) <- M.readArray vec $! start + 14- let !p15# = p14# `or#` ((maskw# x15# v# `or#` maskw# x15# v2#)- `and#` int2Word# 0x4000#)-- (I# x16#) <- M.readArray vec $! start + 15- let !p16# = p15# `or#` ((maskw# x16# v# `or#` maskw# x16# v2#)- `and#` int2Word# 0x8000#)-- return $! lineResult# p16# start-{-# INLINE lineSearch32_2 #-}--#endif------------------------------------------------------------------------------------ | Search through a mutable vector for one of three given int values,--- cache-line aligned. If the start index is cache-line aligned, and there is--- more than a cache-line's room between the start index and the end of the--- vector, we will search the cache-line all at once using an efficient--- branchless bit-twiddling technique. Otherwise, we will use a typical loop.----cacheLineSearch3 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> Int -- ^ value 3 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-cacheLineSearch3 !vec !start !value !value2 !value3 = do-#ifdef NO_C_SEARCH- let !vlen = M.length vec- let !st1 = vlen - start- let !nvlen = numWordsInCacheLine - st1- let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask- let st2 = adv - start-- if nvlen > 0 || not (isCacheLineAligned start)- then naiveSearch3 vec start (min st1 st2) value value2 value3- else lineSearch3 vec start value value2 value3-#else- lineSearch3 vec start value value2 value3-#endif-{-# INLINE cacheLineSearch3 #-}---#ifdef NO_C_SEARCH--naiveSearch3 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ number of things to search- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> Int -- ^ value 3 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-naiveSearch3 !vec !start !nThings !value1 !value2 !value3 = go start- where- !doneIdx = start + nThings-- go !i | i >= doneIdx = return (-1)- | otherwise = do- x <- M.readArray vec i- if x == value1 || x == value2 || x == value3- then return i- else go (i+1)-{-# INLINE naiveSearch3 #-}---lineSearch3 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> Int -- ^ value 3 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch3 | wordSize == 32 = lineSearch32_3- | otherwise = lineSearch64_3----lineSearch64_3 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> Int -- ^ value 3 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch64_3 !vec !start !(I# v#) !(I# v2#) !(I# v3#) = do- (I# x1#) <- M.readArray vec $! start + 0- let !p1# = (maskw# x1# v# `or#` maskw# x1# v2# `or#` maskw# x1# v3#)- `and#` int2Word# 0x1#-- (I# x2#) <- M.readArray vec $! start + 1- let !p2# = p1# `or#`- ((maskw# x2# v# `or#` maskw# x2# v2# `or#` maskw# x2# v3#)- `and#` int2Word# 0x2#)-- (I# x3#) <- M.readArray vec $! start + 2- let !p3# = p2# `or#`- ((maskw# x3# v# `or#` maskw# x3# v2# `or#` maskw# x3# v3#)- `and#` int2Word# 0x4#)-- (I# x4#) <- M.readArray vec $! start + 3- let !p4# = p3# `or#`- ((maskw# x4# v# `or#` maskw# x4# v2# `or#` maskw# x4# v3#)- `and#` int2Word# 0x8#)-- (I# x5#) <- M.readArray vec $! start + 4- let !p5# = p4# `or#`- ((maskw# x5# v# `or#` maskw# x5# v2# `or#` maskw# x5# v3#)- `and#` int2Word# 0x10#)-- (I# x6#) <- M.readArray vec $! start + 5- let !p6# = p5# `or#`- ((maskw# x6# v# `or#` maskw# x6# v2# `or#` maskw# x6# v3#)- `and#` int2Word# 0x20#)-- (I# x7#) <- M.readArray vec $! start + 6- let !p7# = p6# `or#`- ((maskw# x7# v# `or#` maskw# x7# v2# `or#` maskw# x7# v3#)- `and#` int2Word# 0x40#)-- (I# x8#) <- M.readArray vec $! start + 7- let !p8# = p7# `or#`- ((maskw# x8# v# `or#` maskw# x8# v2# `or#` maskw# x8# v3#)- `and#` int2Word# 0x80#)-- return $! lineResult# p8# start-{-# INLINE lineSearch64_3 #-}---lineSearch32_3 :: IntArray s -- ^ vector to search- -> Int -- ^ start index- -> Int -- ^ value to search for- -> Int -- ^ value 2 to search for- -> Int -- ^ value 3 to search for- -> ST s Int -- ^ dest index where it can be found, or- -- \"-1\" if not found-lineSearch32_3 !vec !start !(I# v#) !(I# v2#) !(I# v3#) = do- (I# x1#) <- M.readArray vec $! start + 0- let !p1# = (maskw# x1# v# `or#` maskw# x1# v2# `or#` maskw# x1# v3#)- `and#` int2Word# 0x1#-- (I# x2#) <- M.readArray vec $! start + 1- let !p2# = p1# `or#`- ((maskw# x2# v# `or#` maskw# x2# v2# `or#` maskw# x2# v3#)- `and#` int2Word# 0x2#)-- (I# x3#) <- M.readArray vec $! start + 2- let !p3# = p2# `or#`- ((maskw# x3# v# `or#` maskw# x3# v2# `or#` maskw# x3# v3#)- `and#` int2Word# 0x4#)-- (I# x4#) <- M.readArray vec $! start + 3- let !p4# = p3# `or#`- ((maskw# x4# v# `or#` maskw# x4# v2# `or#` maskw# x4# v3#)- `and#` int2Word# 0x8#)-- (I# x5#) <- M.readArray vec $! start + 4- let !p5# = p4# `or#`- ((maskw# x5# v# `or#` maskw# x5# v2# `or#` maskw# x5# v3#)- `and#` int2Word# 0x10#)-- (I# x6#) <- M.readArray vec $! start + 5- let !p6# = p5# `or#`- ((maskw# x6# v# `or#` maskw# x6# v2# `or#` maskw# x6# v3#)- `and#` int2Word# 0x20#)-- (I# x7#) <- M.readArray vec $! start + 6- let !p7# = p6# `or#`- ((maskw# x7# v# `or#` maskw# x7# v2# `or#` maskw# x7# v3#)- `and#` int2Word# 0x40#)-- (I# x8#) <- M.readArray vec $! start + 7- let !p8# = p7# `or#`- ((maskw# x8# v# `or#` maskw# x8# v2# `or#` maskw# x8# v3#)- `and#` int2Word# 0x80#)-- (I# x9#) <- M.readArray vec $! start + 8- let !p9# = p8# `or#`- ((maskw# x9# v# `or#` maskw# x9# v2# `or#` maskw# x9# v3#)- `and#` int2Word# 0x100#)-- (I# x10#) <- M.readArray vec $! start + 9- let !p10# = p9# `or#`- ((maskw# x10# v# `or#` maskw# x10# v2# `or#` maskw# x10# v3#)- `and#` int2Word# 0x200#)-- (I# x11#) <- M.readArray vec $! start + 10- let !p11# = p10# `or#`- ((maskw# x11# v# `or#` maskw# x11# v2# `or#` maskw# x11# v3#)- `and#` int2Word# 0x400#)-- (I# x12#) <- M.readArray vec $! start + 11- let !p12# = p11# `or#`- ((maskw# x12# v# `or#` maskw# x12# v2# `or#` maskw# x12# v3#)- `and#` int2Word# 0x800#)-- (I# x13#) <- M.readArray vec $! start + 12- let !p13# = p12# `or#`- ((maskw# x13# v# `or#` maskw# x13# v2# `or#` maskw# x13# v3#)- `and#` int2Word# 0x1000#)-- (I# x14#) <- M.readArray vec $! start + 13- let !p14# = p13# `or#`- ((maskw# x14# v# `or#` maskw# x14# v2# `or#` maskw# x14# v3#)- `and#` int2Word# 0x2000#)-- (I# x15#) <- M.readArray vec $! start + 14- let !p15# = p14# `or#`- ((maskw# x15# v# `or#` maskw# x15# v2# `or#` maskw# x15# v3#)- `and#` int2Word# 0x4000#)-- (I# x16#) <- M.readArray vec $! start + 15- let !p16# = p15# `or#`- ((maskw# x16# v# `or#` maskw# x16# v2# `or#` maskw# x16# v3#)- `and#` int2Word# 0x8000#)-- return $! lineResult# p16# start-{-# INLINE lineSearch32_3 #-}--#endif+import Control.Monad+#if MIN_VERSION_base(4,4,0)+import Control.Monad.ST (ST)+import Control.Monad.ST.Unsafe+#else+import Control.Monad.ST+#endif++import Data.HashTable.Internal.IntArray (Elem, IntArray)+import qualified Data.HashTable.Internal.IntArray as M++#ifndef NO_C_SEARCH+import Foreign.C.Types+#else+import Data.Bits+import Data.Int+import qualified Data.Vector.Unboxed as U+import GHC.Int+#endif++import Data.HashTable.Internal.Utils+import GHC.Exts++#if __GLASGOW_HASKELL__ >= 707+import GHC.Exts (isTrue#)+#else+isTrue# :: Bool -> Bool+isTrue# = id+#endif++{-# INLINE prefetchRead #-}+{-# INLINE prefetchWrite #-}+prefetchRead :: IntArray s -> Int -> ST s ()+prefetchWrite :: IntArray s -> Int -> ST s ()++#ifndef NO_C_SEARCH+foreign import ccall unsafe "line_search"+ c_lineSearch :: Ptr a -> CInt -> CUShort -> IO CInt++foreign import ccall unsafe "line_search_2"+ c_lineSearch_2 :: Ptr a -> CInt -> CUShort -> CUShort -> IO CInt++foreign import ccall unsafe "line_search_2"+ c_lineSearch_3 :: Ptr a -> CInt -> CUShort -> CUShort -> CUShort -> IO CInt++foreign import ccall unsafe "forward_search_2"+ c_forwardSearch_2 :: Ptr a -> CInt -> CInt -> CUShort -> CUShort -> IO CInt++foreign import ccall unsafe "forward_search_3"+ c_forwardSearch_3 :: Ptr a -> CInt -> CInt -> CUShort -> CUShort -> CUShort+ -> IO CInt++foreign import ccall unsafe "prefetch_cacheline_read"+ prefetchCacheLine_read :: Ptr a -> CInt -> IO ()++foreign import ccall unsafe "prefetch_cacheline_write"+ prefetchCacheLine_write :: Ptr a -> CInt -> IO ()+++fI :: (Num b, Integral a) => a -> b+fI = fromIntegral++prefetchRead a i = unsafeIOToST $ prefetchCacheLine_read v x+ where+ v = M.toPtr a+ x = fI i++prefetchWrite a i = unsafeIOToST $ prefetchCacheLine_write v x+ where+ v = M.toPtr a+ x = fI i+++{-# INLINE forwardSearch2 #-}+forwardSearch2 :: IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int+forwardSearch2 !vec !start !end !x1 !x2 =+ liftM fromEnum $! unsafeIOToST c+ where+ c = c_forwardSearch_2 (M.toPtr vec) (fI start) (fI end) (fI x1) (fI x2)+++{-# INLINE forwardSearch3 #-}+forwardSearch3 :: IntArray s -> Int -> Int -> Elem -> Elem -> Elem -> ST s Int+forwardSearch3 !vec !start !end !x1 !x2 !x3 =+ liftM fromEnum $! unsafeIOToST c+ where+ c = c_forwardSearch_3 (M.toPtr vec) (fI start) (fI end)+ (fI x1) (fI x2) (fI x3)+++{-# INLINE lineSearch #-}+lineSearch :: IntArray s -> Int -> Elem -> ST s Int+lineSearch !vec !start !value =+ liftM fromEnum $! unsafeIOToST c+ where+ c = c_lineSearch (M.toPtr vec) (fI start) (fI value)+++{-# INLINE lineSearch2 #-}+lineSearch2 :: IntArray s -> Int -> Elem -> Elem -> ST s Int+lineSearch2 !vec !start !x1 !x2 =+ liftM fromEnum $! unsafeIOToST c+ where+ c = c_lineSearch_2 (M.toPtr vec) (fI start) (fI x1) (fI x2)+++{-# INLINE lineSearch3 #-}+lineSearch3 :: IntArray s -> Int -> Elem -> Elem -> Elem -> ST s Int+lineSearch3 !vec !start !x1 !x2 !x3 =+ liftM fromEnum $! unsafeIOToST c+ where+ c = c_lineSearch_3 (M.toPtr vec) (fI start) (fI x1) (fI x2) (fI x3)+#endif++{-# INLINE advanceByCacheLineSize #-}+advanceByCacheLineSize :: Int -> Int -> Int+advanceByCacheLineSize !(I# start0#) !(I# vecSize#) = out+ where+ !(I# clm#) = cacheLineIntMask+ !clmm# = not# (int2Word# clm#)+ !start# = word2Int# (clmm# `and#` int2Word# start0#)+ !(I# nw#) = numElemsInCacheLine+ !start'# = start# +# nw#+ !s# = sign# (vecSize# -# start'# -# 1#)+ !m# = not# (int2Word# s#)+ !r# = int2Word# start'# `and#` m#+ !out = I# (word2Int# r#)+++{-# INLINE isCacheLineAligned #-}+isCacheLineAligned :: Int -> Bool+isCacheLineAligned (I# x#) = isTrue# (r# ==# 0#)+ where+ !(I# m#) = cacheLineIntMask+ !mw# = int2Word# m#+ !w# = int2Word# x#+ !r# = word2Int# (mw# `and#` w#)+++{-# INLINE sign# #-}+-- | Returns 0 if x is positive, -1 otherwise+sign# :: Int# -> Int#+sign# !x# = x# `uncheckedIShiftRA#` wordSizeMinus1#+ where+ !(I# wordSizeMinus1#) = wordSize-1+++{-# INLINE bl_abs# #-}+-- | Abs of an integer, branchless+bl_abs# :: Int# -> Int#+bl_abs# !x# = word2Int# r#+ where+ !m# = sign# x#+ !r# = (int2Word# (m# +# x#)) `xor#` int2Word# m#+++{-# INLINE mask# #-}+-- | Returns 0xfff..fff (aka -1) if a# == b#, 0 otherwise.+mask# :: Int# -> Int# -> Int#+mask# !a# !b# = dest#+ where+ !d# = a# -# b#+ !r# = bl_abs# d# -# 1#+ !dest# = sign# r#+++{- note: this code should be:++mask# :: Int# -> Int# -> Int#+mask# !a# !b# = let !(I# z#) = fromEnum (a# ==# b#)+ !q# = negateInt# z#+ in q#++but GHC doesn't properly optimize this as straight-line code at the moment.++-}+++{-# INLINE maskw# #-}+maskw# :: Int# -> Int# -> Word#+maskw# !a# !b# = int2Word# (mask# a# b#)+++#ifdef NO_C_SEARCH+prefetchRead _ _ = return ()+prefetchWrite _ _ = return ()++{-# INLINE forwardSearch2 #-}+forwardSearch2 :: IntArray s -> Int -> Int -> Elem -> Elem -> ST s Int+forwardSearch2 !vec !start !end !x1 !x2 = go start end False+ where+ go !i !e !b =+ if i >= e then+ if b then return (-1) else go 0 start True+ else do+ h <- M.readArray vec i+ if h == x1 || h == x2+ then return i+ else go (i+1) e b+++{-# INLINE forwardSearch3 #-}+forwardSearch3 :: IntArray s -> Int -> Int -> Elem -> Elem -> Elem -> ST s Int+forwardSearch3 !vec !start !end !x1 !x2 !x3 = go start end False+ where+ go !i !e !b =+ if i >= e then+ if b then return (-1) else go 0 start True+ else do+ h <- M.readArray vec i+ if h == x1 || h == x2 || h == x3+ then return i+ else go (i+1) e b+++deBruijnBitPositions :: U.Vector Int8+deBruijnBitPositions =+ U.fromList [+ 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,+ 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9+ ]+++{-# INLINE firstBitSet# #-}+-- only works with 32-bit values -- ok for us here+firstBitSet# :: Int# -> Int#+firstBitSet# i# = word2Int# ((or# zeroCase# posw#))+ where+ !zeroCase# = int2Word# (mask# 0# i#)+ !w# = int2Word# i#+ !iLowest# = word2Int# (and# w# (int2Word# (negateInt# i#)))+ !idxW# = uncheckedShiftRL#+ (narrow32Word# (timesWord# (int2Word# iLowest#)+ (int2Word# 0x077CB531#)))+ 27#+ !idx = I# (word2Int# idxW#)+ !(I8# pos8#) = U.unsafeIndex deBruijnBitPositions idx+ !posw# = int2Word# pos8#++#endif+++#ifdef NO_C_SEARCH+lineResult# :: Word# -- ^ mask+ -> Int -- ^ start value+ -> Int+lineResult# bitmask# (I# start#) = I# (word2Int# rv#)+ where+ !p# = firstBitSet# (word2Int# bitmask#)+ !mm# = maskw# p# (-1#)+ !nmm# = not# mm#+ !rv# = mm# `or#` (nmm# `and#` (int2Word# (start# +# p#)))+{-# INLINE lineResult# #-}+++-- Required: unlike in C search, required that the start index is+-- cache-line-aligned and array has at least 32 elements after the start index+lineSearch :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Elem -- ^ value to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+lineSearch !vec !start !elem1 = do+ let !(I# v1#) = fromIntegral elem1++ !(I# x1#) <- liftM fromIntegral $ M.readArray vec start+ let !p1# = (and# (maskw# x1# v1#) (int2Word# 0x1#))++ !(I# x2#) <- liftM fromIntegral $ M.readArray vec $! start + 1+ let !p2# = or# p1# (and# (maskw# x2# v1#) (int2Word# 0x2#))++ !(I# x3#) <- liftM fromIntegral $ M.readArray vec $! start + 2+ let !p3# = or# p2# (and# (maskw# x3# v1#) (int2Word# 0x4#))++ !(I# x4#) <- liftM fromIntegral $ M.readArray vec $! start + 3+ let !p4# = or# p3# (and# (maskw# x4# v1#) (int2Word# 0x8#))++ !(I# x5#) <- liftM fromIntegral $ M.readArray vec $! start + 4+ let !p5# = or# p4# (and# (maskw# x5# v1#) (int2Word# 0x10#))++ !(I# x6#) <- liftM fromIntegral $ M.readArray vec $! start + 5+ let !p6# = or# p5# (and# (maskw# x6# v1#) (int2Word# 0x20#))++ !(I# x7#) <- liftM fromIntegral $ M.readArray vec $! start + 6+ let !p7# = or# p6# (and# (maskw# x7# v1#) (int2Word# 0x40#))++ !(I# x8#) <- liftM fromIntegral $ M.readArray vec $! start + 7+ let !p8# = or# p7# (and# (maskw# x8# v1#) (int2Word# 0x80#))++ !(I# x9#) <- liftM fromIntegral $ M.readArray vec $! start + 8+ let !p9# = or# p8# (and# (maskw# x9# v1#) (int2Word# 0x100#))++ !(I# x10#) <- liftM fromIntegral $ M.readArray vec $! start + 9+ let !p10# = or# p9# (and# (maskw# x10# v1#) (int2Word# 0x200#))++ !(I# x11#) <- liftM fromIntegral $ M.readArray vec $! start + 10+ let !p11# = or# p10# (and# (maskw# x11# v1#) (int2Word# 0x400#))++ !(I# x12#) <- liftM fromIntegral $ M.readArray vec $! start + 11+ let !p12# = or# p11# (and# (maskw# x12# v1#) (int2Word# 0x800#))++ !(I# x13#) <- liftM fromIntegral $ M.readArray vec $! start + 12+ let !p13# = or# p12# (and# (maskw# x13# v1#) (int2Word# 0x1000#))++ !(I# x14#) <- liftM fromIntegral $ M.readArray vec $! start + 13+ let !p14# = or# p13# (and# (maskw# x14# v1#) (int2Word# 0x2000#))++ !(I# x15#) <- liftM fromIntegral $ M.readArray vec $! start + 14+ let !p15# = or# p14# (and# (maskw# x15# v1#) (int2Word# 0x4000#))++ !(I# x16#) <- liftM fromIntegral $ M.readArray vec $! start + 15+ let !p16# = or# p15# (and# (maskw# x16# v1#) (int2Word# 0x8000#))++ !(I# x17#) <- liftM fromIntegral $ M.readArray vec $! start + 16+ let !p17# = or# p16# (and# (maskw# x17# v1#) (int2Word# 0x10000#))++ !(I# x18#) <- liftM fromIntegral $ M.readArray vec $! start + 17+ let !p18# = or# p17# (and# (maskw# x18# v1#) (int2Word# 0x20000#))++ !(I# x19#) <- liftM fromIntegral $ M.readArray vec $! start + 18+ let !p19# = or# p18# (and# (maskw# x19# v1#) (int2Word# 0x40000#))++ !(I# x20#) <- liftM fromIntegral $ M.readArray vec $! start + 19+ let !p20# = or# p19# (and# (maskw# x20# v1#) (int2Word# 0x80000#))++ !(I# x21#) <- liftM fromIntegral $ M.readArray vec $! start + 20+ let !p21# = or# p20# (and# (maskw# x21# v1#) (int2Word# 0x100000#))++ !(I# x22#) <- liftM fromIntegral $ M.readArray vec $! start + 21+ let !p22# = or# p21# (and# (maskw# x22# v1#) (int2Word# 0x200000#))++ !(I# x23#) <- liftM fromIntegral $ M.readArray vec $! start + 22+ let !p23# = or# p22# (and# (maskw# x23# v1#) (int2Word# 0x400000#))++ !(I# x24#) <- liftM fromIntegral $ M.readArray vec $! start + 23+ let !p24# = or# p23# (and# (maskw# x24# v1#) (int2Word# 0x800000#))++ !(I# x25#) <- liftM fromIntegral $ M.readArray vec $! start + 24+ let !p25# = or# p24# (and# (maskw# x25# v1#) (int2Word# 0x1000000#))++ !(I# x26#) <- liftM fromIntegral $ M.readArray vec $! start + 25+ let !p26# = or# p25# (and# (maskw# x26# v1#) (int2Word# 0x2000000#))++ !(I# x27#) <- liftM fromIntegral $ M.readArray vec $! start + 26+ let !p27# = or# p26# (and# (maskw# x27# v1#) (int2Word# 0x4000000#))++ !(I# x28#) <- liftM fromIntegral $ M.readArray vec $! start + 27+ let !p28# = or# p27# (and# (maskw# x28# v1#) (int2Word# 0x8000000#))++ !(I# x29#) <- liftM fromIntegral $ M.readArray vec $! start + 28+ let !p29# = or# p28# (and# (maskw# x29# v1#) (int2Word# 0x10000000#))++ !(I# x30#) <- liftM fromIntegral $ M.readArray vec $! start + 29+ let !p30# = or# p29# (and# (maskw# x30# v1#) (int2Word# 0x20000000#))++ !(I# x31#) <- liftM fromIntegral $ M.readArray vec $! start + 30+ let !p31# = or# p30# (and# (maskw# x31# v1#) (int2Word# 0x40000000#))++ !(I# x32#) <- liftM fromIntegral $ M.readArray vec $! start + 31+ let !p32# = or# p31# (and# (maskw# x32# v1#) (int2Word# 0x80000000#))++ return $! lineResult# p32# start+++-- Required: unlike in C search, required that the start index is+-- cache-line-aligned and array has at least 32 elements after the start index+lineSearch2 :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Elem -- ^ value to search for+ -> Elem -- ^ second value to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+lineSearch2 !vec !start !elem1 !elem2 = do+ let !(I# v1#) = fromIntegral elem1+ let !(I# v2#) = fromIntegral elem2++ !(I# x1#) <- liftM fromIntegral $ M.readArray vec start+ let !p1# = (and# (int2Word# 0x1#)+ (or# (maskw# x1# v1#) (maskw# x1# v2#)))+ !(I# x2#) <- liftM fromIntegral $ M.readArray vec $! start + 1+ let !p2# = or# p1# (and# (int2Word# 0x2#)+ (or# (maskw# x2# v1#) (maskw# x2# v2#)))+ !(I# x3#) <- liftM fromIntegral $ M.readArray vec $! start + 2+ let !p3# = or# p2# (and# (int2Word# 0x4#)+ (or# (maskw# x3# v1#) (maskw# x3# v2#)))+ !(I# x4#) <- liftM fromIntegral $ M.readArray vec $! start + 3+ let !p4# = or# p3# (and# (int2Word# 0x8#)+ (or# (maskw# x4# v1#) (maskw# x4# v2#)))+ !(I# x5#) <- liftM fromIntegral $ M.readArray vec $! start + 4+ let !p5# = or# p4# (and# (int2Word# 0x10#)+ (or# (maskw# x5# v1#) (maskw# x5# v2#)))+ !(I# x6#) <- liftM fromIntegral $ M.readArray vec $! start + 5+ let !p6# = or# p5# (and# (int2Word# 0x20#)+ (or# (maskw# x6# v1#) (maskw# x6# v2#)))+ !(I# x7#) <- liftM fromIntegral $ M.readArray vec $! start + 6+ let !p7# = or# p6# (and# (int2Word# 0x40#)+ (or# (maskw# x7# v1#) (maskw# x7# v2#)))+ !(I# x8#) <- liftM fromIntegral $ M.readArray vec $! start + 7+ let !p8# = or# p7# (and# (int2Word# 0x80#)+ (or# (maskw# x8# v1#) (maskw# x8# v2#)))+ !(I# x9#) <- liftM fromIntegral $ M.readArray vec $! start + 8+ let !p9# = or# p8# (and# (int2Word# 0x100#)+ (or# (maskw# x9# v1#) (maskw# x9# v2#)))+ !(I# x10#) <- liftM fromIntegral $ M.readArray vec $! start + 9+ let !p10# = or# p9# (and# (int2Word# 0x200#)+ (or# (maskw# x10# v1#) (maskw# x10# v2#)))+ !(I# x11#) <- liftM fromIntegral $ M.readArray vec $! start + 10+ let !p11# = or# p10# (and# (int2Word# 0x400#)+ (or# (maskw# x11# v1#) (maskw# x11# v2#)))+ !(I# x12#) <- liftM fromIntegral $ M.readArray vec $! start + 11+ let !p12# = or# p11# (and# (int2Word# 0x800#)+ (or# (maskw# x12# v1#) (maskw# x12# v2#)))+ !(I# x13#) <- liftM fromIntegral $ M.readArray vec $! start + 12+ let !p13# = or# p12# (and# (int2Word# 0x1000#)+ (or# (maskw# x13# v1#) (maskw# x13# v2#)))+ !(I# x14#) <- liftM fromIntegral $ M.readArray vec $! start + 13+ let !p14# = or# p13# (and# (int2Word# 0x2000#)+ (or# (maskw# x14# v1#) (maskw# x14# v2#)))+ !(I# x15#) <- liftM fromIntegral $ M.readArray vec $! start + 14+ let !p15# = or# p14# (and# (int2Word# 0x4000#)+ (or# (maskw# x15# v1#) (maskw# x15# v2#)))+ !(I# x16#) <- liftM fromIntegral $ M.readArray vec $! start + 15+ let !p16# = or# p15# (and# (int2Word# 0x8000#)+ (or# (maskw# x16# v1#) (maskw# x16# v2#)))+ !(I# x17#) <- liftM fromIntegral $ M.readArray vec $! start + 16+ let !p17# = or# p16# (and# (int2Word# 0x10000#)+ (or# (maskw# x17# v1#) (maskw# x17# v2#)))+ !(I# x18#) <- liftM fromIntegral $ M.readArray vec $! start + 17+ let !p18# = or# p17# (and# (int2Word# 0x20000#)+ (or# (maskw# x18# v1#) (maskw# x18# v2#)))+ !(I# x19#) <- liftM fromIntegral $ M.readArray vec $! start + 18+ let !p19# = or# p18# (and# (int2Word# 0x40000#)+ (or# (maskw# x19# v1#) (maskw# x19# v2#)))+ !(I# x20#) <- liftM fromIntegral $ M.readArray vec $! start + 19+ let !p20# = or# p19# (and# (int2Word# 0x80000#)+ (or# (maskw# x20# v1#) (maskw# x20# v2#)))+ !(I# x21#) <- liftM fromIntegral $ M.readArray vec $! start + 20+ let !p21# = or# p20# (and# (int2Word# 0x100000#)+ (or# (maskw# x21# v1#) (maskw# x21# v2#)))+ !(I# x22#) <- liftM fromIntegral $ M.readArray vec $! start + 21+ let !p22# = or# p21# (and# (int2Word# 0x200000#)+ (or# (maskw# x22# v1#) (maskw# x22# v2#)))+ !(I# x23#) <- liftM fromIntegral $ M.readArray vec $! start + 22+ let !p23# = or# p22# (and# (int2Word# 0x400000#)+ (or# (maskw# x23# v1#) (maskw# x23# v2#)))+ !(I# x24#) <- liftM fromIntegral $ M.readArray vec $! start + 23+ let !p24# = or# p23# (and# (int2Word# 0x800000#)+ (or# (maskw# x24# v1#) (maskw# x24# v2#)))+ !(I# x25#) <- liftM fromIntegral $ M.readArray vec $! start + 24+ let !p25# = or# p24# (and# (int2Word# 0x1000000#)+ (or# (maskw# x25# v1#) (maskw# x25# v2#)))+ !(I# x26#) <- liftM fromIntegral $ M.readArray vec $! start + 25+ let !p26# = or# p25# (and# (int2Word# 0x2000000#)+ (or# (maskw# x26# v1#) (maskw# x26# v2#)))+ !(I# x27#) <- liftM fromIntegral $ M.readArray vec $! start + 26+ let !p27# = or# p26# (and# (int2Word# 0x4000000#)+ (or# (maskw# x27# v1#) (maskw# x27# v2#)))+ !(I# x28#) <- liftM fromIntegral $ M.readArray vec $! start + 27+ let !p28# = or# p27# (and# (int2Word# 0x8000000#)+ (or# (maskw# x28# v1#) (maskw# x28# v2#)))+ !(I# x29#) <- liftM fromIntegral $ M.readArray vec $! start + 28+ let !p29# = or# p28# (and# (int2Word# 0x10000000#)+ (or# (maskw# x29# v1#) (maskw# x29# v2#)))+ !(I# x30#) <- liftM fromIntegral $ M.readArray vec $! start + 29+ let !p30# = or# p29# (and# (int2Word# 0x20000000#)+ (or# (maskw# x30# v1#) (maskw# x30# v2#)))+ !(I# x31#) <- liftM fromIntegral $ M.readArray vec $! start + 30+ let !p31# = or# p30# (and# (int2Word# 0x40000000#)+ (or# (maskw# x31# v1#) (maskw# x31# v2#)))+ !(I# x32#) <- liftM fromIntegral $ M.readArray vec $! start + 31+ let !p32# = or# p31# (and# (int2Word# 0x80000000#)+ (or# (maskw# x32# v1#) (maskw# x32# v2#)))++ return $! lineResult# p32# start+++-- Required: unlike in C search, required that the start index is+-- cache-line-aligned and array has at least 32 elements after the start index+lineSearch3 :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Elem -- ^ value to search for+ -> Elem -- ^ second value to search for+ -> Elem -- ^ third value to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+lineSearch3 !vec !start !elem1 !elem2 !elem3 = do+ let !(I# v1#) = fromIntegral elem1+ let !(I# v2#) = fromIntegral elem2+ let !(I# v3#) = fromIntegral elem3++ !(I# x1#) <- liftM fromIntegral $ M.readArray vec start+ let !p1# = (and# (int2Word# 0x1#)+ (or# (maskw# x1# v1#)+ (or# (maskw# x1# v2#) (maskw# x1# v3#))))++ !(I# x2#) <- liftM fromIntegral $ M.readArray vec $! start + 1+ let !p2# = or# p1# (and# (int2Word# 0x2#)+ (or# (maskw# x2# v1#)+ (or# (maskw# x2# v2#) (maskw# x2# v3#))))++ !(I# x3#) <- liftM fromIntegral $ M.readArray vec $! start + 2+ let !p3# = or# p2# (and# (int2Word# 0x4#)+ (or# (maskw# x3# v1#)+ (or# (maskw# x3# v2#) (maskw# x3# v3#))))++ !(I# x4#) <- liftM fromIntegral $ M.readArray vec $! start + 3+ let !p4# = or# p3# (and# (int2Word# 0x8#)+ (or# (maskw# x4# v1#)+ (or# (maskw# x4# v2#) (maskw# x4# v3#))))++ !(I# x5#) <- liftM fromIntegral $ M.readArray vec $! start + 4+ let !p5# = or# p4# (and# (int2Word# 0x10#)+ (or# (maskw# x5# v1#)+ (or# (maskw# x5# v2#) (maskw# x5# v3#))))++ !(I# x6#) <- liftM fromIntegral $ M.readArray vec $! start + 5+ let !p6# = or# p5# (and# (int2Word# 0x20#)+ (or# (maskw# x6# v1#)+ (or# (maskw# x6# v2#) (maskw# x6# v3#))))++ !(I# x7#) <- liftM fromIntegral $ M.readArray vec $! start + 6+ let !p7# = or# p6# (and# (int2Word# 0x40#)+ (or# (maskw# x7# v1#)+ (or# (maskw# x7# v2#) (maskw# x7# v3#))))++ !(I# x8#) <- liftM fromIntegral $ M.readArray vec $! start + 7+ let !p8# = or# p7# (and# (int2Word# 0x80#)+ (or# (maskw# x8# v1#)+ (or# (maskw# x8# v2#) (maskw# x8# v3#))))++ !(I# x9#) <- liftM fromIntegral $ M.readArray vec $! start + 8+ let !p9# = or# p8# (and# (int2Word# 0x100#)+ (or# (maskw# x9# v1#)+ (or# (maskw# x9# v2#) (maskw# x9# v3#))))++ !(I# x10#) <- liftM fromIntegral $ M.readArray vec $! start + 9+ let !p10# = or# p9# (and# (int2Word# 0x200#)+ (or# (maskw# x10# v1#)+ (or# (maskw# x10# v2#) (maskw# x10# v3#))))++ !(I# x11#) <- liftM fromIntegral $ M.readArray vec $! start + 10+ let !p11# = or# p10# (and# (int2Word# 0x400#)+ (or# (maskw# x11# v1#)+ (or# (maskw# x11# v2#) (maskw# x11# v3#))))++ !(I# x12#) <- liftM fromIntegral $ M.readArray vec $! start + 11+ let !p12# = or# p11# (and# (int2Word# 0x800#)+ (or# (maskw# x12# v1#)+ (or# (maskw# x12# v2#) (maskw# x12# v3#))))++ !(I# x13#) <- liftM fromIntegral $ M.readArray vec $! start + 12+ let !p13# = or# p12# (and# (int2Word# 0x1000#)+ (or# (maskw# x13# v1#)+ (or# (maskw# x13# v2#) (maskw# x13# v3#))))++ !(I# x14#) <- liftM fromIntegral $ M.readArray vec $! start + 13+ let !p14# = or# p13# (and# (int2Word# 0x2000#)+ (or# (maskw# x14# v1#)+ (or# (maskw# x14# v2#) (maskw# x14# v3#))))++ !(I# x15#) <- liftM fromIntegral $ M.readArray vec $! start + 14+ let !p15# = or# p14# (and# (int2Word# 0x4000#)+ (or# (maskw# x15# v1#)+ (or# (maskw# x15# v2#) (maskw# x15# v3#))))++ !(I# x16#) <- liftM fromIntegral $ M.readArray vec $! start + 15+ let !p16# = or# p15# (and# (int2Word# 0x8000#)+ (or# (maskw# x16# v1#)+ (or# (maskw# x16# v2#) (maskw# x16# v3#))))++ !(I# x17#) <- liftM fromIntegral $ M.readArray vec $! start + 16+ let !p17# = or# p16# (and# (int2Word# 0x10000#)+ (or# (maskw# x17# v1#)+ (or# (maskw# x17# v2#) (maskw# x17# v3#))))++ !(I# x18#) <- liftM fromIntegral $ M.readArray vec $! start + 17+ let !p18# = or# p17# (and# (int2Word# 0x20000#)+ (or# (maskw# x18# v1#)+ (or# (maskw# x18# v2#) (maskw# x18# v3#))))++ !(I# x19#) <- liftM fromIntegral $ M.readArray vec $! start + 18+ let !p19# = or# p18# (and# (int2Word# 0x40000#)+ (or# (maskw# x19# v1#)+ (or# (maskw# x19# v2#) (maskw# x19# v3#))))++ !(I# x20#) <- liftM fromIntegral $ M.readArray vec $! start + 19+ let !p20# = or# p19# (and# (int2Word# 0x80000#)+ (or# (maskw# x20# v1#)+ (or# (maskw# x20# v2#) (maskw# x20# v3#))))++ !(I# x21#) <- liftM fromIntegral $ M.readArray vec $! start + 20+ let !p21# = or# p20# (and# (int2Word# 0x100000#)+ (or# (maskw# x21# v1#)+ (or# (maskw# x21# v2#) (maskw# x21# v3#))))++ !(I# x22#) <- liftM fromIntegral $ M.readArray vec $! start + 21+ let !p22# = or# p21# (and# (int2Word# 0x200000#)+ (or# (maskw# x22# v1#)+ (or# (maskw# x22# v2#) (maskw# x22# v3#))))++ !(I# x23#) <- liftM fromIntegral $ M.readArray vec $! start + 22+ let !p23# = or# p22# (and# (int2Word# 0x400000#)+ (or# (maskw# x23# v1#)+ (or# (maskw# x23# v2#) (maskw# x23# v3#))))++ !(I# x24#) <- liftM fromIntegral $ M.readArray vec $! start + 23+ let !p24# = or# p23# (and# (int2Word# 0x800000#)+ (or# (maskw# x24# v1#)+ (or# (maskw# x24# v2#) (maskw# x24# v3#))))++ !(I# x25#) <- liftM fromIntegral $ M.readArray vec $! start + 24+ let !p25# = or# p24# (and# (int2Word# 0x1000000#)+ (or# (maskw# x25# v1#)+ (or# (maskw# x25# v2#) (maskw# x25# v3#))))++ !(I# x26#) <- liftM fromIntegral $ M.readArray vec $! start + 25+ let !p26# = or# p25# (and# (int2Word# 0x2000000#)+ (or# (maskw# x26# v1#)+ (or# (maskw# x26# v2#) (maskw# x26# v3#))))++ !(I# x27#) <- liftM fromIntegral $ M.readArray vec $! start + 26+ let !p27# = or# p26# (and# (int2Word# 0x4000000#)+ (or# (maskw# x27# v1#)+ (or# (maskw# x27# v2#) (maskw# x27# v3#))))++ !(I# x28#) <- liftM fromIntegral $ M.readArray vec $! start + 27+ let !p28# = or# p27# (and# (int2Word# 0x8000000#)+ (or# (maskw# x28# v1#)+ (or# (maskw# x28# v2#) (maskw# x28# v3#))))++ !(I# x29#) <- liftM fromIntegral $ M.readArray vec $! start + 28+ let !p29# = or# p28# (and# (int2Word# 0x10000000#)+ (or# (maskw# x29# v1#)+ (or# (maskw# x29# v2#) (maskw# x29# v3#))))++ !(I# x30#) <- liftM fromIntegral $ M.readArray vec $! start + 29+ let !p30# = or# p29# (and# (int2Word# 0x20000000#)+ (or# (maskw# x30# v1#)+ (or# (maskw# x30# v2#) (maskw# x30# v3#))))++ !(I# x31#) <- liftM fromIntegral $ M.readArray vec $! start + 30+ let !p31# = or# p30# (and# (int2Word# 0x40000000#)+ (or# (maskw# x31# v1#)+ (or# (maskw# x31# v2#) (maskw# x31# v3#))))++ !(I# x32#) <- liftM fromIntegral $ M.readArray vec $! start + 31+ let !p32# = or# p31# (and# (int2Word# 0x80000000#)+ (or# (maskw# x32# v1#)+ (or# (maskw# x32# v2#) (maskw# x32# v3#))))++ return $! lineResult# p32# start+++------------------------------------------------------------------------------+-- | Search through a mutable vector for a given int value. The number of+-- things to search for must be at most the number of things remaining in the+-- vector.+naiveSearch :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Int -- ^ number of things to search+ -> Elem -- ^ value to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+naiveSearch !vec !start !nThings !value = go start+ where+ !doneIdx = start + nThings++ go !i | i >= doneIdx = return (-1)+ | otherwise = do+ x <- M.readArray vec i+ if x == value then return i else go (i+1)+{-# INLINE naiveSearch #-}+++------------------------------------------------------------------------------+naiveSearch2 :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Int -- ^ number of things to search+ -> Elem -- ^ value to search for+ -> Elem -- ^ value 2 to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+naiveSearch2 !vec !start !nThings !value1 !value2 = go start+ where+ !doneIdx = start + nThings++ go !i | i >= doneIdx = return (-1)+ | otherwise = do+ x <- M.readArray vec i+ if x == value1 || x == value2 then return i else go (i+1)+{-# INLINE naiveSearch2 #-}+++------------------------------------------------------------------------------+naiveSearch3 :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Int -- ^ number of things to search+ -> Elem -- ^ value to search for+ -> Elem -- ^ value 2 to search for+ -> Elem -- ^ value 3 to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+naiveSearch3 !vec !start !nThings !value1 !value2 !value3 = go start+ where+ !doneIdx = start + nThings++ go !i | i >= doneIdx = return (-1)+ | otherwise = do+ x <- M.readArray vec i+ if x == value1 || x == value2 || x == value3+ then return i+ else go (i+1)+{-# INLINE naiveSearch3 #-}++-- end #if NO_C_SEARCH+#endif++------------------------------------------------------------------------------+-- | Search through a mutable vector for a given int value, cache-line aligned.+-- If the start index is cache-line aligned, and there is more than a+-- cache-line's room between the start index and the end of the vector, we will+-- search the cache-line all at once using an efficient branchless+-- bit-twiddling technique. Otherwise, we will use a typical loop.+--+cacheLineSearch :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Elem -- ^ value to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+cacheLineSearch !vec !start !value = do+#ifdef NO_C_SEARCH+ let !vlen = M.length vec+ let !st1 = vlen - start+ let !nvlen = numElemsInCacheLine - st1+ let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask+ let st2 = adv - start+++ if nvlen > 0 || not (isCacheLineAligned start)+ then naiveSearch vec start (min st1 st2) value+ else lineSearch vec start value+#else+ lineSearch vec start value+#endif+{-# INLINE cacheLineSearch #-}+++------------------------------------------------------------------------------+-- | Search through a mutable vector for one of two given int values,+-- cache-line aligned. If the start index is cache-line aligned, and there is+-- more than a cache-line's room between the start index and the end of the+-- vector, we will search the cache-line all at once using an efficient+-- branchless bit-twiddling technique. Otherwise, we will use a typical loop.+--+cacheLineSearch2 :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Elem -- ^ value to search for+ -> Elem -- ^ value 2 to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+cacheLineSearch2 !vec !start !value !value2 = do+#ifdef NO_C_SEARCH+ let !vlen = M.length vec+ let !st1 = vlen - start+ let !nvlen = numElemsInCacheLine - st1+ let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask+ let st2 = adv - start++ if nvlen > 0 || not (isCacheLineAligned start)+ then naiveSearch2 vec start (min st1 st2) value value2+ else lineSearch2 vec start value value2+#else+ lineSearch2 vec start value value2+#endif+{-# INLINE cacheLineSearch2 #-}+++------------------------------------------------------------------------------+-- | Search through a mutable vector for one of three given int values,+-- cache-line aligned. If the start index is cache-line aligned, and there is+-- more than a cache-line's room between the start index and the end of the+-- vector, we will search the cache-line all at once using an efficient+-- branchless bit-twiddling technique. Otherwise, we will use a typical loop.+--+cacheLineSearch3 :: IntArray s -- ^ vector to search+ -> Int -- ^ start index+ -> Elem -- ^ value to search for+ -> Elem -- ^ value 2 to search for+ -> Elem -- ^ value 3 to search for+ -> ST s Int -- ^ dest index where it can be found, or+ -- \"-1\" if not found+cacheLineSearch3 !vec !start !value !value2 !value3 = do+#ifdef NO_C_SEARCH+ let !vlen = M.length vec+ let !st1 = vlen - start+ let !nvlen = numElemsInCacheLine - st1+ let adv = (start + cacheLineIntMask) .&. complement cacheLineIntMask+ let st2 = adv - start++ if nvlen > 0 || not (isCacheLineAligned start)+ then naiveSearch3 vec start (min st1 st2) value value2 value3+ else lineSearch3 vec start value value2 value3+#else+ lineSearch3 vec start value value2 value3+#endif+{-# INLINE cacheLineSearch3 #-}
src/Data/HashTable/Internal/IntArray.hs view
@@ -4,6 +4,11 @@ module Data.HashTable.Internal.IntArray ( IntArray+ , Elem+ , elemMask+ , primWordToElem+ , elemToInt+ , elemToInt# , newArray , readArray , writeArray@@ -11,63 +16,99 @@ , toPtr ) where +------------------------------------------------------------------------------ import Control.Monad.ST import Data.Bits import qualified Data.Primitive.ByteArray as A-import Data.Primitive.Types (Addr(..))+import Data.Primitive.Types (Addr (..)) import GHC.Exts-import Prelude hiding (length)+import GHC.Word+import Prelude hiding (length)+------------------------------------------------------------------------------ + #ifdef BOUNDS_CHECKING-#define BOUNDS_MSG(sz,i) concat [ "[", __FILE__, ":", \- show (__LINE__ :: Int), \- "] bounds check exceeded: ",\+#define BOUNDS_MSG(sz,i) concat [ "[", __FILE__, ":", \+ show (__LINE__ :: Int), \+ "] bounds check exceeded: ", \ "size was ", show (sz), " i was ", show (i) ]-#define BOUNDS_CHECK(arr,i) let sz = (A.sizeofMutableByteArray (arr) \- `div` wordSizeInBytes) in \- if (i) < 0 || (i) >= sz \- then error (BOUNDS_MSG(sz,(i))) \++#define BOUNDS_CHECK(arr,i) let sz = (A.sizeofMutableByteArray (arr) \+ `div` wordSizeInBytes) in \+ if (i) < 0 || (i) >= sz \+ then error (BOUNDS_MSG(sz,(i))) \ else return () #else #define BOUNDS_CHECK(arr,i) #endif ++------------------------------------------------------------------------------ newtype IntArray s = IA (A.MutableByteArray s)+type Elem = Word16 +------------------------------------------------------------------------------+primWordToElem :: Word# -> Elem+primWordToElem = W16#+++------------------------------------------------------------------------------+elemToInt :: Elem -> Int+elemToInt e = let !i# = elemToInt# e+ in (I# i#)+++------------------------------------------------------------------------------+elemToInt# :: Elem -> Int#+elemToInt# (W16# w#) = word2Int# w#+++------------------------------------------------------------------------------+elemMask :: Int+elemMask = 0xffff+++------------------------------------------------------------------------------ wordSizeInBytes :: Int-wordSizeInBytes = bitSize (0::Int) `div` 8+wordSizeInBytes = bitSize (0::Elem) `div` 8 +------------------------------------------------------------------------------ -- | Cache line size, in bytes cacheLineSize :: Int cacheLineSize = 64 +------------------------------------------------------------------------------ newArray :: Int -> ST s (IntArray s) newArray n = do let !sz = n * wordSizeInBytes- !arr <- A.newAlignedPinnedByteArray sz cacheLineSize+ !arr <- A.newAlignedPinnedByteArray sz cacheLineSize A.fillByteArray arr 0 sz 0 return $! IA arr -readArray :: IntArray s -> Int -> ST s Int+------------------------------------------------------------------------------+readArray :: IntArray s -> Int -> ST s Elem readArray (IA a) idx = do BOUNDS_CHECK(a,idx) A.readByteArray a idx -writeArray :: IntArray s -> Int -> Int -> ST s ()+------------------------------------------------------------------------------+writeArray :: IntArray s -> Int -> Elem -> ST s () writeArray (IA a) idx val = do BOUNDS_CHECK(a,idx) A.writeByteArray a idx val +------------------------------------------------------------------------------ length :: IntArray s -> Int length (IA a) = A.sizeofMutableByteArray a `div` wordSizeInBytes +------------------------------------------------------------------------------ toPtr :: IntArray s -> Ptr a toPtr (IA a) = Ptr a# where
src/Data/HashTable/Internal/Linear/Bucket.hs view
@@ -26,6 +26,9 @@ import qualified Control.Monad import Control.Monad hiding (mapM_, foldM) import Control.Monad.ST+#ifdef DEBUG+import Control.Monad.ST.Unsafe+#endif import Data.Maybe (fromMaybe) import Data.HashTable.Internal.Array import Data.STRef
src/Data/HashTable/Internal/UnsafeTricks.hs view
@@ -22,9 +22,17 @@ #ifdef UNSAFETRICKS import GHC.Exts import Unsafe.Coerce++#if __GLASGOW_HASKELL__ >= 707+import GHC.Exts (isTrue#)+#else+isTrue# :: Bool -> Bool+isTrue# = id #endif +#endif + ------------------------------------------------------------------------------ #ifdef UNSAFETRICKS type Key a = Any@@ -61,12 +69,12 @@ deletedRecord = unsafeCoerce DeletedElement {-# INLINE keyIsEmpty #-}-keyIsEmpty a = x# ==# 1#+keyIsEmpty a = isTrue# (x# ==# 1#) where !x# = reallyUnsafePtrEquality# a emptyRecord {-# INLINE keyIsDeleted #-}-keyIsDeleted a = x# ==# 1#+keyIsDeleted a = isTrue# (x# ==# 1#) where !x# = reallyUnsafePtrEquality# a deletedRecord
src/Data/HashTable/Internal/Utils.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -module Data.HashTable.Internal.Utils +module Data.HashTable.Internal.Utils ( whichBucket , nextBestPrime , bumpSize@@ -15,15 +15,16 @@ , highestBitMask , wordSize , cacheLineSize- , numWordsInCacheLine+ , numElemsInCacheLine , cacheLineIntMask , cacheLineIntBits , forceSameType ) where -import Data.Bits hiding (shiftL)-import Data.Vector (Vector)-import qualified Data.Vector as V+import Data.Bits hiding (shiftL)+import Data.HashTable.Internal.IntArray (Elem)+import Data.Vector (Vector)+import qualified Data.Vector as V #if __GLASGOW_HASKELL__ >= 503 import GHC.Exts #else@@ -41,10 +42,10 @@ cacheLineSize = 64 -numWordsInCacheLine :: Int-numWordsInCacheLine = z+numElemsInCacheLine :: Int+numElemsInCacheLine = z where- !z = cacheLineSize `div` (wordSize `div` 8)+ !z = cacheLineSize `div` (bitSize (0::Elem) `div` 8) -- | What you have to mask an integer index by to tell if it's@@ -52,11 +53,11 @@ cacheLineIntMask :: Int cacheLineIntMask = z where- !z = numWordsInCacheLine - 1+ !z = numElemsInCacheLine - 1 cacheLineIntBits :: Int-cacheLineIntBits = log2 $ toEnum numWordsInCacheLine+cacheLineIntBits = log2 $ toEnum numElemsInCacheLine ------------------------------------------------------------------------------@@ -237,12 +238,8 @@ -------------------------------------------------------------------------------bumpSize :: Int -> Int-bumpSize !s = nextBestPrime s'- where- -- double at small sizes, then 3/2 thereafter- s' = if s < 24593 then 2*s else (s `div` 2) * 3-+bumpSize :: Double -> Int -> Int+bumpSize !maxLoad !s = nextBestPrime $! ceiling (fromIntegral s / maxLoad) ------------------------------------------------------------------------------
src/Data/HashTable/ST/Basic.hs view
@@ -18,49 +18,51 @@ with deleted markers and force the table to be completely rehashed fairly often. -/Details:/--Of the hash tables in this collection, this hash table has the best insert and-lookup performance, with the following caveats.+Of the hash tables in this collection, this hash table has the best lookup+performance, while maintaining competitive insert performance. /Space overhead/ This table is not especially memory-efficient; firstly, the table has a maximum load factor of 0.83 and will be resized if load exceeds this value. Secondly,-to improve insert and lookup performance, we store the hash code for each key-in the table.+to improve insert and lookup performance, we store a 16-bit hash code for each+key in the table. -Each hash table entry requires three words, two for the pointers to the key and-value and one for the hash code. We don't count key and value pointers as-overhead, because they have to be there -- so the overhead for a full slot is-one word -- but empty slots in the hash table count for a full three words of-overhead. Define @m@ as the number of slots in the table and @n@ as the number-of key value mappings. If the load factor is @k=n\/m@, the amount of space-wasted is:+Each hash table entry requires at least 2.25 words (on a 64-bit machine), two+for the pointers to the key and value and one quarter word for the hash code.+We don't count key and value pointers as overhead, because they have to be+there -- so the overhead for a full slot is at least one quarter word -- but+empty slots in the hash table count for a full 2.25 words of overhead. Define+@m@ as the number of slots in the table, @n@ as the number of key value+mappings, and @ws@ as the machine word size in /bytes/. If the load factor is+@k=n\/m@, the amount of space /wasted/ per mapping in words is: @-w(n) = 1*n + 3(m-n)+w(n) = (m*(2*ws + 2) - n*(2*ws)) / ws @ Since @m=n\/k@, @-w(n) = n + 3(n\/k - n)-= n (3\/k-2)+w(n) = n\/k * (2*ws + 2) - n*(2*ws)+ = (n * (2 + 2*ws*(1-k)) / k) / ws @ -Solving for @k=0.83@, the maximum load factor, gives a /minimum/ overhead of 2-words per mapping. If @k=0.5@, under normal usage the /maximum/ overhead-situation, then the overhead would be 4 words per mapping.+Solving for @k=0.83@, the maximum load factor, gives a /minimum/ overhead of+0.71 words per mapping on a 64-bit machine, or 1.01 words per mapping on a+32-bit machine. If @k=0.5@, which should be under normal usage the /maximum/+overhead situation, then the overhead would be 2.5 words per mapping on a+64-bit machine, or 3.0 words per mapping on a 32-bit machine. /Space overhead: experimental results/ -In randomized testing (see @test\/compute-overhead\/ComputeOverhead.hs@ in the-source distribution), mean overhead (that is, the number of words needed to-store the key-value mapping over and above the two words necessary for the key-and the value pointers) is approximately 2.29 machine words per key-value-mapping with a standard deviation of about 0.44 words, and 3.14 words per-mapping at the 95th percentile.+In randomized testing on a 64-bit machine (see+@test\/compute-overhead\/ComputeOverhead.hs@ in the source distribution), mean+overhead (that is, the number of words needed to store the key-value mapping+over and above the two words necessary for the key and the value pointers) is+approximately 1.24 machine words per key-value mapping with a standard+deviation of about 0.30 words, and 1.70 words per mapping at the 95th+percentile. /Expensive resizes/ @@ -78,7 +80,6 @@ Searching. Addison-Wesley Publishing Company, 1973. -} - module Data.HashTable.ST.Basic ( HashTable , new@@ -93,22 +94,25 @@ -------------------------------------------------------------------------------import Control.Exception (assert)-import Control.Monad hiding (mapM_, foldM)+import Control.Exception (assert)+import Control.Monad hiding (foldM, mapM_) import Control.Monad.ST-import Data.Hashable (Hashable)-import qualified Data.Hashable as H+import Control.Monad.ST.Unsafe+import Data.Bits+import Data.Hashable (Hashable)+import qualified Data.Hashable as H import Data.Maybe import Data.Monoid import Data.STRef import GHC.Exts-import Prelude hiding (lookup, read, mapM_)+import Prelude hiding (lookup, mapM_, read) ------------------------------------------------------------------------------+import qualified Data.HashTable.Class as C import Data.HashTable.Internal.Array-import qualified Data.HashTable.Internal.IntArray as U import Data.HashTable.Internal.CacheLine+import Data.HashTable.Internal.IntArray (Elem)+import qualified Data.HashTable.Internal.IntArray as U import Data.HashTable.Internal.Utils-import qualified Data.HashTable.Class as C ------------------------------------------------------------------------------@@ -148,7 +152,7 @@ -- | See the documentation for this function in -- "Data.HashTable.Class#v:new". new :: ST s (HashTable s k v)-new = newSized 30+new = newSized 1 {-# INLINE new #-} @@ -157,6 +161,7 @@ -- "Data.HashTable.Class#v:newSized". newSized :: Int -> ST s (HashTable s k v) newSized n = do+ debug $ "entering: newSized " ++ show n let m = nextBestPrime $ ceiling (fromIntegral n / maxLoad) ht <- newSizedReal m newRef ht@@ -168,8 +173,8 @@ newSizedReal m = do -- make sure the hash array is a multiple of cache-line sized so we can -- always search a whole cache line at once- let m' = ((m + numWordsInCacheLine - 1) `div` numWordsInCacheLine)- * numWordsInCacheLine+ let m' = ((m + numElemsInCacheLine - 1) `div` numElemsInCacheLine)+ * numElemsInCacheLine h <- U.newArray m' k <- newArray m undefined v <- newArray m undefined@@ -186,6 +191,7 @@ -> k -> ST s () delete htRef k = do+ debug $ "entered: delete: hash=" ++ show h ht <- readRef htRef _ <- delete' ht True k h return ()@@ -204,14 +210,22 @@ where lookup' (HashTable sz _ _ hashes keys values) = do let !b = whichBucket h sz- debug $ "lookup sz=" ++ show sz ++ " h=" ++ show h ++ " b=" ++ show b+ debug $ "lookup h=" ++ show h ++ " sz=" ++ show sz ++ " b=" ++ show b go b 0 sz where- !h = hash k+ !h = hash k+ !he = hashToElem h go !b !start !end = {-# SCC "lookup/go" #-} do- idx <- forwardSearch2 hashes b end h emptyMarker+ debug $ concat [ "lookup'/go: "+ , show b+ , "/"+ , show start+ , "/"+ , show end+ ]+ idx <- forwardSearch2 hashes b end he emptyMarker debug $ "forwardSearch2 returned " ++ show idx if (idx < 0 || idx < start || idx >= end) then return Nothing@@ -220,7 +234,9 @@ debug $ "h0 was " ++ show h0 if recordIsEmpty h0- then return Nothing+ then do+ debug $ "record empty, returning Nothing"+ return Nothing else do k' <- readArray keys idx if k == k'@@ -228,9 +244,11 @@ debug $ "value found at " ++ show idx v <- readArray values idx return $! Just v- else if idx < b- then go (idx + 1) (idx + 1) b- else go (idx + 1) start end+ else do+ debug $ "value not found, recursing"+ if idx < b+ then go (idx + 1) (idx + 1) b+ else go (idx + 1) start end {-# INLINE lookup #-} @@ -252,8 +270,14 @@ debug "insert': calling delete'" b <- delete' ht False k h - debug $ "insert': writing h=" ++ show h ++ " b=" ++ show b- U.writeArray hashes b h+ debug $ concat [ "insert': writing h="+ , show h+ , " he="+ , show he+ , " b="+ , show b+ ]+ U.writeArray hashes b he writeArray keys b k writeArray values b v @@ -261,6 +285,7 @@ where !h = hash k+ !he = hashToElem h hashes = _hashes ht keys = _keys ht values = _values ht@@ -316,12 +341,12 @@ work (HashTable sz' loadRef _ _ _ _) = do !ld <- U.readArray loadRef 0 let k = fromIntegral ld / sz- return $ constOverhead / sz + overhead k+ return $ constOverhead/sz + (2 + 2*ws*(1-k)) / (k * ws) where+ ws = fromIntegral $! bitSize (0::Int) `div` 8 sz = fromIntegral sz' -- Change these if you change the representation constOverhead = 14- overhead k = 3 / k - 2 ------------------------------@@ -345,11 +370,13 @@ probe b where+ he = hashToElem h+ probe !i = {-# SCC "insertRecord/probe" #-} do !idx <- forwardSearch2 hashes i sz emptyMarker deletedMarker debug $ "forwardSearch2 returned " ++ show idx assert (idx >= 0) $ do- U.writeArray hashes idx h+ U.writeArray hashes idx he writeArray keys idx key writeArray values idx value @@ -405,7 +432,7 @@ ------------------------------------------------------------------------------ growTable :: Hashable k => HashTable_ s k v -> ST s (HashTable_ s k v) growTable ht@(HashTable sz _ _ _ _ _) = do- let !sz' = bumpSize sz+ let !sz' = bumpSize maxLoad sz rehashAll ht sz' @@ -435,9 +462,10 @@ -> Int -> ST s Int delete' (HashTable sz loadRef delRef hashes keys values) clearOut k h = do- debug $ "delete': sz=" ++ show sz ++ " h=" ++ show h- ++ " b0=" ++ show b0- (found, slot) <- go mempty b0 False+ debug $ "delete': h=" ++ show h ++ " he=" ++ show he+ ++ " sz=" ++ show sz ++ " b0=" ++ show b0+ pair@(found, slot) <- go mempty b0 False+ debug $ "go returned " ++ show pair let !b' = _slot slot @@ -448,6 +476,7 @@ return b' where+ he = hashToElem h bump ref i = do !ld <- U.readArray ref 0 U.writeArray ref 0 $! ld + i@@ -466,11 +495,22 @@ -- * wrap True if we've wrapped around, False otherwise go !fp !b !wrap = do- debug $ "go: fp=" ++ show fp ++ " b=" ++ show b- ++ ", wrap=" ++ show wrap- !idx <- forwardSearch3 hashes b sz h emptyMarker deletedMarker- debug $ "forwardSearch3 returned " ++ show idx+ debug $ concat [ "go: fp="+ , show fp+ , " b="+ , show b+ , ", wrap="+ , show wrap+ , ", he="+ , show he+ , ", emptyMarker="+ , show emptyMarker+ , ", deletedMarker="+ , show deletedMarker ] + !idx <- forwardSearch3 hashes b sz he emptyMarker deletedMarker+ debug $ "forwardSearch3 returned " ++ show idx ++ " with sz=" ++ show sz ++ ", b=" ++ show b+ if wrap && idx >= b0 -- we wrapped around in the search and didn't find our hash code; -- this means that the table is full of deleted elements. Just return@@ -501,8 +541,9 @@ debug $ "deleted, cont with pl=" ++ show pl go pl (idx + 1) wrap' else- if h == h0+ if he == h0 then do+ debug $ "found he == h0 == " ++ show h0 k' <- readArray keys idx if k == k' then do@@ -519,7 +560,7 @@ -- new element here. when (clearOut || not samePlace) $ do bump delRef 1- U.writeArray hashes idx 1+ U.writeArray hashes idx deletedMarker writeArray keys idx undefined writeArray values idx undefined return (True, fp `mappend` (Slot idx 0))@@ -532,38 +573,44 @@ -------------------------------------------------------------------------------emptyMarker :: Int+emptyMarker :: Elem emptyMarker = 0 -------------------------------------------------------------------------------deletedMarker :: Int+deletedMarker :: Elem deletedMarker = 1 ------------------------------------------------------------------------------ {-# INLINE recordIsEmpty #-}-recordIsEmpty :: Int -> Bool+recordIsEmpty :: Elem -> Bool recordIsEmpty = (== emptyMarker) ------------------------------------------------------------------------------ {-# INLINE recordIsDeleted #-}-recordIsDeleted :: Int -> Bool+recordIsDeleted :: Elem -> Bool recordIsDeleted = (== deletedMarker) ------------------------------------------------------------------------------ {-# INLINE hash #-} hash :: (Hashable k) => k -> Int-hash k = out+hash = H.hash+++------------------------------------------------------------------------------+{-# INLINE hashToElem #-}+hashToElem :: Int -> Elem+hashToElem !h = out where- !(I# h#) = H.hash k+ !(I# lo#) = h .&. U.elemMask - !m# = maskw# h# 0# `or#` maskw# h# 1#+ !m# = maskw# lo# 0# `or#` maskw# lo# 1# !nm# = not# m# - !r# = ((int2Word# 2#) `and#` m#) `or#` (int2Word# h# `and#` nm#)- !out = I# (word2Int# r#)+ !r# = ((int2Word# 2#) `and#` m#) `or#` (int2Word# lo# `and#` nm#)+ !out = U.primWordToElem r# ------------------------------------------------------------------------------
src/Data/HashTable/ST/Cuckoo.hs view
@@ -10,7 +10,7 @@ * want the fastest possible inserts, and very fast lookups. * are conscious of memory usage; this table has less space overhead than- "Data.HashTable.ST.Basic", but more than "Data.HashTable.ST.Linear".+ "Data.HashTable.ST.Basic" or "Data.HashTable.ST.Linear". * don't care that a table resize might pause for a long time to rehash all of the key-value mappings.@@ -51,9 +51,8 @@ the basic open-addressing hash table using linear probing, and on average is more space-efficient: in randomized testing on my 64-bit machine (see @test\/compute-overhead\/ComputeOverhead.hs@ in the source distribution), mean-overhead is 1.71 machine words per key-value mapping, with a standard deviation-of 0.30 words, and 2.46 words per mapping at the 95th percentile.-+overhead is 0.77 machine words per key-value mapping, with a standard deviation+of 0.29 words, and 1.23 words per mapping at the 95th percentile. /References:/ @@ -75,21 +74,32 @@ -------------------------------------------------------------------------------import Control.Monad hiding (foldM, mapM_)+import Control.Monad hiding+ (foldM,+ mapM_) import Control.Monad.ST-import Data.Hashable hiding (hash)-import qualified Data.Hashable as H+#ifdef DEBUG+import Control.Monad.ST.Unsafe+#endif+import Data.Bits+import Data.Hashable hiding+ (hash)+import qualified Data.Hashable as H import Data.Int import Data.Maybe import Data.Primitive.Array import Data.STRef import GHC.Exts-import Prelude hiding ( lookup, read, mapM_ )+import Prelude hiding+ (lookup,+ mapM_,+ read) -------------------------------------------------------------------------------import qualified Data.HashTable.Class as C-import Data.HashTable.Internal.CheapPseudoRandomBitStream+import qualified Data.HashTable.Class as C import Data.HashTable.Internal.CacheLine-import qualified Data.HashTable.Internal.IntArray as U+import Data.HashTable.Internal.CheapPseudoRandomBitStream+import Data.HashTable.Internal.IntArray (Elem)+import qualified Data.HashTable.Internal.IntArray as U import Data.HashTable.Internal.Utils #ifdef DEBUG@@ -102,12 +112,12 @@ newtype HashTable s k v = HT (STRef s (HashTable_ s k v)) data HashTable_ s k v = HashTable- { _size :: {-# UNPACK #-} !Int -- ^ in buckets, total size is- -- numWordsInCacheLine * _size- , _rng :: {-# UNPACK #-} !(BitStream s)- , _hashes :: {-# UNPACK #-} !(U.IntArray s)- , _keys :: {-# UNPACK #-} !(MutableArray s k)- , _values :: {-# UNPACK #-} !(MutableArray s v)+ { _size :: {-# UNPACK #-} !Int -- ^ in buckets, total size is+ -- numElemsInCacheLine * _size+ , _rng :: {-# UNPACK #-} !(BitStream s)+ , _hashes :: {-# UNPACK #-} !(U.IntArray s)+ , _keys :: {-# UNPACK #-} !(MutableArray s k)+ , _values :: {-# UNPACK #-} !(MutableArray s v) , _maxAttempts :: {-# UNPACK #-} !Int } @@ -142,7 +152,7 @@ -- "Data.HashTable.Class#v:newSized". newSized :: Int -> ST s (HashTable s k v) newSized n = do- let n' = (n + numWordsInCacheLine - 1) `div` numWordsInCacheLine+ let n' = (n + numElemsInCacheLine - 1) `div` numElemsInCacheLine let k = nextBestPrime $ ceiling $ fromIntegral n' / maxLoad newSizedReal k >>= newRef {-# INLINE newSized #-}@@ -164,14 +174,16 @@ work (HashTable sz _ _ _ _ _) = do nFilled <- foldM f 0 htRef - let oh = totSz -- one word per element in hashes- + 2 * (totSz - nFilled) -- two words per non-filled entry- + 12 -- fixed overhead+ let oh = (totSz `div` hashCodesPerWord) -- one half or quarter word+ -- per element in hashes+ + 2 * (totSz - nFilled) -- two words per non-filled entry+ + 12 -- fixed overhead return $! fromIntegral (oh::Int) / fromIntegral nFilled where- totSz = numWordsInCacheLine * sz+ hashCodesPerWord = (bitSize (0 :: Int)) `div` 16+ totSz = numElemsInCacheLine * sz f !a _ = return $! a+1 @@ -218,14 +230,14 @@ lookup' (HashTable sz _ hashes keys values _) !k = do -- Unlike the write case, prefetch doesn't seem to help here for lookup. -- prefetchRead hashes b2- idx1 <- searchOne keys hashes k b1 h1+ idx1 <- searchOne keys hashes k b1 he1 if idx1 >= 0 then do v <- readArray values idx1 return $! Just v else do- idx2 <- searchOne keys hashes k b2 h2+ idx2 <- searchOne keys hashes k b2 he2 if idx2 >= 0 then do v <- readArray values idx2@@ -237,6 +249,9 @@ h1 = hash1 k h2 = hash2 k + he1 = hashToElem h1+ he2 = hashToElem h2+ b1 = whichLine h1 sz b2 = whichLine h2 sz {-# INLINE lookup' #-}@@ -248,12 +263,12 @@ -> U.IntArray s -> k -> Int- -> Int+ -> Elem -> ST s Int-searchOne !keys !hashes !k = go+searchOne !keys !hashes !k !b0 !h = go b0 where- go !b !h = do- debug $ "searchOne: go " ++ show b ++ " " ++ show h+ go !b = do+ debug $ "searchOne: go/" ++ show b ++ "/" ++ show h idx <- cacheLineSearch hashes b h debug $ "searchOne: cacheLineSearch returned " ++ show idx @@ -267,7 +282,7 @@ let !idx' = idx + 1 if isCacheLineAligned idx' then return (-1)- else go idx' h+ else go idx' {-# INLINE searchOne #-} @@ -290,7 +305,7 @@ -> ST s a foldMWork f seed0 (HashTable sz _ hashes keys values _) = go 0 seed0 where- totSz = numWordsInCacheLine * sz+ totSz = numElemsInCacheLine * sz go !i !seed | i >= totSz = return seed | otherwise = do@@ -323,7 +338,7 @@ -> ST s () mapMWork f (HashTable sz _ hashes keys values _) = go 0 where- totSz = numWordsInCacheLine * sz+ totSz = numElemsInCacheLine * sz go !i | i >= totSz = return () | otherwise = do@@ -347,7 +362,7 @@ ------------------------------------------------------------------------------ newSizedReal :: Int -> ST s (HashTable_ s k v) newSizedReal nbuckets = do- let !ntotal = nbuckets * numWordsInCacheLine+ let !ntotal = nbuckets * numElemsInCacheLine let !maxAttempts = 12 + (log2 $ toEnum nbuckets) debug $ "creating cuckoo hash table with " ++@@ -421,7 +436,7 @@ --------------------------------------------------------------------------------- Returns either (-1,-1) (not found, and both buckets full ==> trigger+-- Returns either (-1, 0) (not found, and both buckets full ==> trigger -- cuckoo), or the slot in the array where it would be safe to write the given -- key, and the hashcode to use there delete' :: (Hashable k, Eq k) =>@@ -432,17 +447,19 @@ -> Int -- ^ cache line start address 2 -> Int -- ^ hash1 -> Int -- ^ hash2- -> ST s (Int, Int)+ -> ST s (Int, Elem) delete' (HashTable _ _ hashes keys values _) !updating !k b1 b2 h1 h2 = do debug $ "delete' b1=" ++ show b1 ++ " b2=" ++ show b2 ++ " h1=" ++ show h1 ++ " h2=" ++ show h2 prefetchWrite hashes b2- idx1 <- searchOne keys hashes k b1 h1+ let !he1 = hashToElem h1+ let !he2 = hashToElem h2+ idx1 <- searchOne keys hashes k b1 he1 if idx1 < 0 then do- idx2 <- searchOne keys hashes k b2 h2+ idx2 <- searchOne keys hashes k b2 he2 if idx2 < 0 then if updating then do@@ -451,16 +468,16 @@ idxE1 <- cacheLineSearch hashes b1 emptyMarker debug $ "delete': idxE1 was " ++ show idxE1 if idxE1 >= 0- then return (idxE1, h1)+ then return (idxE1, he1) else do idxE2 <- cacheLineSearch hashes b2 emptyMarker debug $ "delete': idxE2 was " ++ show idxE1 if idxE2 >= 0- then return (idxE2, h2)- else return (-1, -1)- else return (-1,-1)- else deleteIt idx2 h2- else deleteIt idx1 h1+ then return (idxE2, he2)+ else return (-1, 0)+ else return (-1, 0)+ else deleteIt idx2 he2+ else deleteIt idx1 he1 where deleteIt !idx !h = do@@ -520,18 +537,20 @@ return $! b + z bumpIdx !idx !h !k !v = do+ let !he = hashToElem h debug $ "bumpIdx idx=" ++ show idx ++ " h=" ++ show h- !h' <- U.readArray hashes idx- debug $ "bumpIdx: h' was " ++ show h'+ ++ " he=" ++ show he+ !he' <- U.readArray hashes idx+ debug $ "bumpIdx: he' was " ++ show he' !k' <- readArray keys idx v' <- readArray values idx- U.writeArray hashes idx h+ U.writeArray hashes idx he writeArray keys idx k writeArray values idx v- debug $ "bumped key with h'=" ++ show h'- return $! (h', k', v')+ debug $ "bumped key with he'=" ++ show he'+ return $! (he', k', v') - otherHash h k = if h2 == h then h1 else h2+ otherHash he k = if hashToElem h1 == he then h2 else h1 where h1 = hash1 k h2 = hash2 k@@ -543,7 +562,7 @@ if idx >= 0 then do- U.writeArray hashes idx h+ U.writeArray hashes idx $! hashToElem h writeArray keys idx k writeArray values idx v return Nothing@@ -552,8 +571,8 @@ go !b !h !k v !maxAttempts | maxAttempts == 0 = return $! Just (k,v) | otherwise = do idx <- randomIdx b- (!h0', !k', v') <- bumpIdx idx h k v- let !h' = otherHash h0' k'+ (!he0', !k', v') <- bumpIdx idx h k v+ let !h' = otherHash he0' k' let !b' = whichLine h' sz tryWrite b' h' k' v' maxAttempts@@ -566,11 +585,11 @@ -> v -> ST s (HashTable_ s k v) grow (HashTable sz _ hashes keys values _) k0 v0 = do- newHt <- grow' $! bumpSize sz+ newHt <- grow' $! bumpSize bumpFactor sz mbR <- updateOrFail newHt k0 v0 maybe (return newHt)- (\_ -> grow' $ bumpSize $ _size newHt)+ (\_ -> grow' $ bumpSize bumpFactor $ _size newHt) mbR where@@ -583,7 +602,7 @@ rehash !newSz !newHt = go 0 where- totSz = numWordsInCacheLine * sz+ totSz = numElemsInCacheLine * sz go !i | i >= totSz = return newHt | otherwise = do@@ -595,7 +614,7 @@ mbR <- updateOrFail newHt k v maybe (go $ i + 1)- (\_ -> grow' $ bumpSize newSz)+ (\_ -> grow' $ bumpSize bumpFactor newSz) mbR else go $ i + 1 @@ -610,30 +629,31 @@ ------------------------------------------------------------------------------ hash1 :: Hashable k => k -> Int-hash1 = hashF H.hash+hash1 = H.hash {-# INLINE hash1 #-} hash2 :: Hashable k => k -> Int-hash2 = hashF (H.hashWithSalt hashPrime)+hash2 = H.hashWithSalt hashPrime {-# INLINE hash2 #-} -hashF :: (k -> Int) -> k -> Int-hashF f k = out+------------------------------------------------------------------------------+hashToElem :: Int -> Elem+hashToElem !h = out where- !(I# h#) = f k+ !(I# lo#) = h .&. U.elemMask - !m# = maskw# h# 0#+ !m# = maskw# lo# 0# !nm# = not# m# - !r# = ((int2Word# 1#) `and#` m#) `or#` (int2Word# h# `and#` nm#)- !out = I# (word2Int# r#)-{-# INLINE hashF #-}+ !r# = ((int2Word# 1#) `and#` m#) `or#` (int2Word# lo# `and#` nm#)+ !out = U.primWordToElem r#+{-# INLINE hashToElem #-} -------------------------------------------------------------------------------emptyMarker :: Int+emptyMarker :: Elem emptyMarker = 0 @@ -643,6 +663,11 @@ ------------------------------------------------------------------------------+bumpFactor :: Double+bumpFactor = 0.73+++------------------------------------------------------------------------------ debug :: String -> ST s () #ifdef DEBUG debug s = unsafeIOToST (putStrLn s >> hFlush stdout)@@ -670,4 +695,3 @@ readRef :: HashTable s k v -> ST s (HashTable_ s k v) readRef (HT ref) = readSTRef ref {-# INLINE readRef #-}-
src/Data/HashTable/ST/Linear.hs view
@@ -6,9 +6,6 @@ {-| An implementation of linear hash tables. (See <http://en.wikipedia.org/wiki/Linear_hashing>). Use this hash table if you... - * care a lot about fitting your data set into memory; of the hash tables- included in this collection, this one has the lowest space overhead- * don't care that inserts and lookups are slower than the other hash table implementations in this collection (this one is slightly faster than @Data.HashTable@ from the base library in most cases)@@ -92,17 +89,20 @@ ) where -------------------------------------------------------------------------------import Control.Monad hiding (mapM_, foldM)+import Control.Monad hiding (foldM, mapM_) import Control.Monad.ST+#ifdef DEBUG+import Control.Monad.ST.Unsafe+#endif import Data.Bits import Data.Hashable import Data.STRef-import Prelude hiding (mapM_, lookup)+import Prelude hiding (lookup, mapM_) -------------------------------------------------------------------------------import qualified Data.HashTable.Class as C+import qualified Data.HashTable.Class as C import Data.HashTable.Internal.Array-import qualified Data.HashTable.Internal.Linear.Bucket as Bucket import Data.HashTable.Internal.Linear.Bucket (Bucket)+import qualified Data.HashTable.Internal.Linear.Bucket as Bucket import Data.HashTable.Internal.Utils #ifdef DEBUG
test/hashtables-test.cabal view
@@ -2,7 +2,7 @@ Version: 0.2 Author: Gregory Collins Maintainer: greg@gregorycollins.net-Copyright: (c) 2011-2012, Google, Inc.+Copyright: (c) 2011-2013, Google, Inc. Category: Data Build-type: Simple Cabal-version: >= 1.8@@ -22,13 +22,11 @@ Description: if on, use bounds-checking array accesses Default: False --Flag sse41- Description: if on, use SSE 4.1 extensions to search cache lines very- efficiently+Flag sse42+ Description: if on, use SSE 4.2 extensions to search cache lines very+ efficiently. The portable flag forces this off. Default: False - Flag portable Description: if on, use only pure Haskell code and no GHC extensions. Default: False@@ -38,8 +36,16 @@ hs-source-dirs: ../src suite main-is: TestSuite.hs + if flag(sse42) && !flag(portable)+ cc-options: -DUSE_SSE_4_2 -msse4.2+ cpp-options: -DUSE_SSE_4_2+ C-sources: ../cbits/sse-42.c++ if !flag(portable) && !flag(sse42)+ C-sources: ../cbits/default.c+ if !flag(portable)- C-sources: ../cbits/cfuncs.c+ C-sources: ../cbits/common.c ghc-prof-options: -prof -auto-all @@ -59,10 +65,6 @@ if flag(bounds-checking) cpp-options: -DBOUNDS_CHECKING - if !flag(portable) && flag(sse41)- cc-options: -DUSE_SSE_4_1 -msse4.1- cpp-options: -DUSE_SSE_4_1- Build-depends: base >= 4 && <5, hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3, mwc-random >= 0.8 && <0.13,@@ -89,8 +91,18 @@ Executable compute-overhead hs-source-dirs: ../src suite compute-overhead main-is: ComputeOverhead.hs- C-sources: ../cbits/cfuncs.c + if flag(sse42) && !flag(portable)+ cc-options: -DUSE_SSE_4_2 -msse4.2+ cpp-options: -DUSE_SSE_4_2+ C-sources: ../cbits/sse-42.c++ if !flag(portable) && !flag(sse42)+ C-sources: ../cbits/default.c++ if !flag(portable)+ C-sources: ../cbits/common.c+ ghc-prof-options: -prof -auto-all if flag(portable)@@ -106,17 +118,13 @@ if flag(bounds-checking) cpp-options: -DBOUNDS_CHECKING - if !flag(portable) && flag(sse41)- cc-options: -DUSE_SSE_4_1 -msse4.1- cpp-options: -DUSE_SSE_4_1- Build-depends: base >= 4 && <5, hashable >= 1.1 && <1.2 || >= 1.2.1 && <1.3, mwc-random >= 0.8 && <0.13, QuickCheck >= 2.3.0.2 && <3, HUnit >= 1.2 && <2,- test-framework >= 0.3.1 && <0.7,- test-framework-quickcheck2 >= 0.2.6 && <0.3,+ test-framework >= 0.3.1 && <0.9,+ test-framework-quickcheck2 >= 0.2.6 && <0.4, test-framework-hunit >= 0.2.6 && <3, statistics >= 0.8 && <0.11, primitive,
test/runTestsAndCoverage.sh view
@@ -19,7 +19,7 @@ exit; fi -./dist/build/testsuite/testsuite -j4 -a1000 $*+./dist/build/testsuite/testsuite -a1000 $* DIR=dist/hpc
test/suite/Data/HashTable/Test/Common.hs view
@@ -50,6 +50,21 @@ ------------------------------------------------------------------------------+announce :: Show a => String -> a -> IO ()+#ifdef DEBUG+announce nm x = do+ putStrLn "\n============================="+ putStrLn $ concat [ "starting "+ , nm+ , " with "+ , show x+ ]+ putStrLn "============================="+#else+announce _ _ = return ()+#endif++ assertEq :: (Eq a, Show a) => String -> a -> a -> PropertyM IO () assertEq s expected got =@@ -98,6 +113,7 @@ prop :: GenIO -> [(Int, Int)] -> PropertyM IO () prop rng origL = do let l = V.toList $ shuffle rng $ V.fromList $ dedupe origL+ run $ announce "fromListToList" l ht <- run $ fromList l l' <- run $ toList ht assertEq "fromList . toList == id" (sort l) (sort l')@@ -114,7 +130,8 @@ where prop :: GenIO -> ([(Int, Int)], (Int,Int)) -> PropertyM IO ()- prop rng (origL, (k,v)) = do+ prop rng o@(origL, (k,v)) = do+ run $ announce "insert" o let l = V.toList $ shuffle rng $ V.fromList $ remove k $ dedupe origL assert $ all (\t -> fst t /= k) l @@ -139,7 +156,8 @@ where prop :: GenIO -> ([(Int, Int)], (Int,Int,Int)) -> PropertyM IO ()- prop rng (origL, (k,v,v2)) = do+ prop rng o@(origL, (k,v,v2)) = do+ run $ announce "insert2" o let l = V.toList $ shuffle rng $ V.fromList $ dedupe origL ht <- run $ fromList l @@ -162,7 +180,8 @@ where prop :: (Int,Int,Int) -> PropertyM IO ()- prop (k,v,v2) = do+ prop o@(k,v,v2) = do+ run $ announce "newAndInsert" o ht <- run new nothing <- run $ lookup ht k@@ -209,6 +228,7 @@ prop :: Int -> PropertyM IO () prop n = do+ run $ announce "growTable" n ht <- run $ go n i <- liftM head $ run $ sample' $ choose (0,n-1) @@ -254,6 +274,8 @@ prop :: Int -> PropertyM IO () prop n = do+ run $ announce "delete" n+ ht <- run $ go n i <- liftM head $ run $ sample' $ choose (4,n-1)@@ -475,4 +497,3 @@ idx <- pickOne k swap k idx f (k-1)-