{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable #-}-- | Code shared between the lazy and strict versions.moduleData.HashMap.Common(-- * TypesHashMap(..)-- * Helpers,join,bin,zero,nomatch-- * Construction,empty-- * Combine,union-- * Transformations,toList,filterMapWithKey,traverseWithKey-- * Folds,foldrWithKey-- * Helpers,shorter,insertCollidingWith)where#include "MachDeps.h"importControl.Applicative(Applicative((<*>),pure),(<$>))importControl.DeepSeq(NFData(rnf))importData.Bits(Bits(..),(.&.),xor)importqualifiedData.FoldableasFoldableimportData.Monoid(Monoid(mempty,mappend))importData.Traversable(Traversable(..))importData.Typeable(Typeable)importData.Word(Word)importPreludehiding(foldr,map)#if defined(__GLASGOW_HASKELL__)importGHC.Exts(build)#endifimportqualifiedData.FullList.LazyasFL-------------------------------------------------------------------------- * The 'HashMap' type-- | A map from keys to values. A map cannot contain duplicate keys;-- each key can map to at most one value.dataHashMapkv=Bin{-# UNPACK #-}!SuffixMask!(HashMapkv)!(HashMapkv)|Tip{-# UNPACK #-}!Hash{-# UNPACK #-}!(FL.FullListkv)|Nilderiving(Typeable)typeSuffix=InttypeHash=Int-- | A SuffixMask stores a path to a Bin node in the hash map. The-- uppermost set bit, the Mask, indicates the bit used to distinguish-- hashes in the left and right subtrees. The lower-order bits (below-- the highest set bit), the Suffix, are set the same way in all the-- hashes contained in this subtree of the map. Thus, hashes in the-- right subtree will match all the bits in the SuffixMask, but may-- have set bits above the Mask. Hashes in the left subtree will not-- match the Mask bit, but will match all the Suffix bits.typeSuffixMask=Int-------------------------------------------------------------------------- * Instances-- Since both the lazy and the strict API shares one data type we can-- only provide one set of instances. We provide the lazy ones.instance(Eqk,Eqv)=>Eq(HashMapkv)wheret1==t2=equalt1t2t1/=t2=nequalt1t2-- | /O(n)/ Return a list of this map's elements. The list is-- produced lazily.toList::HashMapkv->[(k,v)]#if defined(__GLASGOW_HASKELL__)toListt=build(\cz->foldrWithKey(curryc)zt)#elsetoList=foldrWithKey(\kvxs->(k,v):xs)[]#endif{-# INLINE toList #-}equal::(Eqk,Eqv)=>HashMapkv->HashMapkv->Boolequal(Binsm1l1r1)(Binsm2l2r2)=(sm1==sm2)&&(equall1l2)&&(equalr1r2)equal(Tiph1l1)(Tiph2l2)=(h1==h2)&&(l1==l2)equalNilNil=Trueequal__=Falsenequal::(Eqk,Eqv)=>HashMapkv->HashMapkv->Boolnequal(Binsm1l1r1)(Binsm2l2r2)=(sm1/=sm2)||(nequall1l2)||(nequalr1r2)nequal(Tiph1l1)(Tiph2l2)=(h1/=h2)||(l1/=l2)nequalNilNil=Falsenequal__=Trueinstance(NFDatak,NFDatav)=>NFData(HashMapkv)wherernfNil=()rnf(Tip_xs)=rnfxsrnf(Bin_lr)=rnfl`seq`rnfrinstanceFunctor(HashMapk)wherefmap=mapinstance(Showk,Showv)=>Show(HashMapkv)whereshowsPrecdm=showParen(d>10)$showString"fromList ".shows(toListm)-- | /O(n)/ Transform this map by applying a function to every value.map::(v1->v2)->HashMapkv1->HashMapkv2mapf=gowherego(Binsmlr)=Binsm(gol)(gor)go(Tiphl)=Tiph(FL.mapf'l)goNil=Nilf'kv=(k,fv){-# INLINE map #-}instanceFoldable.Foldable(HashMapk)wherefoldrf=foldrWithKey(constf)-- | /O(n)/ Reduce this map by applying a binary operator to all-- elements, using the given starting value (typically the-- right-identity of the operator).foldrWithKey::(k->v->a->a)->a->HashMapkv->afoldrWithKeyf=gowheregoz(Bin_lr)=go(gozr)lgoz(Tip_l)=FL.foldrWithKeyfzlgozNil=z{-# INLINE foldrWithKey #-}instanceEqk=>Monoid(HashMapkv)wheremempty=empty{-# INLINE mempty #-}mappend=union{-# INLINE mappend #-}-- | /O(1)/ Construct an empty map.empty::HashMapkvempty=Nil-- | /O(n+m)/ The union of two maps. If a key occurs in both maps,-- the mapping from the first will be the mapping in the result.union::Eqk=>HashMapkv->HashMapkv->HashMapkvuniont1@(Binsm1l1r1)t2@(Binsm2l2r2)|sm1==sm2=Binsm1(unionl1l2)(unionr1r2)|shortersm1sm2=union1|shortersm2sm1=union2|otherwise=joinsm1t1sm2t2whereunion1|nomatchsm2sm1=joinsm1t1sm2t2|zerosm2sm1=Binsm1(unionl1t2)r1|otherwise=Binsm1l1(unionr1t2)union2|nomatchsm1sm2=joinsm1t1sm2t2|zerosm1sm2=Binsm2(uniont1l2)r2|otherwise=Binsm2l2(uniont1r2)union(Tiphl)t=insertCollidingLhltuniont(Tiphl)=insertCollidingRhlt-- right biasunionNilt=tuniontNil=t#if __GLASGOW_HASKELL__ >= 700{-# INLINABLE union #-}#endif-- | Insert a list of key-value pairs which keys all hash to the same-- hash value. Prefer key-value pairs in the list to key-value pairs-- already in the map.insertCollidingL::Eqk=>Hash->FL.FullListkv->HashMapkv->HashMapkvinsertCollidingL=insertCollidingWithFL.union#if __GLASGOW_HASKELL__ >= 700{-# INLINABLE insertCollidingL #-}#endif-- | Insert a list of key-value pairs which keys all hash to the same-- hash value. Prefer key-value pairs already in the map to key-value-- pairs in the list.insertCollidingR::Eqk=>Hash->FL.FullListkv->HashMapkv->HashMapkvinsertCollidingR=insertCollidingWith(flipFL.union)#if __GLASGOW_HASKELL__ >= 700{-# INLINABLE insertCollidingR #-}#endif-- | Insert a list of key-value pairs which keys all hash to the same-- hash value. Merge the list of key-value pairs to be inserted @xs@-- with any existing key-values pairs @ys@ by applying @f xs ys@.insertCollidingWith::Eqk=>(FL.FullListkv->FL.FullListkv->FL.FullListkv)->Hash->FL.FullListkv->HashMapkv->HashMapkvinsertCollidingWithfh0l0t0=goh0l0t0wherego!h!xst@(Binsmlr)|nomatchhsm=joinh(Tiphxs)smt|zerohsm=Binsm(gohxsl)r|otherwise=Binsml(gohxsr)gohxst@(Tiph'l)|h==h'=Tiph$fxsl|otherwise=joinh(Tiphxs)h'tgohxsNil=Tiphxs{-# INLINE insertCollidingWith #-}instanceTraversable(HashMapk)wheretraversef=traverseWithKey(constf)-- | /O(n)/ Transform this map by applying a function to every value;-- when f k v returns Just x, keep an entry mapping k to x, otherwise-- do not include k in the result.filterMapWithKey::(k->v1->Maybev2)->HashMapkv1->HashMapkv2filterMapWithKeyf=gowherego(Binsmlr)=binsm(gol)(gor)go(Tiphvs)=caseFL.foldrWithKeyffFL.NilvsofFL.Nil->NilFL.Conskvxs->Tiph(FL.FLkvxs)goNil=Nilffkvxs=casefkvofNothing->xsJustx->FL.Conskxxs{-# INLINE filterMapWithKey #-}-- | /O(n)/ Transform this map by accumulating an Applicative result-- from every value.traverseWithKey::Applicativef=>(k->v1->fv2)->HashMapkv1->f(HashMapkv2)traverseWithKeyf=gowherego(Binsmlr)=Binsm<$>gol<*>gorgo(Tiphl)=Tiph<$>FL.traverseWithKeyflgoNil=pureNil{-# INLINE traverseWithKey #-}-------------------------------------------------------------------------- Helpersjoin::Suffix->HashMapkv->Suffix->HashMapkv->HashMapkvjoins1t1s2t2|zeros1sm=Binsmt1t2|otherwise=Binsmt2t1wheresm=branchSuffixMasks1s2{-# INLINE join #-}-- | @bin@ assures that we never have empty trees within a tree.bin::SuffixMask->HashMapkv->HashMapkv->HashMapkvbin_lNil=lbin_Nilr=rbinsmlr=Binsmlr{-# INLINE bin #-}-------------------------------------------------------------------------- Endian independent bit twiddling-- Actually detects if every set bit of sm is set in i (and returns-- false if so). In most cases, the Suffix will already match, and-- this just tests the Mask. For lookup it can send us down the wrong-- path, but that's OK; we'll detect this when we reach a Tip and-- don't match. We could have checked (i .|. fromIntegral sm) /= i-- instead.zero::Hash->SuffixMask->Boolzeroism=(i.&.smi)/=smiwheresmi=fromIntegralsm{-# INLINE zero #-}-- We want to detect Suffix bits in the Hash that differ from-- SuffixMask. To do this, we find the first bit that differs between-- Hash and SuffixMask, then check if that bit is smaller than the-- Mask bit. We do this by observing that if we set this bit and all-- bits to its right, we'll obtain a number >= the suffixmask if all-- bits are the same (cb == 0, setting all bits) or if the first bit of-- difference is >= the Mask. Note: this comparison must be unsigned.nomatch::Hash->SuffixMask->Boolnomatchism=(cb+cb-1)<fromIntegralsmwherecb=differentBiti(fromIntegralsm){-# INLINE nomatch #-}-------------------------------------------------------------------------- Big endian operations-- | Compute the first (lowest-order) bit at which h1 and h2 differ.-- This is the mask that distinguishes them.differentBit::Hash->Hash->WorddifferentBith1h2=fromIntegral(critBit(fromIntegralh1`xor`fromIntegralh2))-- | Given mask bit m expressed as a word, compute the suffix bits of-- hash i, also expressed as a word.suffixW::Word->Word->WordsuffixWim=i.&.(m-1){-# INLINE suffixW #-}-- | Given two hashes and/or SuffixMasks for which nomatch p1 p2 &&-- nomatch p2 p1, compute SuffixMask that differentiates them, by-- first computing the mask m and then using that to derive a suffix-- from one of them (it won't matter which, as those bits are the-- same).branchSuffixMask::Suffix->Suffix->SuffixMaskbranchSuffixMaskp1p2=fromIntegral(m+suffixWw1m)wherem=differentBitp1p2w1=fromIntegralp1{-# INLINE branchSuffixMask #-}-- | Is the mask of sm1 closer to the root of the tree (lower order)-- than the mask of sm2? This is actually approximate, and returns-- junk when both sm1 and sm2 are at the same tree level. This must-- be disambiguated by first checking sm1==sm2, and subsequently by-- checking nomatch in the appropriate direction (which will need to-- happen anyway to determine if insertion or branching is-- appropriate).shorter::SuffixMask->SuffixMask->Boolshortersm1sm2=(fromIntegralsm1::Word)<(fromIntegralsm2::Word){-# INLINE shorter #-}-- | Return a 'Word' whose single set bit corresponds to the lowest set bit of w.critBit::Word->WordcritBitw=w.&.(negatew){-# INLINE critBit #-}