{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, KindSignatures,
 ScopedTypeVariables, TypeOperators,
 MultiParamTypeClasses, GADTs, FlexibleContexts #-}{-# OPTIONS_GHC -fno-warn-orphans #-}{-# LANGUAGE Trustworthy #-}-------------------------------------------------------------------------- |-- Module : Data.Hashable.Generic.Instances-- Copyright : (c) Bryan O'Sullivan 2012-- SPDX-License-Identifier : BSD-3-Clause-- Maintainer : bos@serpentine.com-- Stability : provisional-- Portability : GHC >= 7.4---- Internal module defining orphan instances for "GHC.Generics"--moduleData.Hashable.Generic.Instances()whereimportData.Hashable.Class importGHC.Generics
#if MIN_VERSION_base(4,9,0)
importData.Kind(Type)
#else
#define Type *
#endif
-- Type without constructorsinstanceGHashable arity V1whereghashWithSalt :: HashArgs arity a -> Int -> V1 a -> Int
ghashWithSalt HashArgs arity a
_Int
salt V1 a
_=Int -> () -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt ()-- Constructor without argumentsinstanceGHashable arity U1whereghashWithSalt :: HashArgs arity a -> Int -> U1 a -> Int
ghashWithSalt HashArgs arity a
_Int
salt U1 a
U1=Int -> () -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt ()instance(GHashable arity a ,GHashable arity b )=>GHashable arity (a :*:b )whereghashWithSalt :: HashArgs arity a -> Int -> (:*:) a b a -> Int
ghashWithSalt HashArgs arity a
toHash Int
salt (a a
x :*:b a
y )=(HashArgs arity a -> Int -> b a -> Int
forall arity (f :: * -> *) a.
GHashable arity f =>
HashArgs arity a -> Int -> f a -> Int
ghashWithSalt HashArgs arity a
toHash (HashArgs arity a -> Int -> a a -> Int
forall arity (f :: * -> *) a.
GHashable arity f =>
HashArgs arity a -> Int -> f a -> Int
ghashWithSalt HashArgs arity a
toHash Int
salt a a
x )b a
y )-- Metadata (constructor name, etc)instanceGHashable arity a =>GHashable arity (M1i c a )whereghashWithSalt :: HashArgs arity a -> Int -> M1 i c a a -> Int
ghashWithSalt HashArgs arity a
targs Int
salt =HashArgs arity a -> Int -> a a -> Int
forall arity (f :: * -> *) a.
GHashable arity f =>
HashArgs arity a -> Int -> f a -> Int
ghashWithSalt HashArgs arity a
targs Int
salt (a a -> Int) -> (M1 i c a a -> a a) -> M1 i c a a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.M1 i c a a -> a a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1-- Constants, additional parameters, and rank-1 recursioninstanceHashable a =>GHashable arity (K1i a )whereghashWithSalt :: HashArgs arity a -> Int -> K1 i a a -> Int
ghashWithSalt HashArgs arity a
_=(K1 i a a -> a) -> Int -> K1 i a a -> Int
forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing K1 i a a -> a
forall i c k (p :: k). K1 i c p -> c
unK1instanceGHashable One Par1whereghashWithSalt :: HashArgs One a -> Int -> Par1 a -> Int
ghashWithSalt (HashArgs1 h )Int
salt =Int -> a -> Int
h Int
salt (a -> Int) -> (Par1 a -> a) -> Par1 a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Par1 a -> a
forall p. Par1 p -> p
unPar1instanceHashable1 f =>GHashable One (Rec1f )whereghashWithSalt :: HashArgs One a -> Int -> Rec1 f a -> Int
ghashWithSalt (HashArgs1 h )Int
salt =(Int -> a -> Int) -> Int -> f a -> Int
forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> a -> Int
h Int
salt (f a -> Int) -> (Rec1 f a -> f a) -> Rec1 f a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1instance(Hashable1 f ,GHashable One g )=>GHashable One (f :.:g )whereghashWithSalt :: HashArgs One a -> Int -> (:.:) f g a -> Int
ghashWithSalt HashArgs One a
targs Int
salt =(Int -> g a -> Int) -> Int -> f (g a) -> Int
forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt (HashArgs One a -> Int -> g a -> Int
forall arity (f :: * -> *) a.
GHashable arity f =>
HashArgs arity a -> Int -> f a -> Int
ghashWithSalt HashArgs One a
targs )Int
salt (f (g a) -> Int) -> ((:.:) f g a -> f (g a)) -> (:.:) f g a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(:.:) f g a -> f (g a)
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1classSumSize f =>GSum arity f wherehashSum ::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 representation 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 (heterogeneous) 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 )whereghashWithSalt :: HashArgs arity a -> Int -> (:+:) a b a -> Int
ghashWithSalt HashArgs arity a
toHash Int
salt =HashArgs arity a -> Int -> Int -> (:+:) a b a -> Int
forall arity (f :: * -> *) a.
GSum arity f =>
HashArgs arity a -> Int -> Int -> f a -> Int
hashSum HashArgs arity a
toHash Int
salt Int
0instance(GSum arity a ,GSum arity b )=>GSum arity (a :+:b )wherehashSum :: HashArgs arity a -> Int -> Int -> (:+:) a b a -> Int
hashSum HashArgs arity a
toHash !Int
salt !Int
index (:+:) a b a
s =case(:+:) a b a
s ofL1a a
x ->HashArgs arity a -> Int -> Int -> a a -> Int
forall arity (f :: * -> *) a.
GSum arity f =>
HashArgs arity a -> Int -> Int -> f a -> Int
hashSum HashArgs arity a
toHash Int
salt Int
index a a
x R1b a
x ->HashArgs arity a -> Int -> Int -> b a -> Int
forall arity (f :: * -> *) a.
GSum arity f =>
HashArgs arity a -> Int -> Int -> f a -> Int
hashSum HashArgs arity a
toHash Int
salt (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeL )b a
x wheresizeL :: Int
sizeL =Tagged a -> Int
forall (s :: * -> *). Tagged s -> Int
unTagged (Tagged a
forall (f :: * -> *). SumSize f => Tagged f
sumSize ::Tagged a ){-# INLINEhashSum #-}instanceGHashable arity a =>GSum arity (C1c a )wherehashSum :: HashArgs arity a -> Int -> Int -> C1 c a a -> Int
hashSum HashArgs arity a
toHash !Int
salt !Int
index (M1a a
x )=HashArgs arity a -> Int -> a a -> Int
forall arity (f :: * -> *) a.
GHashable arity f =>
HashArgs arity a -> Int -> f a -> Int
ghashWithSalt HashArgs arity a
toHash (Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
index )a a
x {-# INLINEhashSum #-}classSumSize f wheresumSize ::Tagged f newtypeTagged (s ::Type->Type)=Tagged {Tagged s -> Int
unTagged ::Int}instance(SumSize a ,SumSize b )=>SumSize (a :+:b )wheresumSize :: Tagged (a :+: b)
sumSize =Int -> Tagged (a :+: b)
forall (s :: * -> *). Int -> Tagged s
Tagged (Int -> Tagged (a :+: b)) -> Int -> Tagged (a :+: b)
forall a b. (a -> b) -> a -> b
$Tagged a -> Int
forall (s :: * -> *). Tagged s -> Int
unTagged (Tagged a
forall (f :: * -> *). SumSize f => Tagged f
sumSize ::Tagged a )Int -> Int -> Int
forall a. Num a => a -> a -> a
+Tagged b -> Int
forall (s :: * -> *). Tagged s -> Int
unTagged (Tagged b
forall (f :: * -> *). SumSize f => Tagged f
sumSize ::Tagged b )instanceSumSize (C1c a )wheresumSize :: Tagged (C1 c a)
sumSize =Int -> Tagged (C1 c a)
forall (s :: * -> *). Int -> Tagged s
Tagged Int
1