hashable-1.2.6.1/0000755000000000000000000000000013122641150011607 5ustar0000000000000000hashable-1.2.6.1/LICENSE0000644000000000000000000000275513122641150012625 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.6.1/CHANGES.md0000644000000000000000000001143313122641150013203 0ustar0000000000000000## Version 1.2.6.1 * Use typeRepFingerprint from Type.Reflection.Unsafe * Bump minimum version of base to 4.4. ## Version 1.2.6.0 * Add support for type-indexed `Typeable`. * Rework the `Generic` hashable for sums. ## Version 1.2.5.0 * Add `Hashable1` and `Hashable2` * Add instances for: `Eq1`, `Ord1`, `Show1`, `Ptr`, `FunPtr`, `IntPtr`, `WordPtr` * Add `Hashed` type for caching the `hash` function result. ## 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.6.1/README.md0000644000000000000000000000043513122641150013070 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.6.1/Setup.hs0000644000000000000000000000011013122641150013233 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain hashable-1.2.6.1/hashable.cabal0000644000000000000000000001123113122641150014340 0ustar0000000000000000Name: hashable Version: 1.2.6.1 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, benchmarks/cbits/*.c, benchmarks/cbits/*.h 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 Flag examples Description: Build example modules Default: False Manual: True Library Exposed-modules: Data.Hashable Data.Hashable.Lifted Other-modules: Data.Hashable.Class Build-depends: base >= 4.4 && < 4.11, bytestring >= 0.9 && < 0.11, deepseq >= 1.3 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 if impl(ghc >= 7.2.1) CPP-Options: -DGENERICS include-dirs: benchmarks/cbits includes: siphash.h 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 Executable hashable-examples if flag(examples) build-depends: base, hashable else buildable: False hs-source-dirs: examples main-is: Main.hs source-repository head type: git location: https://github.com/tibbe/hashable.git hashable-1.2.6.1/examples/0000755000000000000000000000000013122641150013425 5ustar0000000000000000hashable-1.2.6.1/examples/Main.hs0000644000000000000000000000250013122641150014642 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} import Data.Hashable import Data.Hashable.Lifted import GHC.Generics (Generic) data Foo = Foo1 Int Char Bool | Foo2 String () deriving (Generic) instance Hashable Foo data Bar = Bar Double Float deriving (Generic) instance Hashable Bar -- printHash :: (Hashable a, Show a) => a -> IO () -- printHash = print . hash main :: IO () main = do putStrLn "Hashing Foo1" print . hash $ Foo1 22 'y' True putStrLn "Hashing Foo2" print . hash $ Foo2 "hello" () putStrLn "Hashing Bar" print . hash $ Bar 55.50 9.125 ----------------------------------- -- Higher Rank Hashable Examples -- ----------------------------------- newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } data Free f a = Pure a | Free (f (Free f a)) instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where liftHashWithSalt h s (WriterT m) = liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m instance Hashable1 f => Hashable1 (Free f) where liftHashWithSalt h = go where go s x = case x of Pure a -> h s a Free p -> liftHashWithSalt go s p instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where hashWithSalt = hashWithSalt1 instance (Hashable1 f, Hashable a) => Hashable (Free f a) where hashWithSalt = hashWithSalt1 hashable-1.2.6.1/Data/0000755000000000000000000000000013122641150012460 5ustar0000000000000000hashable-1.2.6.1/Data/Hashable.hs0000644000000000000000000001515513122641150014532 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} #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 -- * Caching hashes , Hashed , hashed , unhashed , mapHashed , traverseHashed ) 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.6.1/Data/Hashable/0000755000000000000000000000000013122641150014167 5ustar0000000000000000hashable-1.2.6.1/Data/Hashable/Generic.hs0000644000000000000000000001026213122641150016100 0ustar0000000000000000{-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures, ScopedTypeVariables, TypeOperators, MultiParamTypeClasses, GADTs, FlexibleContexts #-} {-# 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 arity V1 where ghashWithSalt _ salt _ = hashWithSalt salt () -- Constructor without arguments instance GHashable arity U1 where ghashWithSalt _ salt U1 = hashWithSalt salt () instance (GHashable arity a, GHashable arity b) => GHashable arity (a :*: b) where ghashWithSalt toHash salt (x :*: y) = (ghashWithSalt toHash (ghashWithSalt toHash salt x) y) -- Metadata (constructor name, etc) instance GHashable arity a => GHashable arity (M1 i c a) where ghashWithSalt targs salt = ghashWithSalt targs salt . unM1 -- Constants, additional parameters, and rank-1 recursion instance Hashable a => GHashable arity (K1 i a) where ghashWithSalt _ = hashUsing unK1 instance GHashable One Par1 where ghashWithSalt (HashArgs1 h) salt = h salt . unPar1 instance Hashable1 f => GHashable One (Rec1 f) where ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1 instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1 class SumSize f => GSum arity f where hashSum :: HashArgs arity a -> Int -> Int -> f a -> Int -- hashSum args salt index value = ... -- [Note: Hashing a sum type] -- -- The tree structure is used in GHC.Generics to represent the sum (and -- product) part of the generic represention of the type, e.g.: -- -- (C0 ... :+: C1 ...) :+: (C2 ... :+: (C3 ... :+: C4 ...)) -- -- The value constructed with C2 constructor is represented as (R1 (L1 ...)). -- Yet, if we think that this tree is a flat (heterogenous) list: -- -- [C0 ..., C1 ..., C2 ..., C3 ..., C4... ] -- -- then the value constructed with C2 is a (dependent) pair (2, ...), and -- hashing it is simple: -- -- salt `hashWithSalt` (2 :: Int) `hashWithSalt` ... -- -- This is what we do below. When drilling down the tree, we count how many -- leafs are to the left (`index` variable). At the leaf case C1, we'll have an -- actual index into the sum. -- -- This works well for balanced data. However for recursive types like: -- -- data Nat = Z | S Nat -- -- the `hashWithSalt salt (S (S (S Z)))` is -- -- salt `hashWithSalt` (1 :: Int) -- first S -- `hashWithSalt` (1 :: Int) -- second S -- `hashWithSalt` (1 :: Int) -- third S -- `hashWithSalt` (0 :: Int) -- Z -- `hashWithSalt` () -- U1 -- -- For that type the manual implementation: -- -- instance Hashable Nat where -- hashWithSalt salt n = hashWithSalt salt (natToInteger n) -- -- would be better performing CPU and hash-quality wise (assuming that -- Integer's Hashable is of high quality). -- instance (GSum arity a, GSum arity b) => GHashable arity (a :+: b) where ghashWithSalt toHash salt = hashSum toHash salt 0 instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where hashSum toHash !salt !index s = case s of L1 x -> hashSum toHash salt index x R1 x -> hashSum toHash salt (index + sizeL) x where sizeL = unTagged (sumSize :: Tagged a) {-# INLINE hashSum #-} instance GHashable arity a => GSum arity (C1 c a) where hashSum toHash !salt !index (M1 x) = ghashWithSalt toHash (hashWithSalt salt index) 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.6.1/Data/Hashable/Class.hs0000644000000000000000000007424313122641150015602 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, ScopedTypeVariables, UnliftedFFITypes #-} #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE DeriveDataTypeable #-} #endif #if __GLASGOW_HASKELL__ >= 801 {-# LANGUAGE PolyKinds #-} -- For TypeRep instances #endif #ifdef GENERICS {-# LANGUAGE DefaultSignatures, FlexibleContexts, GADTs, MultiParamTypeClasses, EmptyDataDecls #-} #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(..) , Hashable1(..) , Hashable2(..) #ifdef GENERICS -- ** Support for generics , GHashable(..) , HashArgs(..) , Zero , One #endif -- * Creating new instances , hashUsing , hashPtr , hashPtrWithSalt , hashByteArray , hashByteArrayWithSalt , defaultHashWithSalt -- * Higher Rank Functions , hashWithSalt1 , hashWithSalt2 , defaultLiftHashWithSalt -- * Caching hashes , Hashed , hashed , unhashed , mapHashed , traverseHashed ) where import Control.Applicative (Const(..)) import Control.Exception (assert) import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR, xor) import qualified Data.ByteString 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.Version (Version(..)) import Data.Word (Word8, Word16, Word32, Word64) import Foreign.C (CString) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, FunPtr, IntPtr, WordPtr, castPtr, castFunPtrToPtr, ptrToIntPtr) import Foreign.Storable (alignment, peek, sizeOf) import GHC.Base (ByteArray#) import GHC.Conc (ThreadId(..)) import GHC.Prim (ThreadId#) import System.IO.Unsafe (unsafeDupablePerformIO) import System.Mem.StableName import Data.Unique (Unique, hashUnique) -- As we use qualified F.Foldable, we don't get warnings with newer base import qualified Data.Foldable as F #if MIN_VERSION_base(4,7,0) import Data.Proxy (Proxy) #endif #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) #endif #if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity(..)) #endif #ifdef GENERICS import GHC.Generics #endif #if __GLASGOW_HASKELL__ >= 801 import Type.Reflection (Typeable, TypeRep, SomeTypeRep(..)) import Type.Reflection.Unsafe (typeRepFingerprint) import GHC.Fingerprint.Type(Fingerprint(..)) #elif __GLASGOW_HASKELL__ >= 710 import Data.Typeable (typeRepFingerprint, Typeable, TypeRep) import GHC.Fingerprint.Type(Fingerprint(..)) #elif __GLASGOW_HASKELL__ >= 702 import Data.Typeable.Internal (Typeable, TypeRep (..)) import GHC.Fingerprint.Type(Fingerprint(..)) #elif __GLASGOW_HASKELL__ >= 606 import Data.Typeable (typeRepKey, Typeable, TypeRep) #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 import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith) import Data.Functor.Compose (Compose(..)) import qualified Data.Functor.Product as FP import qualified Data.Functor.Sum as FS #endif import Data.String (IsString(..)) #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 Zero (Rep a)) => Int -> a -> Int hashWithSalt salt = ghashWithSalt HashArgs0 salt . from data Zero data One data HashArgs arity a where HashArgs0 :: HashArgs Zero a HashArgs1 :: (Int -> a -> Int) -> HashArgs One a -- | The class of types that can be generically hashed. class GHashable arity f where ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int #endif class Hashable1 t where -- | Lift a hashing function through the type constructor. liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int #ifdef GENERICS default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int liftHashWithSalt h salt = ghashWithSalt (HashArgs1 h) salt . from1 #endif class Hashable2 t where -- | Lift a hashing function through the binary type constructor. liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int -- | Lift the 'hashWithSalt' function through the type constructor. -- -- > hashWithSalt1 = liftHashWithSalt hashWithSalt hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int hashWithSalt1 = liftHashWithSalt hashWithSalt -- | Lift the 'hashWithSalt' function through the type constructor. -- -- > hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt -- | Lift the 'hashWithSalt' function halfway through the type constructor. -- This function makes a suitable default implementation of 'liftHashWithSalt', -- given that the type constructor @t@ in question can unify with @f a@. defaultLiftHashWithSalt :: (Hashable2 f, Hashable a) => (Int -> b -> Int) -> Int -> f a b -> Int defaultLiftHashWithSalt h = liftHashWithSalt2 hashWithSalt h -- | 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 ((unsafeDupablePerformIO $ 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 ((unsafeDupablePerformIO $ 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 = hashWithSalt1 instance Hashable1 Maybe where liftHashWithSalt _ s Nothing = s `combine` 0 liftHashWithSalt h s (Just a) = s `combine` distinguisher `h` a instance (Hashable a, Hashable b) => Hashable (Either a b) where hash (Left a) = 0 `hashWithSalt` a hash (Right b) = distinguisher `hashWithSalt` b hashWithSalt = hashWithSalt1 instance Hashable a => Hashable1 (Either a) where liftHashWithSalt = defaultLiftHashWithSalt instance Hashable2 Either where liftHashWithSalt2 h _ s (Left a) = s `combine` 0 `h` a liftHashWithSalt2 _ h s (Right b) = s `combine` distinguisher `h` b instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where hash (a1, a2) = hash a1 `hashWithSalt` a2 hashWithSalt = hashWithSalt1 instance Hashable a1 => Hashable1 ((,) a1) where liftHashWithSalt = defaultLiftHashWithSalt instance Hashable2 (,) where liftHashWithSalt2 h1 h2 s (a1, a2) = s `h1` a1 `h2` a2 instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 hashWithSalt = hashWithSalt1 instance (Hashable a1, Hashable a2) => Hashable1 ((,,) a1 a2) where liftHashWithSalt = defaultLiftHashWithSalt instance Hashable a1 => Hashable2 ((,,) a1) where liftHashWithSalt2 h1 h2 s (a1, a2, a3) = (s `hashWithSalt` a1) `h1` a2 `h2` 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 = hashWithSalt1 instance (Hashable a1, Hashable a2, Hashable a3) => Hashable1 ((,,,) a1 a2 a3) where liftHashWithSalt = defaultLiftHashWithSalt instance (Hashable a1, Hashable a2) => Hashable2 ((,,,) a1 a2) where liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4) = (s `hashWithSalt` a1 `hashWithSalt` a2) `h1` a3 `h2` 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 = hashWithSalt1 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable1 ((,,,,) a1 a2 a3 a4) where liftHashWithSalt = defaultLiftHashWithSalt instance (Hashable a1, Hashable a2, Hashable a3) => Hashable2 ((,,,,) a1 a2 a3) where liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5) = (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3) `h1` a4 `h2` 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 = hashWithSalt1 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) => Hashable1 ((,,,,,) a1 a2 a3 a4 a5) where liftHashWithSalt = defaultLiftHashWithSalt instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable2 ((,,,,,) a1 a2 a3 a4) where liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6) = (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4) `h1` a5 `h2` 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 a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable1 ((,,,,,,) a1 a2 a3 a4 a5 a6) where liftHashWithSalt = defaultLiftHashWithSalt instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) => Hashable2 ((,,,,,,) a1 a2 a3 a4 a5) where liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6, a7) = (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5) `h1` a6 `h2` 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 = hashWithSalt1 instance Hashable1 [] where liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr) where finalise (SP s l) = hashWithSalt s l step (SP s l) x = SP (h s x) (l + 1) instance Hashable B.ByteString where hashWithSalt salt bs = unsafeDupablePerformIO $ 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 instance Hashable (Ptr a) where hashWithSalt salt p = hashWithSalt salt $ ptrToIntPtr p instance Hashable (FunPtr a) where hashWithSalt salt p = hashWithSalt salt $ castFunPtrToPtr p instance Hashable IntPtr where hash n = fromIntegral n hashWithSalt = defaultHashWithSalt instance Hashable WordPtr where hash n = fromIntegral n hashWithSalt = defaultHashWithSalt #if __GLASGOW_HASKELL__ < 801 -- | 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 = unsafeDupablePerformIO . typeRepKey #else hashTypeRep = hash . show #endif instance Hashable TypeRep where hash = hashTypeRep hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} #else hashTypeRep :: Type.Reflection.TypeRep a -> Int hashTypeRep tr = let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x instance Hashable Type.Reflection.SomeTypeRep where hash (Type.Reflection.SomeTypeRep r) = hashTypeRep r hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} instance Hashable (Type.Reflection.TypeRep a) where hash = hashTypeRep hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} #endif #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) -- Using hashWithSalt1 would cause needless constraint instance Hashable (Fixed a) where hashWithSalt salt (MkFixed i) = hashWithSalt salt i instance Hashable1 Fixed where liftHashWithSalt _ salt (MkFixed i) = hashWithSalt salt i #endif #if MIN_VERSION_base(4,8,0) instance Hashable a => Hashable (Identity a) where hashWithSalt = hashWithSalt1 instance Hashable1 Identity where liftHashWithSalt h salt (Identity x) = h salt x #endif -- Using hashWithSalt1 would cause needless constraint instance Hashable a => Hashable (Const a b) where hashWithSalt salt (Const x) = hashWithSalt salt x instance Hashable a => Hashable1 (Const a) where liftHashWithSalt = defaultLiftHashWithSalt instance Hashable2 Const where liftHashWithSalt2 f _ salt (Const x) = f salt x #if MIN_VERSION_base(4,7,0) instance Hashable (Proxy a) where hash _ = 0 hashWithSalt s _ = s instance Hashable1 Proxy where liftHashWithSalt _ s _ = s #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 -- instances for @Data.Functor.{Product,Sum,Compose}@, present -- in base-4.9 and onward. #if MIN_VERSION_base(4,9,0) -- | In general, @hash (Compose x) ≠ hash x@. However, @hashWithSalt@ satisfies -- its variant of this equivalence. instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) where hashWithSalt = hashWithSalt1 instance (Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) where liftHashWithSalt h s = liftHashWithSalt (liftHashWithSalt h) s . getCompose instance (Hashable1 f, Hashable1 g) => Hashable1 (FP.Product f g) where liftHashWithSalt h s (FP.Pair a b) = liftHashWithSalt h (liftHashWithSalt h s a) b instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FP.Product f g a) where hashWithSalt = hashWithSalt1 instance (Hashable1 f, Hashable1 g) => Hashable1 (FS.Sum f g) where liftHashWithSalt h s (FS.InL a) = liftHashWithSalt h (s `combine` 0) a liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `combine` distinguisher) a instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where hashWithSalt = hashWithSalt1 #endif -- | A hashable value along with the result of the 'hash' function. data Hashed a = Hashed a {-# UNPACK #-} !Int deriving (Typeable) -- | Wrap a hashable value, caching the 'hash' function result. hashed :: Hashable a => a -> Hashed a hashed a = Hashed a (hash a) -- | Unwrap hashed value. unhashed :: Hashed a -> a unhashed (Hashed a _) = a -- | Uses precomputed hash to detect inequality faster instance Eq a => Eq (Hashed a) where Hashed a ha == Hashed b hb = ha == hb && a == b instance Ord a => Ord (Hashed a) where Hashed a _ `compare` Hashed b _ = a `compare` b instance Show a => Show (Hashed a) where showsPrec d (Hashed a _) = showParen (d > 10) $ showString "hashed" . showChar ' ' . showsPrec 11 a instance Hashable (Hashed a) where hashWithSalt = defaultHashWithSalt hash (Hashed _ h) = h -- This instance is a little unsettling. It is unusal for -- 'liftHashWithSalt' to ignore its first argument when a -- value is actually available for it to work on. instance Hashable1 Hashed where liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h instance (IsString a, Hashable a) => IsString (Hashed a) where fromString s = let r = fromString s in Hashed r (hash r) instance F.Foldable Hashed where foldr f acc (Hashed a _) = f a acc instance NFData a => NFData (Hashed a) where rnf = rnf . unhashed -- | 'Hashed' cannot be 'Functor' mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b mapHashed f (Hashed a _) = hashed (f a) -- | 'Hashed' cannot be 'Traversable' traverseHashed :: (Hashable b, Functor f) => (a -> f b) -> Hashed a -> f (Hashed b) traverseHashed f (Hashed a _) = fmap hashed (f a) -- instances for @Data.Functor.Classes@ higher rank typeclasses -- in base-4.9 and onward. #if MIN_VERSION_base(4,9,0) instance Eq1 Hashed where liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b instance Ord1 Hashed where liftCompare f (Hashed a _) (Hashed b _) = f a b instance Show1 Hashed where liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a #endif hashable-1.2.6.1/Data/Hashable/Lifted.hs0000644000000000000000000000731113122641150015734 0ustar0000000000000000------------------------------------------------------------------------ -- | -- 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 -- -- Lifting of the 'Hashable' class to unary and binary type constructors. -- These classes are needed to express the constraints on arguments of -- types that are parameterized by type constructors. Fixed-point data -- types and monad transformers are such types. module Data.Hashable.Lifted ( -- * Type Classes Hashable1(..) , Hashable2(..) -- * Auxiliary Functions , hashWithSalt1 , hashWithSalt2 , defaultLiftHashWithSalt -- * Motivation -- $motivation ) where import Data.Hashable.Class -- $motivation -- -- This type classes provided in this module are used to express constraints -- on type constructors in a Haskell98-compatible fashion. As an example, consider -- the following two types (Note that these instances are not actually provided -- because @hashable@ does not have @transformers@ or @free@ as a dependency): -- -- > newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } -- > data Free f a = Pure a | Free (f (Free f a)) -- -- The 'Hashable1' instances for @WriterT@ and @Free@ could be written as: -- -- > instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where -- > liftHashWithSalt h s (WriterT m) = -- > liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m -- > instance Hashable1 f => Hashable1 (Free f) where -- > liftHashWithSalt h = go where -- > go s x = case x of -- > Pure a -> h s a -- > Free p -> liftHashWithSalt go s p -- -- The 'Hashable' instances for these types can be trivially recovered with -- 'hashWithSalt1': -- -- > instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where -- > hashWithSalt = hashWithSalt1 -- > instance (Hashable1 f, Hashable a) => Hashable (Free f a) where -- > hashWithSalt = hashWithSalt1 -- -- $discussion -- -- Regardless of whether 'hashWithSalt1' is used to provide an implementation -- of 'hashWithSalt', they should produce the same hash when called with -- the same arguments. This is the only law that 'Hashable1' and 'Hashable2' -- are expected to follow. -- -- The typeclasses in this module only provide lifting for 'hashWithSalt', not -- for 'hash'. This is because such liftings cannot be defined in a way that -- would satisfy the @liftHash@ variant of the above law. As an illustration -- of the problem we run into, let us assume that 'Hashable1' were -- given a 'liftHash' method: -- -- > class Hashable1 t where -- > liftHash :: (Int -> a) -> t a -> Int -- > liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int -- -- Even for a type as simple as 'Maybe', the problem manifests itself. The -- 'Hashable' instance for 'Maybe' is: -- -- > distinguisher :: Int -- > distinguisher = ... -- > -- > instance Hashable a => Hashable (Maybe a) where -- > hash Nothing = 0 -- > hash (Just a) = distinguisher `hashWithSalt` a -- > hashWithSalt s Nothing = ... -- > hashWithSalt s (Just a) = ... -- -- The implementation of 'hash' calls 'hashWithSalt' on @a@. The hypothetical -- @liftHash@ defined earlier only accepts an argument that corresponds to -- the implementation of 'hash' for @a@. Consequently, this formulation of -- @liftHash@ would not provide a way to match the current behavior of 'hash' -- for 'Maybe'. This problem gets worse when 'Either' and @[]@ are considered. -- The solution adopted in this library is to omit @liftHash@ entirely. hashable-1.2.6.1/Data/Hashable/RandomSource.hs0000644000000000000000000000164413122641150017131 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.6.1/Data/Hashable/SipHash.hs0000644000000000000000000001153213122641150016064 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.6.1/benchmarks/0000755000000000000000000000000013122641150013724 5ustar0000000000000000hashable-1.2.6.1/benchmarks/Benchmarks.hs0000644000000000000000000002751013122641150016342 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, UnboxedTuples, DeriveGeneric #-} 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 GHC.Generics (Generic) 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 let exP = P 22.0203 234.19 'x' 6424 exS = S3 exPS = PS3 'z' 7715 -- 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 ] , bgroup "Generic" [ bench "product" $ whnf hash exP , bench "sum" $ whnf hash exS , bench "product and sum" $ whnf hash exPS ] ] 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 data PS = PS1 Int Char Bool | PS2 String () | PS3 Char Int deriving (Generic) data P = P Double Float Char Int deriving (Generic) data S = S1 | S2 | S3 | S4 | S5 deriving (Generic) instance Hashable PS instance Hashable P instance Hashable S hashable-1.2.6.1/benchmarks/cbits/0000755000000000000000000000000013122641150015030 5ustar0000000000000000hashable-1.2.6.1/benchmarks/cbits/wang.c0000644000000000000000000000131613122641150016131 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.6.1/benchmarks/cbits/inthash.c0000644000000000000000000000076213122641150016637 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.6.1/benchmarks/cbits/siphash.h0000644000000000000000000000340713122641150016644 0ustar0000000000000000#ifndef _hashable_siphash_h #define _hashable_siphash_h #include #include typedef uint64_t u64; typedef uint32_t u32; typedef uint16_t u16; typedef uint8_t u8; #define SIPHASH_ROUNDS 2 #define SIPHASH_FINALROUNDS 4 u64 hashable_siphash(int, int, u64, u64, const u8 *, size_t); u64 hashable_siphash24(u64, u64, const u8 *, size_t); #if defined(__i386) /* To use SSE instructions, we have to adjust the stack from its default of 4-byte alignment to use 16-byte alignment. */ # define ALIGNED_STACK __attribute__((force_align_arg_pointer)) u64 hashable_siphash24_sse2(u64, u64, const u8 *, size_t) ALIGNED_STACK; u64 hashable_siphash24_sse41(u64, u64, const u8 *, size_t) ALIGNED_STACK; #endif #if defined(_WIN32) # define __LITTLE_ENDIAN 1234 # define __BIG_ENDIAN 4321 # define __BYTE_ORDER __LITTLE_ENDIAN #elif (defined(__FreeBSD__) && __FreeBSD_version >= 470000) || defined(__OpenBSD__) || defined(__NetBSD__) # include # define __BIG_ENDIAN BIG_ENDIAN # define __LITTLE_ENDIAN LITTLE_ENDIAN # define __BYTE_ORDER BYTE_ORDER #elif (defined(BSD) && (BSD >= 199103)) || defined(__APPLE__) # include # define __BIG_ENDIAN BIG_ENDIAN # define __LITTLE_ENDIAN LITTLE_ENDIAN # define __BYTE_ORDER BYTE_ORDER #elif defined(__linux__) # include #endif static inline u64 peek_u64le(const u64 *p) { u64 x = *p; #if __BYTE_ORDER == __BIG_ENDIAN x = ((x & 0xff00000000000000ull) >> 56) | ((x & 0x00ff000000000000ull) >> 40) | ((x & 0x0000ff0000000000ull) >> 24) | ((x & 0x000000ff00000000ull) >> 8) | ((x & 0x00000000ff000000ull) << 8) | ((x & 0x0000000000ff0000ull) << 24) | ((x & 0x000000000000ff00ull) << 40) | ((x & 0x00000000000000ffull) << 56); #endif return x; } #endif /* _hashable_siphash_h */ hashable-1.2.6.1/benchmarks/cbits/siphash.c0000644000000000000000000001235513122641150016641 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.6.1/benchmarks/cbits/siphash-sse2.c0000644000000000000000000000763013122641150017513 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.6.1/benchmarks/cbits/siphash-sse41.c0000644000000000000000000000505013122641150017570 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.6.1/cbits/0000755000000000000000000000000013122641150012713 5ustar0000000000000000hashable-1.2.6.1/cbits/getRandomBytes.c0000644000000000000000000000506213122641150016011 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.6.1/cbits/fnv.c0000644000000000000000000000411113122641150013645 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.6.1/tests/0000755000000000000000000000000013122641150012751 5ustar0000000000000000hashable-1.2.6.1/tests/Properties.hs0000644000000000000000000002162113122641150015443 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, Hashed, hashed, unhashed, hashWithSalt) import Data.Hashable.Lifted (hashWithSalt1) 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 instance (Arbitrary a, Hashable a) => Arbitrary (Hashed a) where arbitrary = fmap hashed arbitrary shrink xs = map hashed $ shrink $ unhashed xs pLiftedHashed :: Int -> Hashed (Either Int String) -> Bool pLiftedHashed s h = hashWithSalt s h == hashWithSalt1 s h 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 , testGroup "lifted law" [ testProperty "Hashed" pLiftedHashed ] ] ------------------------------------------------------------------------ -- 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.6.1/tests/Regress.hs0000644000000000000000000000237713122641150014730 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} module Regress (regressions) where import qualified Test.Framework as F import Test.Framework.Providers.HUnit (testCase) import Test.HUnit ((@=?)) import GHC.Generics (Generic) import Data.List (nub) #ifdef HAVE_MMAP import qualified Regress.Mmap as Mmap #endif import Data.Hashable regressions :: [F.Test] regressions = [] ++ #ifdef HAVE_MMAP Mmap.regressions ++ #endif [ F.testGroup "Generic: sum of nullary constructors" [ testCase "0" $ nullaryCase 0 S0 , testCase "1" $ nullaryCase 1 S1 , testCase "2" $ nullaryCase 2 S2 , testCase "3" $ nullaryCase 3 S3 , testCase "4" $ nullaryCase 4 S4 ] , testCase "Generic: Peano https://github.com/tibbe/hashable/issues/135" $ do let ns = take 20 $ iterate S Z let hs = map hash ns hs @=? nub hs ] where nullaryCase :: Int -> SumOfNullary -> IO () nullaryCase n s = do let salt = 42 let expected = salt `hashWithSalt` n `hashWithSalt` () let actual = hashWithSalt salt s expected @=? actual data SumOfNullary = S0 | S1 | S2 | S3 | S4 deriving (Generic) instance Hashable SumOfNullary data Nat = Z | S Nat deriving (Generic) instance Hashable Nat hashable-1.2.6.1/tests/Main.hs0000644000000000000000000000057413122641150014177 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.6.1/tests/Regress/0000755000000000000000000000000013122641150014363 5ustar0000000000000000hashable-1.2.6.1/tests/Regress/Mmap.hsc0000644000000000000000000000456013122641150015761 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