hashable-1.2.4.0/0000755000000000000000000000000012645773753011634 5ustar0000000000000000hashable-1.2.4.0/CHANGES.md0000644000000000000000000001055512645773753013234 0ustar0000000000000000## Version 1.2.4.0 * Add instances for: Unique, Version, Fixed, NonEmpty, Min, Max, Arg, First, Last, WrappedMonoid, Option * Support GHC 8.0 ## Version 1.2.3.3 * Support integer-simple. ## Version 1.2.3.2 * Add support for GHC 7.10 typeRepFingerprint ## Version 1.2.3.1 * Added support for random 1.1.*. ## Version 1.2.3.0 * Silence integer literal overflow warning * Add support for GHC 7.10 `integer-gmp2` & `Natural` * Add instance for Data.Void * Make the SSE .cabal flags manual * Add an upper bound on bytestring ## Version 1.2.2.0 * Add instances for `Data.ByteString.Short` * Use a 32-bit default salt on 32-bit archs. ## Version 1.2.1.0 * Revert instances to their 1.1 implementations to regain the performance we had then. * Remove use of random salt altogether. Without using SipHash the benefit is unclear (i.e. collision attacks still work) and the complexity is no longer worth it. * Documentation improvements. ## Version 1.2.0.10 * Fix for GHC 7.0. ## Version 1.2.0.9 * Stop using SipHash. The current implementation still has segfault causing bugs that we won't be able to fix soon. * Stop using Wang hash. It degrades performance of fixed-size integer hashing too much. ## Version 1.2.0.8 * Fix linking issue when SSE was disabled. * Hash small signed Integers correctly. ## Version 1.2.0.7 * Add flags to control usage of SSE. ## Version 1.2.0.6 * Fix another segfault caused by SSE2 code. ## Version 1.2.0.5 * More portability fixes. * Force stack alignment to 16 bytes everywhere. Fixes a segfault. * Fix bug where code relied on rewrite rules firing for correctness. ## Version1.2.0.4 * Update docs to match code. * Work around bug in GHCi runtime linker, which never call static initializers. ## Version1.2.0.3 * Make building of SSE 4.1 code conditional, as it doesn't work on all platforms. * Use a fixed salt, but allow random salting. Random salting by default broke people's code. ## Version1.2.0.2 * Work around ghci linker bug on Windows. ## Version1.2.0.1 * Fix performance bug in SSE implementation of SipHash. * Fix segfault due to incorrect stack alignment on Windows. ## Version1.2.0.0 * Switch string hashing from FNV-1 to SipHash, in an effort to prevent collision attacks. * Switch fixed-size integer hashing to Wang hash. * The default salt now switched on every program run, in an effort to prevent collision attacks. * Move hash method out of Hashable type class. * Add support for generic instance deriving. * Add instance for Ordering. ## Version1.1.2.5 * Bug fix for bytestring < 0.10.0. ## Version1.1.2.4 * Switch string hashing from Bernstein to FNV-1 * Faster instance for Integer. * Update dependency on base, ghc-prim * Now works with GHC 7.6. ## Version1.1.2.3 * Add instance for TypeRep. * Update dependency on test-framework. ## Version1.1.2.2 * Bug fix for GHC 7.4 ## Version1.1.2.1 * Update dependency on test-framework. * Improve documentation of combine. ## Version1.1.2.0 * Add instances for Interger, Ratio, Float, Double, and StableName. * Fix hash collision issues for lists and tuples when using a user-specified salt. ## Version1.1.1.0 * Improved instances for tuples and lists. * Add instances for StableName, Float, Double, Integer, and Ratio. ## Version1.1.1.0 * Add hashWithSalt, which allows the user to create different hash values for the same input by providing different seeds. This is useful for application like Cuckoo hashing which need a family of hash functions. * Fix a bug in the Hashable instance for Int64/Word64 on 32-bit platforms. * Improved resilience to leading zero in the input being hashed. ## Version1.1.0.0 * Add instance for: strict and lazy Texts, ThreadId * Add hashPtrWithSalt and hashByteArrayWithSalt. * Faster ByteArray# hashing. * Fix a signedness bug that affected ByteString. * Fix ByteString hashing to work correctly on both 32 and 64-bit platforms. ## Version1.0.1.1 * Fix bug in Hashable instance for lazy ByteStrings where differences in the internal structure of the ByteString could cause different hash values for ByteStrings that are equal according to ==. ## Version1.0.1.0 * Add two helpers for creating Hashable instances: hashPtr and hashByteArray. ## Version1.0.0 * Separate Hashable class to its own package from hashmap 1.0.0.3. hashable-1.2.4.0/hashable.cabal0000644000000000000000000001025712645773753014374 0ustar0000000000000000Name: hashable Version: 1.2.4.0 Synopsis: A class for types that can be converted to a hash value Description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class exists for the benefit of hashing-based data structures. The package provides instances for basic types and a way to combine hash values. Homepage: http://github.com/tibbe/hashable License: BSD3 License-file: LICENSE Author: Milan Straka Johan Tibell Maintainer: johan.tibell@gmail.com bug-reports: https://github.com/tibbe/hashable/issues Stability: Provisional Category: Data Build-type: Simple Cabal-version: >=1.8 -- tests/Properties.hs shouldn't have to go here, but the source files -- for the test-suite stanzas don't get picked up by `cabal sdist`. Extra-source-files: CHANGES.md, README.md, tests/Properties.hs, benchmarks/Benchmarks.hs Flag integer-gmp Description: Are we using integer-gmp to provide fast Integer instances? Default: True Flag sse2 Description: Do we want to assume that a target supports SSE 2? Default: True Manual: True Flag sse41 Description: Do we want to assume that a target supports SSE 4.1? Default: False Manual: True Library Exposed-modules: Data.Hashable Other-modules: Data.Hashable.Class Build-depends: base >= 4.0 && < 4.10, bytestring >= 0.9 && < 0.11 if impl(ghc) Build-depends: ghc-prim, text >= 0.11.0.5 if impl(ghc) && flag(integer-gmp) Build-depends: integer-gmp >= 0.2 if impl(ghc >= 7.2.1) CPP-Options: -DGENERICS Other-modules: Data.Hashable.Generic C-sources: cbits/fnv.c Ghc-options: -Wall if impl(ghc >= 6.8) Ghc-options: -fwarn-tabs else c-sources: cbits/getRandomBytes.c other-modules: Data.Hashable.RandomSource if os(windows) extra-libraries: advapi32 Test-suite tests Type: exitcode-stdio-1.0 Hs-source-dirs: tests Main-is: Main.hs Other-modules: Properties Regress Build-depends: base >= 4.0 && < 5.0, bytestring, ghc-prim, hashable, test-framework >= 0.3.3, test-framework-hunit, test-framework-quickcheck2 >= 0.2.9, HUnit, QuickCheck >= 2.4.0.1, random >= 1.0 && < 1.2, text >= 0.11.0.5 if !os(windows) Build-depends: unix CPP-options: -DHAVE_MMAP Other-modules: Regress.Mmap Ghc-options: -Wall -fno-warn-orphans if impl(ghc >= 7.2.1) CPP-Options: -DGENERICS benchmark benchmarks -- We cannot depend on the hashable library directly as that creates -- a dependency cycle. hs-source-dirs: . benchmarks main-is: Benchmarks.hs other-modules: Data.Hashable Data.Hashable.Class Data.Hashable.RandomSource Data.Hashable.SipHash type: exitcode-stdio-1.0 build-depends: base, bytestring, criterion >= 1.0, ghc-prim, siphash, text if impl(ghc) Build-depends: ghc-prim, text >= 0.11.0.5 if impl(ghc) && flag(integer-gmp) Build-depends: integer-gmp >= 0.2 c-sources: benchmarks/cbits/inthash.c benchmarks/cbits/siphash.c benchmarks/cbits/wang.c cbits/fnv.c if (arch(i386) || arch(x86_64)) && flag(sse2) cpp-options: -DHAVE_SSE2 c-sources: benchmarks/cbits/siphash-sse2.c if flag(sse41) cpp-options: -DHAVE_SSE41 c-sources: benchmarks/cbits/siphash-sse41.c Ghc-options: -Wall -O2 if impl(ghc >= 6.8) Ghc-options: -fwarn-tabs else c-sources: cbits/getRandomBytes.c other-modules: Data.Hashable.RandomSource if os(windows) extra-libraries: advapi32 source-repository head type: git location: https://github.com/tibbe/hashable.git hashable-1.2.4.0/LICENSE0000644000000000000000000000275512645773753012652 0ustar0000000000000000Copyright Milan Straka 2010 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Milan Straka nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hashable-1.2.4.0/README.md0000644000000000000000000000043512645773753013115 0ustar0000000000000000The hashable package ==================== This package defines a class, `Hashable`, for types that can be converted to a hash value. This class exists for the benefit of hashing-based data structures. The package provides instances for basic types and a way to combine hash values. hashable-1.2.4.0/Setup.hs0000644000000000000000000000011012645773753013260 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain hashable-1.2.4.0/benchmarks/0000755000000000000000000000000012645773753013751 5ustar0000000000000000hashable-1.2.4.0/benchmarks/Benchmarks.hs0000644000000000000000000002642212645773753016370 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, UnboxedTuples #-} module Main (main) where import Control.Monad.ST import Criterion.Main import Data.Hashable import Data.Hashable.SipHash import Data.Int import Foreign.ForeignPtr import GHC.Exts import GHC.ST (ST(..)) import Data.Word import Foreign.C.Types (CInt(..), CLong(..), CSize(..)) import Foreign.Ptr import Data.ByteString.Internal import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Crypto.MAC.SipHash as HS import qualified Data.ByteString.Char8 as B8 -- Benchmark English words (5 and 8), base64 encoded integers (11), -- SHA1 hashes as hex (40), and large blobs (1 Mb). main :: IO () main = do -- We do not actually care about the contents of these pointers. fp5 <- mallocForeignPtrBytes 5 fp8 <- mallocForeignPtrBytes 8 fp11 <- mallocForeignPtrBytes 11 fp40 <- mallocForeignPtrBytes 40 fp128 <- mallocForeignPtrBytes 128 fp512 <- mallocForeignPtrBytes 512 let !mb = 2^(20 :: Int) -- 1 Mb fp1Mb <- mallocForeignPtrBytes mb -- We don't care about the contents of these either. let !ba5 = new 5; !ba8 = new 8; !ba11 = new 11; !ba40 = new 40 !ba128 = new 128; !ba512 = new 512; !ba1Mb = new mb s5 = ['\0'..'\4']; s8 = ['\0'..'\7']; s11 = ['\0'..'\10'] s40 = ['\0'..'\39']; s128 = ['\0'..'\127']; s512 = ['\0'..'\511'] s1Mb = ['\0'..'\999999'] !bs5 = B8.pack s5; !bs8 = B8.pack s8; !bs11 = B8.pack s11 !bs40 = B8.pack s40; !bs128 = B8.pack s128; !bs512 = B8.pack s512 !bs1Mb = B8.pack s1Mb blmeg = BL.take (fromIntegral mb) . BL.fromChunks . repeat bl5 = BL.fromChunks [bs5]; bl8 = BL.fromChunks [bs8] bl11 = BL.fromChunks [bs11]; bl40 = BL.fromChunks [bs40] bl128 = BL.fromChunks [bs128]; bl512 = BL.fromChunks [bs512] bl1Mb_40 = blmeg bs40; bl1Mb_128 = blmeg bs128 bl1Mb_64k = blmeg (B8.take 65536 bs1Mb) !t5 = T.pack s5; !t8 = T.pack s8; !t11 = T.pack s11 !t40 = T.pack s40; !t128 = T.pack s128; !t512 = T.pack s512 !t1Mb = T.pack s1Mb tlmeg = TL.take (fromIntegral mb) . TL.fromChunks . repeat tl5 = TL.fromStrict t5; tl8 = TL.fromStrict t8 tl11 = TL.fromStrict t11; tl40 = TL.fromStrict t40 tl128 = TL.fromStrict t128; tl512 = TL.fromChunks (replicate 4 t128) tl1Mb_40 = tlmeg t40; tl1Mb_128 = tlmeg t128 tl1Mb_64k = tlmeg (T.take 65536 t1Mb) let k0 = 0x4a7330fae70f52e8 k1 = 0x919ea5953a9a1ec9 sipHash = hashByteString 2 4 k0 k1 hsSipHash = HS.hash (HS.SipKey k0 k1) cSipHash (PS fp off len) = inlinePerformIO . withForeignPtr fp $ \ptr -> return $! c_siphash 2 4 k0 k1 (ptr `plusPtr` off) (fromIntegral len) cSipHash24 (PS fp off len) = inlinePerformIO . withForeignPtr fp $ \ptr -> return $! c_siphash24 k0 k1 (ptr `plusPtr` off) (fromIntegral len) fnvHash (PS fp off len) = inlinePerformIO . withForeignPtr fp $ \ptr -> return $! fnv_hash (ptr `plusPtr` off) (fromIntegral len) 2166136261 #ifdef HAVE_SSE2 sse2SipHash (PS fp off len) = inlinePerformIO . withForeignPtr fp $ \ptr -> return $! sse2_siphash k0 k1 (ptr `plusPtr` off) (fromIntegral len) #endif #ifdef HAVE_SSE41 sse41SipHash (PS fp off len) = inlinePerformIO . withForeignPtr fp $ \ptr -> return $! sse41_siphash k0 k1 (ptr `plusPtr` off) (fromIntegral len) #endif withForeignPtr fp5 $ \ p5 -> withForeignPtr fp8 $ \ p8 -> withForeignPtr fp11 $ \ p11 -> withForeignPtr fp40 $ \ p40 -> withForeignPtr fp128 $ \ p128 -> withForeignPtr fp512 $ \ p512 -> withForeignPtr fp1Mb $ \ p1Mb -> defaultMain [ bgroup "hashPtr" [ bench "5" $ whnfIO $ hashPtr p5 5 , bench "8" $ whnfIO $ hashPtr p8 8 , bench "11" $ whnfIO $ hashPtr p11 11 , bench "40" $ whnfIO $ hashPtr p40 40 , bench "128" $ whnfIO $ hashPtr p128 128 , bench "512" $ whnfIO $ hashPtr p512 512 , bench "2^20" $ whnfIO $ hashPtr p1Mb mb ] , bgroup "hashByteArray" [ bench "5" $ whnf (hashByteArray ba5 0) 5 , bench "8" $ whnf (hashByteArray ba8 0) 8 , bench "11" $ whnf (hashByteArray ba11 0) 11 , bench "40" $ whnf (hashByteArray ba40 0) 40 , bench "128" $ whnf (hashByteArray ba128 0) 128 , bench "512" $ whnf (hashByteArray ba512 0) 512 , bench "2^20" $ whnf (hashByteArray ba1Mb 0) mb ] , bgroup "hash" [ bgroup "ByteString" [ bgroup "strict" [ bench "5" $ whnf hash bs5 , bench "8" $ whnf hash bs8 , bench "11" $ whnf hash bs11 , bench "40" $ whnf hash bs40 , bench "128" $ whnf hash bs128 , bench "512" $ whnf hash bs512 , bench "2^20" $ whnf hash bs1Mb ] , bgroup "lazy" [ bench "5" $ whnf hash bl5 , bench "8" $ whnf hash bl8 , bench "11" $ whnf hash bl11 , bench "40" $ whnf hash bl40 , bench "128" $ whnf hash bl128 , bench "512" $ whnf hash bl512 , bench "2^20_40" $ whnf hash bl1Mb_40 , bench "2^20_128" $ whnf hash bl1Mb_128 , bench "2^20_64k" $ whnf hash bl1Mb_64k ] ] , bgroup "String" [ bench "5" $ whnf hash s5 , bench "8" $ whnf hash s8 , bench "11" $ whnf hash s11 , bench "40" $ whnf hash s40 , bench "128" $ whnf hash s128 , bench "512" $ whnf hash s512 , bench "2^20" $ whnf hash s1Mb ] , bgroup "Text" [ bgroup "strict" [ bench "5" $ whnf hash t5 , bench "8" $ whnf hash t8 , bench "11" $ whnf hash t11 , bench "40" $ whnf hash t40 , bench "128" $ whnf hash t128 , bench "512" $ whnf hash t512 , bench "2^20" $ whnf hash t1Mb ] , bgroup "lazy" [ bench "5" $ whnf hash tl5 , bench "8" $ whnf hash tl8 , bench "11" $ whnf hash tl11 , bench "40" $ whnf hash tl40 , bench "128" $ whnf hash tl128 , bench "512" $ whnf hash tl512 , bench "2^20_40" $ whnf hash tl1Mb_40 , bench "2^20_128" $ whnf hash tl1Mb_128 , bench "2^20_64k" $ whnf hash tl1Mb_64k ] ] , bench "Int8" $ whnf hash (0xef :: Int8) , bench "Int16" $ whnf hash (0x7eef :: Int16) , bench "Int32" $ whnf hash (0x7eadbeef :: Int32) , bench "Int" $ whnf hash (0x7eadbeefdeadbeef :: Int) , bench "Int64" $ whnf hash (0x7eadbeefdeadbeef :: Int64) , bench "Double" $ whnf hash (0.3780675796601578 :: Double) ] , bgroup "sipHash" [ bench "5" $ whnf sipHash bs5 , bench "8" $ whnf sipHash bs8 , bench "11" $ whnf sipHash bs11 , bench "40" $ whnf sipHash bs40 , bench "128" $ whnf sipHash bs128 , bench "512" $ whnf sipHash bs512 , bench "2^20" $ whnf sipHash bs1Mb ] , bgroup "cSipHash" [ bench "5" $ whnf cSipHash bs5 , bench "8" $ whnf cSipHash bs8 , bench "11" $ whnf cSipHash bs11 , bench "40" $ whnf cSipHash bs40 , bench "128" $ whnf cSipHash bs128 , bench "512" $ whnf cSipHash bs512 , bench "2^20" $ whnf cSipHash bs1Mb ] , bgroup "cSipHash24" [ bench "5" $ whnf cSipHash24 bs5 , bench "8" $ whnf cSipHash24 bs8 , bench "11" $ whnf cSipHash24 bs11 , bench "40" $ whnf cSipHash24 bs40 , bench "128" $ whnf cSipHash24 bs128 , bench "512" $ whnf cSipHash24 bs512 , bench "2^20" $ whnf cSipHash24 bs1Mb ] #ifdef HAVE_SSE2 , bgroup "sse2SipHash" [ bench "5" $ whnf sse2SipHash bs5 , bench "8" $ whnf sse2SipHash bs8 , bench "11" $ whnf sse2SipHash bs11 , bench "40" $ whnf sse2SipHash bs40 , bench "128" $ whnf sse2SipHash bs128 , bench "512" $ whnf sse2SipHash bs512 , bench "2^20" $ whnf sse2SipHash bs1Mb ] #endif #ifdef HAVE_SSE41 , bgroup "sse41SipHash" [ bench "5" $ whnf sse41SipHash bs5 , bench "8" $ whnf sse41SipHash bs8 , bench "11" $ whnf sse41SipHash bs11 , bench "40" $ whnf sse41SipHash bs40 , bench "128" $ whnf sse41SipHash bs128 , bench "512" $ whnf sse41SipHash bs512 , bench "2^20" $ whnf sse41SipHash bs1Mb ] #endif , bgroup "pkgSipHash" [ bench "5" $ whnf hsSipHash bs5 , bench "8" $ whnf hsSipHash bs8 , bench "11" $ whnf hsSipHash bs11 , bench "40" $ whnf hsSipHash bs40 , bench "128" $ whnf hsSipHash bs128 , bench "512" $ whnf hsSipHash bs512 , bench "2^20" $ whnf hsSipHash bs1Mb ] , bgroup "fnv" [ bench "5" $ whnf fnvHash bs5 , bench "8" $ whnf fnvHash bs8 , bench "11" $ whnf fnvHash bs11 , bench "40" $ whnf fnvHash bs40 , bench "128" $ whnf fnvHash bs128 , bench "512" $ whnf fnvHash bs512 , bench "2^20" $ whnf fnvHash bs1Mb ] , bgroup "Int" [ bench "id32" $ whnf id (0x7eadbeef :: Int32) , bench "id64" $ whnf id (0x7eadbeefdeadbeef :: Int64) , bench "wang32" $ whnf hash_wang_32 0xdeadbeef , bench "wang64" $ whnf hash_wang_64 0xdeadbeefdeadbeef , bench "jenkins32a" $ whnf hash_jenkins_32a 0xdeadbeef , bench "jenkins32b" $ whnf hash_jenkins_32b 0xdeadbeef ] ] data ByteArray = BA { unBA :: !ByteArray# } new :: Int -> ByteArray# new (I# n#) = unBA (runST $ ST $ \s1 -> case newByteArray# n# s1 of (# s2, ary #) -> case unsafeFreezeByteArray# ary s2 of (# s3, ba #) -> (# s3, BA ba #)) foreign import ccall unsafe "hashable_siphash" c_siphash :: CInt -> CInt -> Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64 foreign import ccall unsafe "hashable_siphash24" c_siphash24 :: Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64 #ifdef HAVE_SSE2 foreign import ccall unsafe "hashable_siphash24_sse2" sse2_siphash :: Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64 #endif #ifdef HAVE_SSE41 foreign import ccall unsafe "hashable_siphash24_sse41" sse41_siphash :: Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64 #endif foreign import ccall unsafe "hashable_fnv_hash" fnv_hash :: Ptr Word8 -> CLong -> CLong -> CLong foreign import ccall unsafe "hashable_wang_32" hash_wang_32 :: Word32 -> Word32 foreign import ccall unsafe "hashable_wang_64" hash_wang_64 :: Word64 -> Word64 foreign import ccall unsafe "hash_jenkins_32a" hash_jenkins_32a :: Word32 -> Word32 foreign import ccall unsafe "hash_jenkins_32b" hash_jenkins_32b :: Word32 -> Word32 hashable-1.2.4.0/benchmarks/cbits/0000755000000000000000000000000012645773753015055 5ustar0000000000000000hashable-1.2.4.0/benchmarks/cbits/inthash.c0000644000000000000000000000076212645773753016664 0ustar0000000000000000#include /* * 32-bit hashes by Bob Jenkins. */ uint32_t hash_jenkins_32a(uint32_t a) { a = (a+0x7ed55d16) + (a<<12); a = (a^0xc761c23c) ^ (a>>19); a = (a+0x165667b1) + (a<<5); a = (a+0xd3a2646c) ^ (a<<9); a = (a+0xfd7046c5) + (a<<3); a = (a^0xb55a4f09) ^ (a>>16); return a; } uint32_t hash_jenkins_32b(uint32_t a) { a -= (a<<6); a ^= (a>>17); a -= (a<<9); a ^= (a<<4); a -= (a<<3); a ^= (a<<10); a ^= (a>>15); return a; } hashable-1.2.4.0/benchmarks/cbits/siphash-sse2.c0000644000000000000000000000763012645773753017540 0ustar0000000000000000/* * The original code was developed by Samuel Neves, and has been * only lightly modified. * * Used with permission. */ #pragma GCC target("sse2") #include #include "siphash.h" #define _mm_roti_epi64(x, c) ((16 == (c)) ? _mm_shufflelo_epi16((x), _MM_SHUFFLE(2,1,0,3)) : _mm_xor_si128(_mm_slli_epi64((x), (c)), _mm_srli_epi64((x), 64-(c)))) u64 hashable_siphash24_sse2(u64 ik0, u64 ik1, const u8 *m, size_t n) { __m128i v0, v1, v2, v3; __m128i k0, k1; __m128i mi, mask, len; size_t i, k; union { u64 gpr; __m128i xmm; } hash; const u8 *p; /* We used to use the _mm_seti_epi32 intrinsic to initialize SSE2 registers. This compiles to a movdqa instruction, which requires 16-byte alignment. On 32-bit Windows, it looks like ghc's runtime linker doesn't align ".rdata" sections as requested, so we got segfaults for our trouble. Now we use an intrinsic that cares less about alignment (_mm_loadu_si128, aka movdqu) instead, and all seems happy. */ static const u32 const iv[6][4] = { { 0x70736575, 0x736f6d65, 0, 0 }, { 0x6e646f6d, 0x646f7261, 0, 0 }, { 0x6e657261, 0x6c796765, 0, 0 }, { 0x79746573, 0x74656462, 0, 0 }, { -1, -1, 0, 0 }, { 255, 0, 0, 0 }, }; k0 = _mm_loadl_epi64((__m128i*)(&ik0)); k1 = _mm_loadl_epi64((__m128i*)(&ik1)); v0 = _mm_xor_si128(k0, _mm_loadu_si128((__m128i*) &iv[0])); v1 = _mm_xor_si128(k1, _mm_loadu_si128((__m128i*) &iv[1])); v2 = _mm_xor_si128(k0, _mm_loadu_si128((__m128i*) &iv[2])); v3 = _mm_xor_si128(k1, _mm_loadu_si128((__m128i*) &iv[3])); #define HALF_ROUND(a,b,c,d,s,t) \ do \ { \ a = _mm_add_epi64(a, b); c = _mm_add_epi64(c, d); \ b = _mm_roti_epi64(b, s); d = _mm_roti_epi64(d, t); \ b = _mm_xor_si128(b, a); d = _mm_xor_si128(d, c); \ } while(0) #define COMPRESS(v0,v1,v2,v3) \ do \ { \ HALF_ROUND(v0,v1,v2,v3,13,16); \ v0 = _mm_shufflelo_epi16(v0, _MM_SHUFFLE(1,0,3,2)); \ HALF_ROUND(v2,v1,v0,v3,17,21); \ v2 = _mm_shufflelo_epi16(v2, _MM_SHUFFLE(1,0,3,2)); \ } while(0) for(i = 0; i < (n-n%8); i += 8) { mi = _mm_loadl_epi64((__m128i*)(m + i)); v3 = _mm_xor_si128(v3, mi); if (SIPHASH_ROUNDS == 2) { COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3); } else { for (k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3); } v0 = _mm_xor_si128(v0, mi); } p = m + n; /* We must be careful to not trigger a segfault by reading an unmapped page. So where is the end of our input? */ if (((uintptr_t) p & 4095) == 0) /* Exactly at a page boundary: do not read past the end. */ mi = _mm_setzero_si128(); else if (((uintptr_t) p & 4095) <= 4088) /* Inside a page: safe to read past the end, as we'll mask out any bits we shouldn't have looked at below. */ mi = _mm_loadl_epi64((__m128i*)(m + i)); else /* Within 8 bytes of the end of a page: ensure that our final read re-reads some bytes so that we do not cross the page boundary, then shift our result right so that the re-read bytes vanish. */ mi = _mm_srli_epi64(_mm_loadl_epi64((__m128i*)(((uintptr_t) m + i) & ~7)), 8 * (((uintptr_t) m + i) % 8)); len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0); mask = _mm_srli_epi64(_mm_loadu_si128((__m128i*) &iv[4]), 8*(8-n%8)); mi = _mm_xor_si128(_mm_and_si128(mi, mask), len); v3 = _mm_xor_si128(v3, mi); if (SIPHASH_ROUNDS == 2) { COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3); } else { for (k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3); } v0 = _mm_xor_si128(v0, mi); v2 = _mm_xor_si128(v2, _mm_loadu_si128((__m128i*) &iv[5])); if (SIPHASH_FINALROUNDS == 4) { COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3); } else { for (k = 0; k < SIPHASH_FINALROUNDS; ++k) COMPRESS(v0,v1,v2,v3); } v0 = _mm_xor_si128(_mm_xor_si128(v0, v1), _mm_xor_si128(v2, v3)); hash.xmm = v0; #undef COMPRESS #undef HALF_ROUND //return _mm_extract_epi32(v0, 0) | (((u64)_mm_extract_epi32(v0, 1)) << 32); return hash.gpr; } hashable-1.2.4.0/benchmarks/cbits/siphash-sse41.c0000644000000000000000000000505012645773753017615 0ustar0000000000000000/* * The original code was developed by Samuel Neves, and has been * only lightly modified. * * Used with permission. */ #pragma GCC target("sse4.1") #include #include "siphash.h" // Specialized for siphash, do not reuse #define rotate16(x) _mm_shufflehi_epi16((x), _MM_SHUFFLE(2,1,0,3)) #define _mm_roti_epi64(x, c) (((c) == 16) ? rotate16((x)) : _mm_xor_si128(_mm_slli_epi64((x), (c)), _mm_srli_epi64((x), 64-(c)))) //#define _mm_roti_epi64(x, c) _mm_xor_si128(_mm_slli_epi64((x), (c)), _mm_srli_epi64((x), 64-(c))) u64 hashable_siphash24_sse41(u64 _k0, u64 _k1, const unsigned char *m, size_t n) { __m128i v0, v1, v02, v13; __m128i k0; __m128i mi, mask, len, h; const __m128i zero = _mm_setzero_si128(); size_t i, k; union { u64 gpr; __m128i xmm; } hash; unsigned char key[16]; ((u64 *)key)[0] = _k0; ((u64 *)key)[1] = _k1; k0 = _mm_loadu_si128((__m128i*)(key + 0)); v0 = _mm_xor_si128(k0, _mm_set_epi32(0x646f7261, 0x6e646f6d, 0x736f6d65, 0x70736575)); v1 = _mm_xor_si128(k0, _mm_set_epi32(0x74656462, 0x79746573, 0x6c796765, 0x6e657261)); v02 = _mm_unpacklo_epi64(v0, v1); v13 = _mm_unpackhi_epi64(v0, v1); #define HALF_ROUND(a,b,s,t) \ do \ { \ __m128i b1,b2; \ a = _mm_add_epi64(a, b); \ b1 = _mm_roti_epi64(b, s); b2 = _mm_roti_epi64(b, t); b = _mm_blend_epi16(b1, b2, 0xF0); \ b = _mm_xor_si128(b, a); \ } while(0) #define COMPRESS(v02,v13) \ do \ { \ HALF_ROUND(v02,v13,13,16); \ v02 = _mm_shuffle_epi32(v02, _MM_SHUFFLE(0,1,3,2)); \ HALF_ROUND(v02,v13,17,21); \ v02 = _mm_shuffle_epi32(v02, _MM_SHUFFLE(0,1,3,2)); \ } while(0) for(i = 0; i < (n-n%8); i += 8) { mi = _mm_loadl_epi64((__m128i*)(m + i)); v13 = _mm_xor_si128(v13, _mm_unpacklo_epi64(zero, mi)); for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v02,v13); v02 = _mm_xor_si128(v02, mi); } mi = _mm_loadl_epi64((__m128i*)(m + i)); len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0); mask = _mm_srli_epi64(_mm_set_epi32(0, 0, 0xffffffff, 0xffffffff), 8*(8-n%8)); mi = _mm_xor_si128(_mm_and_si128(mi, mask), len); v13 = _mm_xor_si128(v13, _mm_unpacklo_epi64(zero, mi)); for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v02,v13); v02 = _mm_xor_si128(v02, mi); v02 = _mm_xor_si128(v02, _mm_set_epi32(0, 0xff, 0, 0)); for(k = 0; k < SIPHASH_FINALROUNDS; ++k) COMPRESS(v02,v13); v0 = _mm_xor_si128(v02, v13); v0 = _mm_xor_si128(v0, _mm_castps_si128(_mm_movehl_ps(_mm_castsi128_ps(zero), _mm_castsi128_ps(v0)))); hash.xmm = v0; #undef COMPRESS #undef HALF_ROUND //return _mm_extract_epi32(v0, 0) | (((u64)_mm_extract_epi32(v0, 1)) << 32); return hash.gpr; } hashable-1.2.4.0/benchmarks/cbits/siphash.c0000644000000000000000000001235512645773753016666 0ustar0000000000000000/* Almost a verbatim copy of the reference implementation. */ #include #include "siphash.h" #define ROTL(x,b) (u64)(((x) << (b)) | ((x) >> (64 - (b)))) #define SIPROUND \ do { \ v0 += v1; v1=ROTL(v1,13); v1 ^= v0; v0=ROTL(v0,32); \ v2 += v3; v3=ROTL(v3,16); v3 ^= v2; \ v0 += v3; v3=ROTL(v3,21); v3 ^= v0; \ v2 += v1; v1=ROTL(v1,17); v1 ^= v2; v2=ROTL(v2,32); \ } while(0) #if defined(__i386) # define _siphash24 plain_siphash24 #endif static inline u64 odd_read(const u8 *p, int count, u64 val, int shift) { switch (count) { case 7: val |= ((u64)p[6]) << (shift + 48); case 6: val |= ((u64)p[5]) << (shift + 40); case 5: val |= ((u64)p[4]) << (shift + 32); case 4: val |= ((u64)p[3]) << (shift + 24); case 3: val |= ((u64)p[2]) << (shift + 16); case 2: val |= ((u64)p[1]) << (shift + 8); case 1: val |= ((u64)p[0]) << shift; } return val; } static inline u64 _siphash(int c, int d, u64 k0, u64 k1, const u8 *str, size_t len) { u64 v0 = 0x736f6d6570736575ull ^ k0; u64 v1 = 0x646f72616e646f6dull ^ k1; u64 v2 = 0x6c7967656e657261ull ^ k0; u64 v3 = 0x7465646279746573ull ^ k1; const u8 *end, *p; u64 b; int i; for (p = str, end = str + (len & ~7); p < end; p += 8) { u64 m = peek_u64le((u64 *) p); v3 ^= m; if (c == 2) { SIPROUND; SIPROUND; } else { for (i = 0; i < c; i++) SIPROUND; } v0 ^= m; } b = odd_read(p, len & 7, ((u64) len) << 56, 0); v3 ^= b; if (c == 2) { SIPROUND; SIPROUND; } else { for (i = 0; i < c; i++) SIPROUND; } v0 ^= b; v2 ^= 0xff; if (d == 4) { SIPROUND; SIPROUND; SIPROUND; SIPROUND; } else { for (i = 0; i < d; i++) SIPROUND; } b = v0 ^ v1 ^ v2 ^ v3; return b; } static inline u64 _siphash24(u64 k0, u64 k1, const u8 *str, size_t len) { return _siphash(2, 4, k0, k1, str, len); } #if defined(__i386) # undef _siphash24 static u64 (*_siphash24)(u64 k0, u64 k1, const u8 *, size_t); static void maybe_use_sse() __attribute__((constructor)); static void maybe_use_sse() { uint32_t eax = 1, ebx, ecx, edx; __asm volatile ("mov %%ebx, %%edi;" /* 32bit PIC: don't clobber ebx */ "cpuid;" "mov %%ebx, %%esi;" "mov %%edi, %%ebx;" :"+a" (eax), "=S" (ebx), "=c" (ecx), "=d" (edx) : :"edi"); #if defined(HAVE_SSE2) if (edx & (1 << 26)) _siphash24 = hashable_siphash24_sse2; #if defined(HAVE_SSE41) else if (ecx & (1 << 19)) _siphash24 = hashable_siphash24_sse41; #endif else #endif _siphash24 = plain_siphash24; } #endif /* ghci's linker fails to call static initializers. */ static inline void ensure_sse_init() { #if defined(__i386) if (_siphash24 == NULL) maybe_use_sse(); #endif } u64 hashable_siphash(int c, int d, u64 k0, u64 k1, const u8 *str, size_t len) { return _siphash(c, d, k0, k1, str, len); } u64 hashable_siphash24(u64 k0, u64 k1, const u8 *str, size_t len) { ensure_sse_init(); return _siphash24(k0, k1, str, len); } /* Used for ByteArray#s. We can't treat them like pointers in native Haskell, but we can in unsafe FFI calls. */ u64 hashable_siphash24_offset(u64 k0, u64 k1, const u8 *str, size_t off, size_t len) { ensure_sse_init(); return _siphash24(k0, k1, str + off, len); } static int _siphash_chunk(int c, int d, int buffered, u64 v[5], const u8 *str, size_t len, size_t totallen) { u64 v0 = v[0], v1 = v[1], v2 = v[2], v3 = v[3], m, b; const u8 *p, *end; u64 carry = 0; int i; if (buffered > 0) { int unbuffered = 8 - buffered; int tobuffer = unbuffered > len ? len : unbuffered; int shift = buffered << 3; m = odd_read(str, tobuffer, v[4], shift); str += tobuffer; buffered += tobuffer; len -= tobuffer; if (buffered < 8) carry = m; else { v3 ^= m; if (c == 2) { SIPROUND; SIPROUND; } else { for (i = 0; i < c; i++) SIPROUND; } v0 ^= m; buffered = 0; m = 0; } } for (p = str, end = str + (len & ~7); p < end; p += 8) { m = peek_u64le((u64 *) p); v3 ^= m; if (c == 2) { SIPROUND; SIPROUND; } else { for (i = 0; i < c; i++) SIPROUND; } v0 ^= m; } b = odd_read(p, len & 7, 0, 0); if (totallen == -1) { v[0] = v0; v[1] = v1; v[2] = v2; v[3] = v3; v[4] = b | carry; return buffered + (len & 7); } b |= ((u64) totallen) << 56; v3 ^= b; if (c == 2) { SIPROUND; SIPROUND; } else { for (i = 0; i < c; i++) SIPROUND; } v0 ^= b; v2 ^= 0xff; if (d == 4) { SIPROUND; SIPROUND; SIPROUND; SIPROUND; } else { for (i = 0; i < d; i++) SIPROUND; } v[4] = v0 ^ v1 ^ v2 ^ v3; return 0; } void hashable_siphash_init(u64 k0, u64 k1, u64 *v) { v[0] = 0x736f6d6570736575ull ^ k0; v[1] = 0x646f72616e646f6dull ^ k1; v[2] = 0x6c7967656e657261ull ^ k0; v[3] = 0x7465646279746573ull ^ k1; v[4] = 0; } int hashable_siphash24_chunk(int buffered, u64 v[5], const u8 *str, size_t len, size_t totallen) { return _siphash_chunk(2, 4, buffered, v, str, len, totallen); } /* * Used for ByteArray#. */ int hashable_siphash24_chunk_offset(int buffered, u64 v[5], const u8 *str, size_t off, size_t len, size_t totallen) { return _siphash_chunk(2, 4, buffered, v, str + off, len, totallen); } hashable-1.2.4.0/benchmarks/cbits/wang.c0000644000000000000000000000131612645773753016156 0ustar0000000000000000/* * These hash functions were developed by Thomas Wang. * * http://www.concentric.net/~ttwang/tech/inthash.htm */ #include uint32_t hashable_wang_32(uint32_t a) { a = (a ^ 61) ^ (a >> 16); a = a + (a << 3); a = a ^ (a >> 4); a = a * 0x27d4eb2d; a = a ^ (a >> 15); return a; } uint64_t hashable_wang_64(uint64_t key) { key = (~key) + (key << 21); // key = (key << 21) - key - 1; key = key ^ ((key >> 24) | (key << 40)); key = (key + (key << 3)) + (key << 8); // key * 265 key = key ^ ((key >> 14) | (key << 50)); key = (key + (key << 2)) + (key << 4); // key * 21 key = key ^ ((key >> 28) | (key << 36)); key = key + (key << 31); return key; } hashable-1.2.4.0/cbits/0000755000000000000000000000000012645773753012740 5ustar0000000000000000hashable-1.2.4.0/cbits/fnv.c0000644000000000000000000000411112645773753013672 0ustar0000000000000000/* Copyright Johan Tibell 2011 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Johan Tibell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* FNV-1 hash * * The FNV-1 hash description: http://isthe.com/chongo/tech/comp/fnv/ * The FNV-1 hash is public domain: http://isthe.com/chongo/tech/comp/fnv/#public_domain */ long hashable_fnv_hash(const unsigned char* str, long len, long hash) { while (len--) { hash = (hash * 16777619) ^ *str++; } return hash; } /* Used for ByteArray#s. We can't treat them like pointers in native Haskell, but we can in unsafe FFI calls. */ long hashable_fnv_hash_offset(const unsigned char* str, long offset, long len, long hash) { return hashable_fnv_hash(str + offset, len, hash); } hashable-1.2.4.0/cbits/getRandomBytes.c0000644000000000000000000000506212645773753016036 0ustar0000000000000000/* Copyright Bryan O'Sullivan 2012 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Johan Tibell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "MachDeps.h" int hashable_getRandomBytes(unsigned char *dest, int nbytes); #if defined(mingw32_HOST_OS) || defined(__MINGW32__) #include #include int hashable_getRandomBytes(unsigned char *dest, int nbytes) { HCRYPTPROV hCryptProv; int ret; if (!CryptAcquireContextA(&hCryptProv, NULL, NULL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) return -1; ret = CryptGenRandom(hCryptProv, (DWORD) nbytes, (BYTE *) dest) ? nbytes : -1; CryptReleaseContext(hCryptProv, 0); bail: return ret; } #else #include #include #include /* Assumptions: /dev/urandom exists and does something sane, and does not block. */ int hashable_getRandomBytes(unsigned char *dest, int nbytes) { ssize_t off, nread; int fd; fd = open("/dev/urandom", O_RDONLY); if (fd == -1) return -1; for (off = 0; nbytes > 0; nbytes -= nread) { nread = read(fd, dest + off, nbytes); off += nread; if (nread == -1) { off = -1; break; } } bail: close(fd); return off; } #endif hashable-1.2.4.0/Data/0000755000000000000000000000000012645773753012505 5ustar0000000000000000hashable-1.2.4.0/Data/Hashable.hs0000644000000000000000000001474212645773753014560 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------ -- | -- Module : Data.Hashable -- Copyright : (c) Milan Straka 2010 -- (c) Johan Tibell 2011 -- (c) Bryan O'Sullivan 2011, 2012 -- License : BSD-style -- Maintainer : johan.tibell@gmail.com -- Stability : provisional -- Portability : portable -- -- This module defines a class, 'Hashable', for types that can be -- converted to a hash value. This class exists for the benefit of -- hashing-based data structures. The module provides instances for -- most standard types. Efficient instances for other types can be -- generated automatically and effortlessly using the generics support -- in GHC 7.2 and above. -- -- The easiest way to get started is to use the 'hash' function. Here -- is an example session with @ghci@. -- -- > ghci> import Data.Hashable -- > ghci> hash "foo" -- > 60853164 module Data.Hashable ( -- * Hashing and security -- $security -- * Computing hash values Hashable(..) -- * Creating new instances -- | There are two ways to create new instances: by deriving -- instances automatically using GHC's generic programming -- support or by writing instances manually. -- ** Generic instances -- $generics -- *** Understanding a compiler error -- $generic_err -- ** Writing instances by hand -- $blocks -- *** Hashing contructors with multiple fields -- $multiple-fields -- *** Hashing types with multiple constructors -- $multiple-ctors , hashUsing , hashPtr , hashPtrWithSalt #if defined(__GLASGOW_HASKELL__) , hashByteArray , hashByteArrayWithSalt #endif ) where import Data.Hashable.Class #ifdef GENERICS import Data.Hashable.Generic () #endif -- $security -- #security# -- -- Applications that use hash-based data structures to store input -- from untrusted users can be susceptible to \"hash DoS\", a class of -- denial-of-service attack that uses deliberately chosen colliding -- inputs to force an application into unexpectedly behaving with -- quadratic time complexity. -- -- At this time, the string hashing functions used in this library are -- susceptible to such attacks and users are recommended to either use -- a 'Data.Map' to store keys derived from untrusted input or to use a -- hash function (e.g. SipHash) that's resistant to such attacks. A -- future version of this library might ship with such hash functions. -- $generics -- -- Beginning with GHC 7.2, the recommended way to make instances of -- 'Hashable' for most types is to use the compiler's support for -- automatically generating default instances. -- -- > {-# LANGUAGE DeriveGeneric #-} -- > -- > import GHC.Generics (Generic) -- > import Data.Hashable -- > -- > data Foo a = Foo a String -- > deriving (Eq, Generic) -- > -- > instance Hashable a => Hashable (Foo a) -- > -- > data Colour = Red | Green | Blue -- > deriving Generic -- > -- > instance Hashable Colour -- -- If you omit a body for the instance declaration, GHC will generate -- a default instance that correctly and efficiently hashes every -- constructor and parameter. -- $generic_err -- -- Suppose you intend to use the generic machinery to automatically -- generate a 'Hashable' instance. -- -- > data Oops = Oops -- > -- forgot to add "deriving Generic" here! -- > -- > instance Hashable Oops -- -- And imagine that, as in the example above, you forget to add a -- \"@deriving 'Generic'@\" clause to your data type. At compile time, -- you will get an error message from GHC that begins roughly as -- follows: -- -- > No instance for (GHashable (Rep Oops)) -- -- This error can be confusing, as 'GHashable' is not exported (it is -- an internal typeclass used by this library's generics machinery). -- The correct fix is simply to add the missing \"@deriving -- 'Generic'@\". -- $blocks -- -- To maintain high quality hashes, new 'Hashable' instances should be -- built using existing 'Hashable' instances, combinators, and hash -- functions. -- -- The functions below can be used when creating new instances of -- 'Hashable'. For example, for many string-like types the -- 'hashWithSalt' method can be defined in terms of either -- 'hashPtrWithSalt' or 'hashByteArrayWithSalt'. Here's how you could -- implement an instance for the 'B.ByteString' data type, from the -- @bytestring@ package: -- -- > import qualified Data.ByteString as B -- > import qualified Data.ByteString.Internal as B -- > import qualified Data.ByteString.Unsafe as B -- > import Data.Hashable -- > import Foreign.Ptr (castPtr) -- > -- > instance Hashable B.ByteString where -- > hashWithSalt salt bs = B.inlinePerformIO $ -- > B.unsafeUseAsCStringLen bs $ \(p, len) -> -- > hashPtrWithSalt p (fromIntegral len) salt -- $multiple-fields -- -- Hash constructors with multiple fields by chaining 'hashWithSalt': -- -- > data Date = Date Int Int Int -- > -- > instance Hashable Date where -- > hashWithSalt s (Date yr mo dy) = -- > s `hashWithSalt` -- > yr `hashWithSalt` -- > mo `hashWithSalt` dy -- -- If you need to chain hashes together, use 'hashWithSalt' and follow -- this recipe: -- -- > combineTwo h1 h2 = h1 `hashWithSalt` h2 -- $multiple-ctors -- -- For a type with several value constructors, there are a few -- possible approaches to writing a 'Hashable' instance. -- -- If the type is an instance of 'Enum', the easiest path is to -- convert it to an 'Int', and use the existing 'Hashable' instance -- for 'Int'. -- -- > data Color = Red | Green | Blue -- > deriving Enum -- > -- > instance Hashable Color where -- > hashWithSalt = hashUsing fromEnum -- -- If the type's constructors accept parameters, it is important to -- distinguish the constructors. To distinguish the constructors, add -- a different integer to the hash computation of each constructor: -- -- > data Time = Days Int -- > | Weeks Int -- > | Months Int -- > -- > instance Hashable Time where -- > hashWithSalt s (Days n) = s `hashWithSalt` -- > (0::Int) `hashWithSalt` n -- > hashWithSalt s (Weeks n) = s `hashWithSalt` -- > (1::Int) `hashWithSalt` n -- > hashWithSalt s (Months n) = s `hashWithSalt` -- > (2::Int) `hashWithSalt` n hashable-1.2.4.0/Data/Hashable/0000755000000000000000000000000012645773753014214 5ustar0000000000000000hashable-1.2.4.0/Data/Hashable/Class.hs0000644000000000000000000005075512645773753015631 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, ScopedTypeVariables, UnliftedFFITypes #-} #ifdef GENERICS {-# LANGUAGE DefaultSignatures, FlexibleContexts #-} #endif ------------------------------------------------------------------------ -- | -- Module : Data.Hashable.Class -- Copyright : (c) Milan Straka 2010 -- (c) Johan Tibell 2011 -- (c) Bryan O'Sullivan 2011, 2012 -- License : BSD-style -- Maintainer : johan.tibell@gmail.com -- Stability : provisional -- Portability : portable -- -- This module defines a class, 'Hashable', for types that can be -- converted to a hash value. This class exists for the benefit of -- hashing-based data structures. The module provides instances for -- most standard types. module Data.Hashable.Class ( -- * Computing hash values Hashable(..) #ifdef GENERICS -- ** Support for generics , GHashable(..) #endif -- * Creating new instances , hashUsing , hashPtr , hashPtrWithSalt , hashByteArray , hashByteArrayWithSalt ) where import Control.Exception (assert) import Data.Bits (shiftL, shiftR, xor) import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Unsafe as B import Data.Int (Int8, Int16, Int32, Int64) import Data.List (foldl') import Data.Ratio (Ratio, denominator, numerator) import qualified Data.Text as T import qualified Data.Text.Array as TA import qualified Data.Text.Internal as T import qualified Data.Text.Lazy as TL import Data.Typeable import Data.Version (Version(..)) import Data.Word (Word8, Word16, Word32, Word64) import Foreign.C (CString) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (alignment, peek, sizeOf) import GHC.Base (ByteArray#) import GHC.Conc (ThreadId(..)) import GHC.Prim (ThreadId#) import System.IO.Unsafe (unsafePerformIO) import System.Mem.StableName import Data.Unique (Unique, hashUnique) #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) #endif #ifdef GENERICS import GHC.Generics #endif #if __GLASGOW_HASKELL__ >= 710 import GHC.Fingerprint.Type(Fingerprint(..)) #elif __GLASGOW_HASKELL__ >= 702 import Data.Typeable.Internal(TypeRep(..)) import GHC.Fingerprint.Type(Fingerprint(..)) #endif #if __GLASGOW_HASKELL__ >= 703 import Foreign.C (CLong(..)) import Foreign.C.Types (CInt(..)) #else import Foreign.C (CLong) import Foreign.C.Types (CInt) #endif #if !(MIN_VERSION_base(4,8,0)) import Data.Word (Word) #endif #if MIN_VERSION_base(4,7,0) import Data.Bits (finiteBitSize) #else import Data.Bits (bitSize) #endif #if !(MIN_VERSION_bytestring(0,10,0)) import qualified Data.ByteString.Lazy.Internal as BL -- foldlChunks #endif #if MIN_VERSION_bytestring(0,10,4) import qualified Data.ByteString.Short.Internal as BSI #endif #ifdef VERSION_integer_gmp # if MIN_VERSION_integer_gmp(1,0,0) # define MIN_VERSION_integer_gmp_1_0_0 # endif import GHC.Exts (Int(..)) import GHC.Integer.GMP.Internals (Integer(..)) # if defined(MIN_VERSION_integer_gmp_1_0_0) import GHC.Exts (sizeofByteArray#) import GHC.Integer.GMP.Internals (BigNat(BN#)) # endif #endif #if MIN_VERSION_base(4,8,0) import Data.Void (Void, absurd) import GHC.Natural (Natural(..)) import GHC.Exts (Word(..)) #endif #if MIN_VERSION_base(4,9,0) import qualified Data.List.NonEmpty as NE import Data.Semigroup #endif #include "MachDeps.h" infixl 0 `hashWithSalt` ------------------------------------------------------------------------ -- * Computing hash values -- | A default salt used in the implementation of 'hash'. defaultSalt :: Int #if WORD_SIZE_IN_BITS == 64 defaultSalt = -2578643520546668380 -- 0xdc36d1615b7400a4 #else defaultSalt = 0x087fc72c #endif {-# INLINE defaultSalt #-} -- | The class of types that can be converted to a hash value. -- -- Minimal implementation: 'hashWithSalt'. class Hashable a where -- | Return a hash value for the argument, using the given salt. -- -- The general contract of 'hashWithSalt' is: -- -- * If two values are equal according to the '==' method, then -- applying the 'hashWithSalt' method on each of the two values -- /must/ produce the same integer result if the same salt is -- used in each case. -- -- * It is /not/ required that if two values are unequal -- according to the '==' method, then applying the -- 'hashWithSalt' method on each of the two values must produce -- distinct integer results. However, the programmer should be -- aware that producing distinct integer results for unequal -- values may improve the performance of hashing-based data -- structures. -- -- * This method can be used to compute different hash values for -- the same input by providing a different salt in each -- application of the method. This implies that any instance -- that defines 'hashWithSalt' /must/ make use of the salt in -- its implementation. hashWithSalt :: Int -> a -> Int -- | Like 'hashWithSalt', but no salt is used. The default -- implementation uses 'hashWithSalt' with some default salt. -- Instances might want to implement this method to provide a more -- efficient implementation than the default implementation. hash :: a -> Int hash = hashWithSalt defaultSalt #ifdef GENERICS default hashWithSalt :: (Generic a, GHashable (Rep a)) => Int -> a -> Int hashWithSalt salt = ghashWithSalt salt . from -- | The class of types that can be generically hashed. class GHashable f where ghashWithSalt :: Int -> f a -> Int #endif -- Since we support a generic implementation of 'hashWithSalt' we -- cannot also provide a default implementation for that method for -- the non-generic instance use case. Instead we provide -- 'defaultHashWith'. defaultHashWithSalt :: Hashable a => Int -> a -> Int defaultHashWithSalt salt x = salt `combine` hash x -- | Transform a value into a 'Hashable' value, then hash the -- transformed value using the given salt. -- -- This is a useful shorthand in cases where a type can easily be -- mapped to another type that is already an instance of 'Hashable'. -- Example: -- -- > data Foo = Foo | Bar -- > deriving (Enum) -- > -- > instance Hashable Foo where -- > hashWithSalt = hashUsing fromEnum hashUsing :: (Hashable b) => (a -> b) -- ^ Transformation function. -> Int -- ^ Salt. -> a -- ^ Value to transform. -> Int hashUsing f salt x = hashWithSalt salt (f x) {-# INLINE hashUsing #-} instance Hashable Int where hash = id hashWithSalt = defaultHashWithSalt instance Hashable Int8 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Int16 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Int32 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Int64 where hash n #if MIN_VERSION_base(4,7,0) | finiteBitSize (undefined :: Int) == 64 = fromIntegral n #else | bitSize (undefined :: Int) == 64 = fromIntegral n #endif | otherwise = fromIntegral (fromIntegral n `xor` (fromIntegral n `shiftR` 32 :: Word64)) hashWithSalt = defaultHashWithSalt instance Hashable Word where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word8 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word16 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word32 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word64 where hash n #if MIN_VERSION_base(4,7,0) | finiteBitSize (undefined :: Int) == 64 = fromIntegral n #else | bitSize (undefined :: Int) == 64 = fromIntegral n #endif | otherwise = fromIntegral (n `xor` (n `shiftR` 32)) hashWithSalt = defaultHashWithSalt instance Hashable () where hash = fromEnum hashWithSalt = defaultHashWithSalt instance Hashable Bool where hash = fromEnum hashWithSalt = defaultHashWithSalt instance Hashable Ordering where hash = fromEnum hashWithSalt = defaultHashWithSalt instance Hashable Char where hash = fromEnum hashWithSalt = defaultHashWithSalt #if defined(MIN_VERSION_integer_gmp_1_0_0) instance Hashable BigNat where hashWithSalt salt (BN# ba) = hashByteArrayWithSalt ba 0 numBytes salt `hashWithSalt` size where size = numBytes `quot` SIZEOF_HSWORD numBytes = I# (sizeofByteArray# ba) #endif #if MIN_VERSION_base(4,8,0) instance Hashable Natural where # if defined(MIN_VERSION_integer_gmp_1_0_0) hash (NatS# n) = hash (W# n) hash (NatJ# bn) = hash bn hashWithSalt salt (NatS# n) = hashWithSalt salt (W# n) hashWithSalt salt (NatJ# bn) = hashWithSalt salt bn # else hash (Natural n) = hash n hashWithSalt salt (Natural n) = hashWithSalt salt n # endif #endif instance Hashable Integer where #if defined(VERSION_integer_gmp) # if defined(MIN_VERSION_integer_gmp_1_0_0) hash (S# n) = (I# n) hash (Jp# bn) = hash bn hash (Jn# bn) = negate (hash bn) hashWithSalt salt (S# n) = hashWithSalt salt (I# n) hashWithSalt salt (Jp# bn) = hashWithSalt salt bn hashWithSalt salt (Jn# bn) = negate (hashWithSalt salt bn) # else hash (S# int) = I# int hash n@(J# size# byteArray) | n >= minInt && n <= maxInt = fromInteger n :: Int | otherwise = let size = I# size# numBytes = SIZEOF_HSWORD * abs size in hashByteArrayWithSalt byteArray 0 numBytes defaultSalt `hashWithSalt` size where minInt = fromIntegral (minBound :: Int) maxInt = fromIntegral (maxBound :: Int) hashWithSalt salt (S# n) = hashWithSalt salt (I# n) hashWithSalt salt n@(J# size# byteArray) | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int) | otherwise = let size = I# size# numBytes = SIZEOF_HSWORD * abs size in hashByteArrayWithSalt byteArray 0 numBytes salt `hashWithSalt` size where minInt = fromIntegral (minBound :: Int) maxInt = fromIntegral (maxBound :: Int) # endif #else hashWithSalt salt = foldl' hashWithSalt salt . go where go n | inBounds n = [fromIntegral n :: Int] | otherwise = fromIntegral n : go (n `shiftR` WORD_SIZE_IN_BITS) maxInt = fromIntegral (maxBound :: Int) inBounds x = x >= fromIntegral (minBound :: Int) && x <= maxInt #endif #if MIN_VERSION_base(4,9,0) -- Starting with base-4.9, numerator/denominator don't need 'Integral' anymore instance Hashable a => Hashable (Ratio a) where #else instance (Integral a, Hashable a) => Hashable (Ratio a) where #endif {-# SPECIALIZE instance Hashable (Ratio Integer) #-} hash a = hash (numerator a) `hashWithSalt` denominator a hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a instance Hashable Float where hash x | isIEEE x = assert (sizeOf x >= sizeOf (0::Word32) && alignment x >= alignment (0::Word32)) $ hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word32) | otherwise = hash (show x) hashWithSalt = defaultHashWithSalt instance Hashable Double where hash x | isIEEE x = assert (sizeOf x >= sizeOf (0::Word64) && alignment x >= alignment (0::Word64)) $ hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word64) | otherwise = hash (show x) hashWithSalt = defaultHashWithSalt -- | A value with bit pattern (01)* (or 5* in hexa), for any size of Int. -- It is used as data constructor distinguisher. GHC computes its value during -- compilation. distinguisher :: Int distinguisher = fromIntegral $ (maxBound :: Word) `quot` 3 {-# INLINE distinguisher #-} instance Hashable a => Hashable (Maybe a) where hash Nothing = 0 hash (Just a) = distinguisher `hashWithSalt` a hashWithSalt s Nothing = s `combine` 0 hashWithSalt s (Just a) = s `combine` distinguisher `hashWithSalt` a instance (Hashable a, Hashable b) => Hashable (Either a b) where hash (Left a) = 0 `hashWithSalt` a hash (Right b) = distinguisher `hashWithSalt` b hashWithSalt s (Left a) = s `combine` 0 `hashWithSalt` a hashWithSalt s (Right b) = s `combine` distinguisher `hashWithSalt` b instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where hash (a1, a2) = hash a1 `hashWithSalt` a2 hashWithSalt s (a1, a2) = s `hashWithSalt` a1 `hashWithSalt` a2 instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 hashWithSalt s (a1, a2, a3) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable (a1, a2, a3, a4) where hash (a1, a2, a3, a4) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 hashWithSalt s (a1, a2, a3, a4) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) => Hashable (a1, a2, a3, a4, a5) where hash (a1, a2, a3, a4, a5) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 hashWithSalt s (a1, a2, a3, a4, a5) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where hash (a1, a2, a3, a4, a5, a6) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 hashWithSalt s (a1, a2, a3, a4, a5, a6) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6, Hashable a7) => Hashable (a1, a2, a3, a4, a5, a6, a7) where hash (a1, a2, a3, a4, a5, a6, a7) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 hashWithSalt s (a1, a2, a3, a4, a5, a6, a7) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 instance Hashable (StableName a) where hash = hashStableName hashWithSalt = defaultHashWithSalt -- Auxillary type for Hashable [a] definition data SPInt = SP !Int !Int instance Hashable a => Hashable [a] where {-# SPECIALIZE instance Hashable [Char] #-} hashWithSalt salt arr = finalise (foldl' step (SP salt 0) arr) where finalise (SP s l) = hashWithSalt s l step (SP s l) x = SP (hashWithSalt s x) (l + 1) instance Hashable B.ByteString where hashWithSalt salt bs = B.inlinePerformIO $ B.unsafeUseAsCStringLen bs $ \(p, len) -> hashPtrWithSalt p (fromIntegral len) salt instance Hashable BL.ByteString where hashWithSalt = BL.foldlChunks hashWithSalt #if MIN_VERSION_bytestring(0,10,4) instance Hashable BSI.ShortByteString where #if MIN_VERSION_base(4,3,0) hashWithSalt salt sbs@(BSI.SBS ba) = #else hashWithSalt salt sbs@(BSI.SBS ba _) = #endif hashByteArrayWithSalt ba 0 (BSI.length sbs) salt #endif instance Hashable T.Text where hashWithSalt salt (T.Text arr off len) = hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) salt instance Hashable TL.Text where hashWithSalt = TL.foldlChunks hashWithSalt -- | Compute the hash of a ThreadId. hashThreadId :: ThreadId -> Int hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int) foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt instance Hashable ThreadId where hash = hashThreadId hashWithSalt = defaultHashWithSalt -- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly. hashTypeRep :: TypeRep -> Int {-# INLINE hashTypeRep #-} #if __GLASGOW_HASKELL__ >= 710 -- Fingerprint is just the MD5, so taking any Int from it is fine hashTypeRep tr = let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x #elif __GLASGOW_HASKELL__ >= 702 -- Fingerprint is just the MD5, so taking any Int from it is fine hashTypeRep (TypeRep (Fingerprint x _) _ _) = fromIntegral x #elif __GLASGOW_HASKELL__ >= 606 hashTypeRep = B.inlinePerformIO . typeRepKey #else hashTypeRep = hash . show #endif instance Hashable TypeRep where hash = hashTypeRep hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} #if MIN_VERSION_base(4,8,0) instance Hashable Void where hashWithSalt _ = absurd #endif -- | Compute a hash value for the content of this pointer. hashPtr :: Ptr a -- ^ pointer to the data to hash -> Int -- ^ length, in bytes -> IO Int -- ^ hash value hashPtr p len = hashPtrWithSalt p len defaultSalt -- | Compute a hash value for the content of this pointer, using an -- initial salt. -- -- This function can for example be used to hash non-contiguous -- segments of memory as if they were one contiguous segment, by using -- the output of one hash as the salt for the next. hashPtrWithSalt :: Ptr a -- ^ pointer to the data to hash -> Int -- ^ length, in bytes -> Int -- ^ salt -> IO Int -- ^ hash value hashPtrWithSalt p len salt = fromIntegral `fmap` c_hashCString (castPtr p) (fromIntegral len) (fromIntegral salt) foreign import ccall unsafe "hashable_fnv_hash" c_hashCString :: CString -> CLong -> CLong -> IO CLong -- | Compute a hash value for the content of this 'ByteArray#', -- beginning at the specified offset, using specified number of bytes. hashByteArray :: ByteArray# -- ^ data to hash -> Int -- ^ offset, in bytes -> Int -- ^ length, in bytes -> Int -- ^ hash value hashByteArray ba0 off len = hashByteArrayWithSalt ba0 off len defaultSalt {-# INLINE hashByteArray #-} -- | Compute a hash value for the content of this 'ByteArray#', using -- an initial salt. -- -- This function can for example be used to hash non-contiguous -- segments of memory as if they were one contiguous segment, by using -- the output of one hash as the salt for the next. hashByteArrayWithSalt :: ByteArray# -- ^ data to hash -> Int -- ^ offset, in bytes -> Int -- ^ length, in bytes -> Int -- ^ salt -> Int -- ^ hash value hashByteArrayWithSalt ba !off !len !h = fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len) (fromIntegral h) foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray :: ByteArray# -> CLong -> CLong -> CLong -> CLong -- | Combine two given hash values. 'combine' has zero as a left -- identity. combine :: Int -> Int -> Int combine h1 h2 = (h1 * 16777619) `xor` h2 instance Hashable Unique where hash = hashUnique hashWithSalt = defaultHashWithSalt instance Hashable Version where hashWithSalt salt (Version branch tags) = salt `hashWithSalt` branch `hashWithSalt` tags #if MIN_VERSION_base(4,7,0) instance Hashable (Fixed a) where hashWithSalt salt (MkFixed i) = hashWithSalt salt i #endif -- instances formerly provided by 'semigroups' package #if MIN_VERSION_base(4,9,0) instance Hashable a => Hashable (NE.NonEmpty a) where hashWithSalt p (a NE.:| as) = p `hashWithSalt` a `hashWithSalt` as instance Hashable a => Hashable (Min a) where hashWithSalt p (Min a) = hashWithSalt p a instance Hashable a => Hashable (Max a) where hashWithSalt p (Max a) = hashWithSalt p a instance (Hashable a, Hashable b) => Hashable (Arg a b) where hashWithSalt p (Arg a b) = hashWithSalt p a `hashWithSalt` b instance Hashable a => Hashable (First a) where hashWithSalt p (First a) = hashWithSalt p a instance Hashable a => Hashable (Last a) where hashWithSalt p (Last a) = hashWithSalt p a instance Hashable a => Hashable (WrappedMonoid a) where hashWithSalt p (WrapMonoid a) = hashWithSalt p a instance Hashable a => Hashable (Option a) where hashWithSalt p (Option a) = hashWithSalt p a #endif hashable-1.2.4.0/Data/Hashable/Generic.hs0000644000000000000000000000443012645773753016125 0ustar0000000000000000{-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures, ScopedTypeVariables, TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ------------------------------------------------------------------------ -- | -- Module : Data.Hashable.Generic -- Copyright : (c) Bryan O'Sullivan 2012 -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : provisional -- Portability : GHC >= 7.2 -- -- Hashable support for GHC generics. module Data.Hashable.Generic ( ) where import Data.Bits (shiftR) import Data.Hashable.Class import GHC.Generics -- Type without constructors instance GHashable V1 where ghashWithSalt salt _ = hashWithSalt salt () -- Constructor without arguments instance GHashable U1 where ghashWithSalt salt U1 = hashWithSalt salt () instance (GHashable a, GHashable b) => GHashable (a :*: b) where ghashWithSalt salt (x :*: y) = salt `ghashWithSalt` x `ghashWithSalt` y -- Metadata (constructor name, etc) instance GHashable a => GHashable (M1 i c a) where ghashWithSalt salt = ghashWithSalt salt . unM1 -- Constants, additional parameters, and rank-1 recursion instance Hashable a => GHashable (K1 i a) where ghashWithSalt = hashUsing unK1 class GSum f where hashSum :: Int -> Int -> Int -> f a -> Int instance (GSum a, GSum b, SumSize a, SumSize b) => GHashable (a :+: b) where ghashWithSalt salt = hashSum salt 0 size where size = unTagged (sumSize :: Tagged (a :+: b)) instance (GSum a, GSum b) => GSum (a :+: b) where hashSum !salt !code !size s = case s of L1 x -> hashSum salt code sizeL x R1 x -> hashSum salt (code + sizeL) sizeR x where sizeL = size `shiftR` 1 sizeR = size - sizeL {-# INLINE hashSum #-} instance GHashable a => GSum (C1 c a) where hashSum !salt !code _ x = salt `hashWithSalt` code `ghashWithSalt` x {-# INLINE hashSum #-} class SumSize f where sumSize :: Tagged f newtype Tagged (s :: * -> *) = Tagged {unTagged :: Int} instance (SumSize a, SumSize b) => SumSize (a :+: b) where sumSize = Tagged $ unTagged (sumSize :: Tagged a) + unTagged (sumSize :: Tagged b) instance SumSize (C1 c a) where sumSize = Tagged 1 hashable-1.2.4.0/Data/Hashable/RandomSource.hs0000644000000000000000000000164412645773753017156 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif module Data.Hashable.RandomSource ( getRandomBytes , getRandomBytes_ ) where import Data.ByteString as B import Data.ByteString.Internal (create) import Foreign.C.Error (throwErrnoIfMinus1_) #if MIN_VERSION_base(4,5,0) import Foreign.C.Types (CInt(CInt)) #else import Foreign.C.Types (CInt) #endif import Foreign.Ptr (Ptr) getRandomBytes :: Int -> IO ByteString getRandomBytes nbytes | nbytes <= 0 = return B.empty | otherwise = create nbytes $ flip (getRandomBytes_ "getRandomBytes") nbytes getRandomBytes_ :: String -> Ptr a -> Int -> IO () getRandomBytes_ what ptr nbytes = do throwErrnoIfMinus1_ what $ c_getRandomBytes ptr (fromIntegral nbytes) foreign import ccall unsafe "hashable_getRandomBytes" c_getRandomBytes :: Ptr a -> CInt -> IO CInt hashable-1.2.4.0/Data/Hashable/SipHash.hs0000644000000000000000000001153212645773753016111 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Data.Hashable.SipHash ( LE64 , Sip , fromWord64 , fullBlock , lastBlock , finalize , hashByteString ) where #include "MachDeps.h" import Data.Bits ((.|.), (.&.), rotateL, shiftL, xor) #if MIN_VERSION_base(4,5,0) import Data.Bits (unsafeShiftL) #endif import Data.Word (Word8, Word64) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (Ptr, castPtr, plusPtr) import Data.ByteString.Internal (ByteString(PS), inlinePerformIO) import Foreign.Storable (peek) import Numeric (showHex) newtype LE64 = LE64 { fromLE64 :: Word64 } deriving (Eq) instance Show LE64 where show (LE64 !v) = let s = showHex v "" in "0x" ++ replicate (16 - length s) '0' ++ s data Sip = Sip { v0 :: {-# UNPACK #-} !Word64, v1 :: {-# UNPACK #-} !Word64 , v2 :: {-# UNPACK #-} !Word64, v3 :: {-# UNPACK #-} !Word64 } fromWord64 :: Word64 -> LE64 #ifndef WORDS_BIGENDIAN fromWord64 = LE64 #else #error big endian support TBD #endif initState :: (Sip -> r) -> Word64 -> Word64 -> r initState k k0 k1 = k (Sip s0 s1 s2 s3) where !s0 = (k0 `xor` 0x736f6d6570736575) !s1 = (k1 `xor` 0x646f72616e646f6d) !s2 = (k0 `xor` 0x6c7967656e657261) !s3 = (k1 `xor` 0x7465646279746573) sipRound :: (Sip -> r) -> Sip -> r sipRound k Sip{..} = k (Sip v0_c v1_d v2_c v3_d) where v0_a = v0 + v1 v2_a = v2 + v3 v1_a = v1 `rotateL` 13 v3_a = v3 `rotateL` 16 v1_b = v1_a `xor` v0_a v3_b = v3_a `xor` v2_a v0_b = v0_a `rotateL` 32 v2_b = v2_a + v1_b v0_c = v0_b + v3_b v1_c = v1_b `rotateL` 17 v3_c = v3_b `rotateL` 21 v1_d = v1_c `xor` v2_b v3_d = v3_c `xor` v0_c v2_c = v2_b `rotateL` 32 fullBlock :: Int -> LE64 -> (Sip -> r) -> Sip -> r fullBlock c m k st@Sip{..} | c == 2 = sipRound (sipRound k') st' | otherwise = runRounds c k' st' where k' st1@Sip{..} = k st1{ v0 = v0 `xor` fromLE64 m } st' = st{ v3 = v3 `xor` fromLE64 m } {-# INLINE fullBlock #-} runRounds :: Int -> (Sip -> r) -> Sip -> r runRounds c k = go 0 where go i st | i < c = sipRound (go (i+1)) st | otherwise = k st {-# INLINE runRounds #-} lastBlock :: Int -> Int -> LE64 -> (Sip -> r) -> Sip -> r lastBlock !c !len !m k st = #ifndef WORDS_BIGENDIAN fullBlock c (LE64 m') k st #else #error big endian support TBD #endif where m' = fromLE64 m .|. ((fromIntegral len .&. 0xff) `shiftL` 56) {-# INLINE lastBlock #-} finalize :: Int -> (Word64 -> r) -> Sip -> r finalize d k st@Sip{..} | d == 4 = sipRound (sipRound (sipRound (sipRound k'))) st' | otherwise = runRounds d k' st' where k' Sip{..} = k $! v0 `xor` v1 `xor` v2 `xor` v3 st' = st{ v2 = v2 `xor` 0xff } {-# INLINE finalize #-} hashByteString :: Int -> Int -> Word64 -> Word64 -> ByteString -> Word64 hashByteString !c !d k0 k1 (PS fp off len) = inlinePerformIO . withForeignPtr fp $ \basePtr -> let ptr0 = basePtr `plusPtr` off scant = len .&. 7 endBlocks = ptr0 `plusPtr` (len - scant) go !ptr st | ptr == endBlocks = readLast ptr | otherwise = do m <- peekLE64 ptr fullBlock c m (go (ptr `plusPtr` 8)) st where zero !m _ _ = lastBlock c len (LE64 m) (finalize d return) st one k m p s = do w <- fromIntegral `fmap` peekByte p k (m .|. (w `unsafeShiftL` s)) (p `plusPtr` 1) (s+8) readLast p = case scant of 0 -> zero 0 p (0::Int) 1 -> one zero 0 p 0 2 -> one (one zero) 0 p 0 3 -> one (one (one zero)) 0 p 0 4 -> one (one (one (one zero))) 0 p 0 5 -> one (one (one (one (one zero)))) 0 p 0 6 -> one (one (one (one (one (one zero))))) 0 p 0 _ -> one (one (one (one (one (one (one zero)))))) 0 p 0 in initState (go ptr0) k0 k1 peekByte :: Ptr Word8 -> IO Word8 peekByte = peek peekLE64 :: Ptr Word8 -> IO LE64 #if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH) -- platforms on which unaligned loads are legal and usually fast peekLE64 p = LE64 `fmap` peek (castPtr p) #else peekLE64 p = do let peek8 d = fromIntegral `fmap` peekByte (p `plusPtr` d) b0 <- peek8 0 b1 <- peek8 1 b2 <- peek8 2 b3 <- peek8 3 b4 <- peek8 4 b5 <- peek8 5 b6 <- peek8 6 b7 <- peek8 7 let !w = (b7 `shiftL` 56) .|. (b6 `shiftL` 48) .|. (b5 `shiftL` 40) .|. (b4 `shiftL` 32) .|. (b3 `shiftL` 24) .|. (b2 `shiftL` 16) .|. (b1 `shiftL` 8) .|. b0 return (fromWord64 w) #endif #if !(MIN_VERSION_base(4,5,0)) unsafeShiftL :: Word64 -> Int -> Word64 unsafeShiftL = shiftL #endif hashable-1.2.4.0/tests/0000755000000000000000000000000012645773753012776 5ustar0000000000000000hashable-1.2.4.0/tests/Main.hs0000644000000000000000000000057412645773753014224 0ustar0000000000000000-- | Tests for the 'Data.Hashable' module. We test functions by -- comparing the C and Haskell implementations. module Main (main) where import Properties (properties) import Regress (regressions) import Test.Framework (defaultMain, testGroup) main :: IO () main = defaultMain [ testGroup "properties" properties , testGroup "regressions" regressions ] hashable-1.2.4.0/tests/Properties.hs0000644000000000000000000002072712645773753015476 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash, Rank2Types, UnboxedTuples #-} #ifdef GENERICS {-# LANGUAGE DeriveGeneric, ScopedTypeVariables #-} #endif -- | QuickCheck tests for the 'Data.Hashable' module. We test -- functions by comparing the C and Haskell implementations. module Properties (properties) where import Data.Hashable (Hashable, hash, hashByteArray, hashPtr) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.List (nub) import Control.Monad (ap, liftM) import System.IO.Unsafe (unsafePerformIO) import Foreign.Marshal.Array (withArray) import GHC.Base (ByteArray#, Int(..), newByteArray#, unsafeCoerce#, writeWord8Array#) import GHC.ST (ST(..), runST) import GHC.Word (Word8(..)) import Test.QuickCheck hiding ((.&.)) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) #ifdef GENERICS import GHC.Generics #endif #if MIN_VERSION_bytestring(0,10,4) import qualified Data.ByteString.Short as BS #endif ------------------------------------------------------------------------ -- * Properties instance Arbitrary T.Text where arbitrary = T.pack `fmap` arbitrary instance Arbitrary TL.Text where arbitrary = TL.pack `fmap` arbitrary instance Arbitrary B.ByteString where arbitrary = B.pack `fmap` arbitrary instance Arbitrary BL.ByteString where arbitrary = sized $ \n -> resize (round (sqrt (toEnum n :: Double))) ((BL.fromChunks . map (B.pack . nonEmpty)) `fmap` arbitrary) where nonEmpty (NonEmpty a) = a #if MIN_VERSION_bytestring(0,10,4) instance Arbitrary BS.ShortByteString where arbitrary = BS.pack `fmap` arbitrary #endif -- | Validate the implementation by comparing the C and Haskell -- versions. pHash :: [Word8] -> Bool pHash xs = unsafePerformIO $ withArray xs $ \ p -> (hashByteArray (fromList xs) 0 len ==) `fmap` hashPtr p len where len = length xs -- | Content equality implies hash equality. pText :: T.Text -> T.Text -> Bool pText a b = if (a == b) then (hash a == hash b) else True -- | Content equality implies hash equality. pTextLazy :: TL.Text -> TL.Text -> Bool pTextLazy a b = if (a == b) then (hash a == hash b) else True -- | A small positive integer. newtype ChunkSize = ChunkSize { unCS :: Int } deriving (Eq, Ord, Num, Integral, Real, Enum) instance Show ChunkSize where show = show . unCS instance Arbitrary ChunkSize where arbitrary = (ChunkSize . (`mod` maxChunkSize)) `fmap` (arbitrary `suchThat` ((/=0) . (`mod` maxChunkSize))) where maxChunkSize = 16 -- | Ensure that the rechunk function causes a rechunked string to -- still match its original form. pTextRechunk :: T.Text -> NonEmptyList ChunkSize -> Bool pTextRechunk t cs = TL.fromStrict t == rechunkText t cs -- | Lazy strings must hash to the same value no matter how they are -- chunked. pTextLazyRechunked :: T.Text -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Bool pTextLazyRechunked t cs0 cs1 = hash (rechunkText t cs0) == hash (rechunkText t cs1) -- | Break up a string into chunks of different sizes. rechunkText :: T.Text -> NonEmptyList ChunkSize -> TL.Text rechunkText t0 (NonEmpty cs0) = TL.fromChunks . go t0 . cycle $ cs0 where go t _ | T.null t = [] go t (c:cs) = a : go b cs where (a,b) = T.splitAt (unCS c) t go _ [] = error "Properties.rechunk - The 'impossible' happened!" #if MIN_VERSION_bytestring(0,10,4) -- | Content equality implies hash equality. pBSShort :: BS.ShortByteString -> BS.ShortByteString -> Bool pBSShort a b = if (a == b) then (hash a == hash b) else True #endif -- | Content equality implies hash equality. pBS :: B.ByteString -> B.ByteString -> Bool pBS a b = if (a == b) then (hash a == hash b) else True -- | Content equality implies hash equality. pBSLazy :: BL.ByteString -> BL.ByteString -> Bool pBSLazy a b = if (a == b) then (hash a == hash b) else True -- | Break up a string into chunks of different sizes. rechunkBS :: B.ByteString -> NonEmptyList ChunkSize -> BL.ByteString rechunkBS t0 (NonEmpty cs0) = BL.fromChunks . go t0 . cycle $ cs0 where go t _ | B.null t = [] go t (c:cs) = a : go b cs where (a,b) = B.splitAt (unCS c) t go _ [] = error "Properties.rechunkBS - The 'impossible' happened!" -- | Ensure that the rechunk function causes a rechunked string to -- still match its original form. pBSRechunk :: B.ByteString -> NonEmptyList ChunkSize -> Bool pBSRechunk t cs = fromStrict t == rechunkBS t cs -- | Lazy bytestrings must hash to the same value no matter how they -- are chunked. pBSLazyRechunked :: B.ByteString -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Bool pBSLazyRechunked t cs1 cs2 = hash (rechunkBS t cs1) == hash (rechunkBS t cs2) -- This wrapper is required by 'runST'. data ByteArray = BA { unBA :: ByteArray# } -- | Create a 'ByteArray#' from a list of 'Word8' values. fromList :: [Word8] -> ByteArray# fromList xs0 = unBA (runST $ ST $ \ s1# -> case newByteArray# len# s1# of (# s2#, marr# #) -> case go s2# 0 marr# xs0 of s3# -> (# s3#, BA (unsafeCoerce# marr#) #)) where !(I# len#) = length xs0 go s# _ _ [] = s# go s# i@(I# i#) marr# ((W8# x):xs) = case writeWord8Array# marr# i# x s# of s2# -> go s2# (i + 1) marr# xs -- Generics #ifdef GENERICS data Product2 a b = Product2 a b deriving (Generic) instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where arbitrary = Product2 `liftM` arbitrary `ap` arbitrary instance (Hashable a, Hashable b) => Hashable (Product2 a b) data Product3 a b c = Product3 a b c deriving (Generic) instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Product3 a b c) where arbitrary = Product3 `liftM` arbitrary `ap` arbitrary `ap` arbitrary instance (Hashable a, Hashable b, Hashable c) => Hashable (Product3 a b c) -- Hashes of all product types of the same shapes should be the same. pProduct2 :: Int -> String -> Bool pProduct2 x y = hash (x, y) == hash (Product2 x y) pProduct3 :: Double -> Maybe Bool -> (Int, String) -> Bool pProduct3 x y z = hash (x, y, z) == hash (Product3 x y z) data Sum2 a b = S2a a | S2b b deriving (Eq, Ord, Show, Generic) instance (Hashable a, Hashable b) => Hashable (Sum2 a b) data Sum3 a b c = S3a a | S3b b | S3c c deriving (Eq, Ord, Show, Generic) instance (Hashable a, Hashable b, Hashable c) => Hashable (Sum3 a b c) -- Hashes of the same parameter, but with different sum constructors, -- should differ. (They might legitimately collide, but that's -- vanishingly unlikely.) pSum2_differ :: Int -> Bool pSum2_differ x = nub hs == hs where hs = [ hash (S2a x :: Sum2 Int Int) , hash (S2b x :: Sum2 Int Int) ] pSum3_differ :: Int -> Bool pSum3_differ x = nub hs == hs where hs = [ hash (S3a x :: Sum3 Int Int Int) , hash (S3b x :: Sum3 Int Int Int) , hash (S3c x :: Sum3 Int Int Int) ] #endif properties :: [Test] properties = [ testProperty "bernstein" pHash , testGroup "text" [ testProperty "text/strict" pText , testProperty "text/lazy" pTextLazy , testProperty "text/rechunk" pTextRechunk , testProperty "text/rechunked" pTextLazyRechunked ] , testGroup "bytestring" [ testProperty "bytestring/strict" pBS , testProperty "bytestring/lazy" pBSLazy #if MIN_VERSION_bytestring(0,10,4) , testProperty "bytestring/short" pBSShort #endif , testProperty "bytestring/rechunk" pBSRechunk , testProperty "bytestring/rechunked" pBSLazyRechunked ] #ifdef GENERICS , testGroup "generics" [ -- Note: "product2" and "product3" have been temporarily -- disabled until we have added a 'hash' method to the GHashable -- class. Until then (a,b) hashes to a different value than (a -- :*: b). While this is not incorrect, it would be nicer if -- they didn't. testProperty "product2" pProduct2 , testProperty -- "product3" pProduct3 testProperty "sum2_differ" pSum2_differ , testProperty "sum3_differ" pSum3_differ ] #endif ] ------------------------------------------------------------------------ -- Utilities fromStrict :: B.ByteString -> BL.ByteString #if MIN_VERSION_bytestring(0,10,0) fromStrict = BL.fromStrict #else fromStrict b = BL.fromChunks [b] #endif hashable-1.2.4.0/tests/Regress.hs0000644000000000000000000000040212645773753014740 0ustar0000000000000000{-# LANGUAGE CPP #-} module Regress (regressions) where import qualified Test.Framework as F #ifdef HAVE_MMAP import qualified Regress.Mmap as Mmap #endif regressions :: [F.Test] regressions = [] #ifdef HAVE_MMAP ++ Mmap.regressions #endif hashable-1.2.4.0/tests/Regress/0000755000000000000000000000000012645773753014410 5ustar0000000000000000hashable-1.2.4.0/tests/Regress/Mmap.hsc0000644000000000000000000000456012645773753016006 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Regress.Mmap (regressions) where #include import Control.Exception (bracket, evaluate) import Control.Monad (forM_) import Data.Bits ((.|.)) import Data.ByteString.Internal (ByteString(..)) import Data.Hashable (hash) import Foreign.C.Error (throwErrnoIf, throwErrnoIfMinus1, throwErrnoIfMinus1_) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.Ptr (Ptr, intPtrToPtr, nullPtr, plusPtr) import GHC.ForeignPtr (newForeignPtr_) import System.Posix.Types (COff(..)) import Test.Framework (Test) import Test.Framework.Providers.HUnit (testCase) import qualified Data.ByteString as B withMapping :: (Ptr a -> Int -> IO ()) -> IO () withMapping go = do pageSize <- fromIntegral `fmap` getPageSize let mappingSize = pageSize * 2 bracket (mmap nullPtr mappingSize ((#const PROT_READ) .|. (#const PROT_WRITE)) ((#const MAP_ANON) .|. (#const MAP_PRIVATE)) (-1) 0) (flip munmap mappingSize) $ \mappingPtr -> do go mappingPtr (fromIntegral pageSize) mprotect (mappingPtr `plusPtr` fromIntegral pageSize) pageSize (#const PROT_NONE) hashNearPageBoundary :: IO () hashNearPageBoundary = withMapping $ \ptr pageSize -> do let initialSize = 16 fp <- newForeignPtr_ (ptr `plusPtr` (pageSize - initialSize)) let bs0 = PS fp 0 initialSize forM_ (B.tails bs0) $ \bs -> do evaluate (hash bs) regressions :: [Test] regressions = [ testCase "hashNearPageBoundary" hashNearPageBoundary ] mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a) mmap addr len prot flags fd offset = throwErrnoIf (== intPtrToPtr (#const MAP_FAILED)) "mmap" $ c_mmap addr len prot flags fd offset munmap :: Ptr a -> CSize -> IO CInt munmap addr len = throwErrnoIfMinus1 "munmap" $ c_munmap addr len mprotect :: Ptr a -> CSize -> CInt -> IO () mprotect addr len prot = throwErrnoIfMinus1_ "mprotect" $ c_mprotect addr len prot foreign import ccall unsafe "sys/mman.h mmap" c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a) foreign import ccall unsafe "sys/mman.h munmap" c_munmap :: Ptr a -> CSize -> IO CInt foreign import ccall unsafe "sys/mman.h mprotect" c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt foreign import ccall unsafe "unistd.h getpagesize" getPageSize :: IO CInt