#if!defined(TESTING)&&__GLASGOW_HASKELL__>=703{-# LANGUAGE Trustworthy #-}#endif------------------------------------------------------------------------------- |-- Module : Data.IntSet-- Copyright : (c) Daan Leijen 2002-- License : BSD-style-- Maintainer : libraries@haskell.org-- Stability : provisional-- Portability : portable---- An efficient implementation of integer sets.---- Since many function names (but not the type name) clash with-- "Prelude" names, this module is usually imported @qualified@, e.g.---- > import Data.IntSet (IntSet)-- > import qualified Data.IntSet as IntSet---- The implementation is based on /big-endian patricia trees/. This data-- structure performs especially well on binary operations like 'union'-- and 'intersection'. However, my benchmarks show that it is also-- (much) faster on insertions and deletions when compared to a generic-- size-balanced set implementation (see "Data.Set").---- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",-- Workshop on ML, September 1998, pages 77-86,-- <http://citeseer.ist.psu.edu/okasaki98fast.html>---- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve-- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),-- October 1968, pages 514-534.---- Many operations have a worst-case complexity of /O(min(n,W))/.-- This means that the operation can become linear in the number of-- elements with a maximum of /W/ -- the number of bits in an 'Int'-- (32 or 64).------------------------------------------------------------------------------- It is essential that the bit fiddling functions like mask, zero, branchMask-- etc are inlined. If they do not, the memory allocation skyrockets. The GHC-- usually gets it right, but it is disastrous if it does not. Therefore we-- explicitly mark these functions INLINE.moduleData.IntSet(-- * Set type#if !defined(TESTING)IntSet-- instance Eq,Show#elseIntSet(..)-- instance Eq,Show#endif-- * Operators,(\\)-- * Query,null,size,member,notMember,isSubsetOf,isProperSubsetOf-- * Construction,empty,singleton,insert,delete-- * Combine,union,unions,difference,intersection-- * Filter,filter,partition,split,splitMember-- * Map,map-- * Folds,foldr,foldl-- ** Strict folds,foldr',foldl'-- ** Legacy folds,fold-- * Min\/Max,findMin,findMax,deleteMin,deleteMax,deleteFindMin,deleteFindMax,maxView,minView-- * Conversion-- ** List,elems,toList,fromList-- ** Ordered list,toAscList,fromAscList,fromDistinctAscList-- * Debugging,showTree,showTreeWith#if defined(TESTING)-- * Internals,match#endif)whereimportPreludehiding(lookup,filter,foldr,foldl,null,map)importData.BitsimportqualifiedData.ListasListimportData.Monoid(Monoid(..))importData.Maybe(fromMaybe)importData.TypeableimportControl.DeepSeq(NFData)#if __GLASGOW_HASKELL__importText.ReadimportData.Data(Data(..),mkNoRepType)#endif#if __GLASGOW_HASKELL__ >= 503importGHC.Exts(Word(..),Int(..),shiftRL#)#elif __GLASGOW_HASKELL__importWordimportGlaExts(Word(..),Int(..),shiftRL#)#elseimportData.Word#endif-- Use macros to define strictness of functions.-- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter.-- We do not use BangPatterns, because they are not in any standard and we-- want the compilers to be compiled by as many compilers as possible.#define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefinedinfixl9\\{-This comment teaches CPP correct behaviour -}-- A "Nat" is a natural machine word (an unsigned Int)typeNat=WordnatFromInt::Int->NatnatFromInti=fromIntegrali{-# INLINE natFromInt #-}intFromNat::Nat->IntintFromNatw=fromIntegralw{-# INLINE intFromNat #-}shiftRL::Nat->Int->Nat#if __GLASGOW_HASKELL__{--------------------------------------------------------------------
GHC: use unboxing to get @shiftRL@ inlined.
--------------------------------------------------------------------}shiftRL(W#x)(I#i)=W#(shiftRL#xi)#elseshiftRLxi=shiftRxi{-# INLINE shiftRL #-}#endif{--------------------------------------------------------------------
Operators
--------------------------------------------------------------------}-- | /O(n+m)/. See 'difference'.(\\)::IntSet->IntSet->IntSetm1\\m2=differencem1m2{--------------------------------------------------------------------
Types
--------------------------------------------------------------------}-- The order of constructors of IntSet matters when considering performance.-- Currently in GHC 7.0, when type has 3 constructors, they are matched from-- the first to the last -- the best performance is achieved when the-- constructors are ordered by frequency.-- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil-- improves the containers_benchmark by 11% on x86 and by 9% on x86_64.-- | A set of integers.dataIntSet=Bin{-# UNPACK #-}!Prefix{-# UNPACK #-}!Mask!IntSet!IntSet|Tip{-# UNPACK #-}!Int|Nil-- Invariant: Nil is never found as a child of Bin.-- Invariant: The Mask is a power of 2. It is the largest bit position at which-- two elements of the set differ.-- Invariant: Prefix is the common high-order bits that all elements share to-- the left of the Mask bit.-- Invariant: In Bin prefix mask left right, left consists of the elements that-- don't have the mask bit set; right is all the elements that do.typePrefix=InttypeMask=IntinstanceMonoidIntSetwheremempty=emptymappend=unionmconcat=unions#if __GLASGOW_HASKELL__{--------------------------------------------------------------------
A Data instance
--------------------------------------------------------------------}-- This instance preserves data abstraction at the cost of inefficiency.-- We omit reflection services for the sake of data abstraction.instanceDataIntSetwheregfoldlfzis=zfromList`f`(toListis)toConstr_=error"toConstr"gunfold__=error"gunfold"dataTypeOf_=mkNoRepType"Data.IntSet.IntSet"#endif{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}-- | /O(1)/. Is the set empty?null::IntSet->BoolnullNil=Truenull_=False-- | /O(n)/. Cardinality of the set.size::IntSet->Intsizet=casetofBin__lr->sizel+sizerTip_->1Nil->0-- The 'go' function in the member and lookup causes 10% speedup, but also an-- increased memory allocation. It does not cause speedup with other methods-- like insert and delete, so it is present only in member and lookup.-- Also mind the 'nomatch' line in member definition, which is not present in-- lookup and not present in IntMap.hs. That condition stops the search if the-- prefix of current vertex is different that the element looked for. The-- member is correct both with and without this condition. With this condition,-- elements not present are rejected sooner, but a little bit more work is done-- for the elements in the set (we are talking about 3-5% slowdown). Any of-- the solutions is better than the other, because we do not know the-- distribution of input data. Current state is historic.-- | /O(min(n,W))/. Is the value a member of the set?member::Int->IntSet->Boolmemberx=x`seq`gowherego(Binpmlr)|nomatchxpm=False|zeroxm=gol|otherwise=gorgo(Tipy)=x==ygoNil=False-- | /O(min(n,W))/. Is the element not in the set?notMember::Int->IntSet->BoolnotMemberk=not.memberk-- 'lookup' is used by 'intersection' for left-biasinglookup::Int->IntSet->MaybeIntlookupk=k`seq`gowherego(Bin_mlr)|zerokm=gol|otherwise=gorgo(Tipkx)|k==kx=Justkx|otherwise=NothinggoNil=Nothing{--------------------------------------------------------------------
Construction
--------------------------------------------------------------------}-- | /O(1)/. The empty set.empty::IntSetempty=Nil-- | /O(1)/. A set of one element.singleton::Int->IntSetsingletonx=Tipx{--------------------------------------------------------------------
Insert
--------------------------------------------------------------------}-- | /O(min(n,W))/. Add a value to the set. When the value is already-- an element of the set, it is replaced by the new one, ie. 'insert'-- is left-biased.insert::Int->IntSet->IntSetinsertxt=x`seq`casetofBinpmlr|nomatchxpm->joinx(Tipx)pt|zeroxm->Binpm(insertxl)r|otherwise->Binpml(insertxr)Tipy|x==y->Tipx|otherwise->joinx(Tipx)ytNil->Tipx-- right-biased insertion, used by 'union'insertR::Int->IntSet->IntSetinsertRxt=x`seq`casetofBinpmlr|nomatchxpm->joinx(Tipx)pt|zeroxm->Binpm(insertxl)r|otherwise->Binpml(insertxr)Tipy|x==y->t|otherwise->joinx(Tipx)ytNil->Tipx-- | /O(min(n,W))/. Delete a value in the set. Returns the-- original set when the value was not present.delete::Int->IntSet->IntSetdeletext=x`seq`casetofBinpmlr|nomatchxpm->t|zeroxm->binpm(deletexl)r|otherwise->binpml(deletexr)Tipy|x==y->Nil|otherwise->tNil->Nil{--------------------------------------------------------------------
Union
--------------------------------------------------------------------}-- | The union of a list of sets.unions::[IntSet]->IntSetunionsxs=foldlStrictunionemptyxs-- | /O(n+m)/. The union of two sets. union::IntSet->IntSet->IntSetuniont1@(Binp1m1l1r1)t2@(Binp2m2l2r2)|shorterm1m2=union1|shorterm2m1=union2|p1==p2=Binp1m1(unionl1l2)(unionr1r2)|otherwise=joinp1t1p2t2whereunion1|nomatchp2p1m1=joinp1t1p2t2|zerop2m1=Binp1m1(unionl1t2)r1|otherwise=Binp1m1l1(unionr1t2)union2|nomatchp1p2m2=joinp1t1p2t2|zerop1m2=Binp2m2(uniont1l2)r2|otherwise=Binp2m2l2(uniont1r2)union(Tipx)t=insertxtuniont(Tipx)=insertRxt-- right biasunionNilt=tuniontNil=t{--------------------------------------------------------------------
Difference
--------------------------------------------------------------------}-- | /O(n+m)/. Difference between two sets. difference::IntSet->IntSet->IntSetdifferencet1@(Binp1m1l1r1)t2@(Binp2m2l2r2)|shorterm1m2=difference1|shorterm2m1=difference2|p1==p2=binp1m1(differencel1l2)(differencer1r2)|otherwise=t1wheredifference1|nomatchp2p1m1=t1|zerop2m1=binp1m1(differencel1t2)r1|otherwise=binp1m1l1(differencer1t2)difference2|nomatchp1p2m2=t1|zerop1m2=differencet1l2|otherwise=differencet1r2differencet1@(Tipx)t2|memberxt2=Nil|otherwise=t1differenceNil_=Nildifferencet(Tipx)=deletextdifferencetNil=t{--------------------------------------------------------------------
Intersection
--------------------------------------------------------------------}-- | /O(n+m)/. The intersection of two sets. intersection::IntSet->IntSet->IntSetintersectiont1@(Binp1m1l1r1)t2@(Binp2m2l2r2)|shorterm1m2=intersection1|shorterm2m1=intersection2|p1==p2=binp1m1(intersectionl1l2)(intersectionr1r2)|otherwise=Nilwhereintersection1|nomatchp2p1m1=Nil|zerop2m1=intersectionl1t2|otherwise=intersectionr1t2intersection2|nomatchp1p2m2=Nil|zerop1m2=intersectiont1l2|otherwise=intersectiont1r2intersectiont1@(Tipx)t2|memberxt2=t1|otherwise=Nilintersectiont(Tipx)=caselookupxtofJusty->TipyNothing->NilintersectionNil_=Nilintersection_Nil=Nil{--------------------------------------------------------------------
Subset
--------------------------------------------------------------------}-- | /O(n+m)/. Is this a proper subset? (ie. a subset but not equal).isProperSubsetOf::IntSet->IntSet->BoolisProperSubsetOft1t2=casesubsetCmpt1t2ofLT->True_->FalsesubsetCmp::IntSet->IntSet->OrderingsubsetCmpt1@(Binp1m1l1r1)(Binp2m2l2r2)|shorterm1m2=GT|shorterm2m1=casesubsetCmpLtofGT->GT_->LT|p1==p2=subsetCmpEq|otherwise=GT-- disjointwheresubsetCmpLt|nomatchp1p2m2=GT|zerop1m2=subsetCmpt1l2|otherwise=subsetCmpt1r2subsetCmpEq=case(subsetCmpl1l2,subsetCmpr1r2)of(GT,_)->GT(_,GT)->GT(EQ,EQ)->EQ_->LTsubsetCmp(Bin____)_=GTsubsetCmp(Tipx)(Tipy)|x==y=EQ|otherwise=GT-- disjointsubsetCmp(Tipx)t|memberxt=LT|otherwise=GT-- disjointsubsetCmpNilNil=EQsubsetCmpNil_=LT-- | /O(n+m)/. Is this a subset?-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.isSubsetOf::IntSet->IntSet->BoolisSubsetOft1@(Binp1m1l1r1)(Binp2m2l2r2)|shorterm1m2=False|shorterm2m1=matchp1p2m2&&(ifzerop1m2thenisSubsetOft1l2elseisSubsetOft1r2)|otherwise=(p1==p2)&&isSubsetOfl1l2&&isSubsetOfr1r2isSubsetOf(Bin____)_=FalseisSubsetOf(Tipx)t=memberxtisSubsetOfNil_=True{--------------------------------------------------------------------
Filter
--------------------------------------------------------------------}-- | /O(n)/. Filter all elements that satisfy some predicate.filter::(Int->Bool)->IntSet->IntSetfilterpredicatet=casetofBinpmlr->binpm(filterpredicatel)(filterpredicater)Tipx|predicatex->t|otherwise->NilNil->Nil-- | /O(n)/. partition the set according to some predicate.partition::(Int->Bool)->IntSet->(IntSet,IntSet)partitionpredicatet=casetofBinpmlr->let(l1,l2)=partitionpredicatel(r1,r2)=partitionpredicaterin(binpml1r1,binpml2r2)Tipx|predicatex->(t,Nil)|otherwise->(Nil,t)Nil->(Nil,Nil)-- | /O(min(n,W))/. The expression (@'split' x set@) is a pair @(set1,set2)@-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@-- comprises the elements of @set@ greater than @x@.---- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5])split::Int->IntSet->(IntSet,IntSet)splitxt=casetofBin_mlr|m<0->ifx>=0thenlet(lt,gt)=split'xlin(unionrlt,gt)elselet(lt,gt)=split'xrin(lt,uniongtl)-- handle negative numbers.|otherwise->split'xtTipy|x>y->(t,Nil)|x<y->(Nil,t)|otherwise->(Nil,Nil)Nil->(Nil,Nil)split'::Int->IntSet->(IntSet,IntSet)split'xt=casetofBinpmlr|matchxpm->ifzeroxmthenlet(lt,gt)=split'xlin(lt,uniongtr)elselet(lt,gt)=split'xrin(unionllt,gt)|otherwise->ifx<pthen(Nil,t)else(t,Nil)Tipy|x>y->(t,Nil)|x<y->(Nil,t)|otherwise->(Nil,Nil)Nil->(Nil,Nil)-- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot-- element was found in the original set.splitMember::Int->IntSet->(IntSet,Bool,IntSet)splitMemberxt=casetofBin_mlr|m<0->ifx>=0thenlet(lt,found,gt)=splitMember'xlin(unionrlt,found,gt)elselet(lt,found,gt)=splitMember'xrin(lt,found,uniongtl)-- handle negative numbers.|otherwise->splitMember'xtTipy|x>y->(t,False,Nil)|x<y->(Nil,False,t)|otherwise->(Nil,True,Nil)Nil->(Nil,False,Nil)splitMember'::Int->IntSet->(IntSet,Bool,IntSet)splitMember'xt=casetofBinpmlr|matchxpm->ifzeroxmthenlet(lt,found,gt)=splitMemberxlin(lt,found,uniongtr)elselet(lt,found,gt)=splitMemberxrin(unionllt,found,gt)|otherwise->ifx<pthen(Nil,False,t)else(t,False,Nil)Tipy|x>y->(t,False,Nil)|x<y->(Nil,False,t)|otherwise->(Nil,True,Nil)Nil->(Nil,False,Nil){----------------------------------------------------------------------
Min/Max
----------------------------------------------------------------------}-- | /O(min(n,W))/. Retrieves the maximal key of the set, and the set-- stripped of that element, or 'Nothing' if passed an empty set.maxView::IntSet->Maybe(Int,IntSet)maxViewt=casetofBinpmlr|m<0->let(result,t')=maxViewUnsignedlinJust(result,binpmt'r)Binpmlr->let(result,t')=maxViewUnsignedrinJust(result,binpmlt')Tipy->Just(y,Nil)Nil->NothingmaxViewUnsigned::IntSet->(Int,IntSet)maxViewUnsignedt=casetofBinpmlr->let(result,t')=maxViewUnsignedrin(result,binpmlt')Tipy->(y,Nil)Nil->error"maxViewUnsigned Nil"-- | /O(min(n,W))/. Retrieves the minimal key of the set, and the set-- stripped of that element, or 'Nothing' if passed an empty set.minView::IntSet->Maybe(Int,IntSet)minViewt=casetofBinpmlr|m<0->let(result,t')=minViewUnsignedrinJust(result,binpmlt')Binpmlr->let(result,t')=minViewUnsignedlinJust(result,binpmt'r)Tipy->Just(y,Nil)Nil->NothingminViewUnsigned::IntSet->(Int,IntSet)minViewUnsignedt=casetofBinpmlr->let(result,t')=minViewUnsignedlin(result,binpmt'r)Tipy->(y,Nil)Nil->error"minViewUnsigned Nil"-- | /O(min(n,W))/. Delete and find the minimal element.-- -- > deleteFindMin set = (findMin set, deleteMin set)deleteFindMin::IntSet->(Int,IntSet)deleteFindMin=fromMaybe(error"deleteFindMin: empty set has no minimal element").minView-- | /O(min(n,W))/. Delete and find the maximal element.-- -- > deleteFindMax set = (findMax set, deleteMax set)deleteFindMax::IntSet->(Int,IntSet)deleteFindMax=fromMaybe(error"deleteFindMax: empty set has no maximal element").maxView-- | /O(min(n,W))/. The minimal element of the set.findMin::IntSet->IntfindMinNil=error"findMin: empty set has no minimal element"findMin(Tipx)=xfindMin(Bin_mlr)|m<0=findr|otherwise=findlwherefind(Tipx)=xfind(Bin__l'_)=findl'findNil=error"findMin Nil"-- | /O(min(n,W))/. The maximal element of a set.findMax::IntSet->IntfindMaxNil=error"findMax: empty set has no maximal element"findMax(Tipx)=xfindMax(Bin_mlr)|m<0=findl|otherwise=findrwherefind(Tipx)=xfind(Bin___r')=findr'findNil=error"findMax Nil"-- | /O(min(n,W))/. Delete the minimal element.deleteMin::IntSet->IntSetdeleteMin=maybe(error"deleteMin: empty set has no minimal element")snd.minView-- | /O(min(n,W))/. Delete the maximal element.deleteMax::IntSet->IntSetdeleteMax=maybe(error"deleteMax: empty set has no maximal element")snd.maxView{----------------------------------------------------------------------
Map
----------------------------------------------------------------------}-- | /O(n*min(n,W))/. -- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.-- -- It's worth noting that the size of the result may be smaller if,-- for some @(x,y)@, @x \/= y && f x == f y@map::(Int->Int)->IntSet->IntSetmapf=fromList.List.mapf.toList{--------------------------------------------------------------------
Fold
--------------------------------------------------------------------}-- | /O(n)/. Fold the elements in the set using the given right-associative-- binary operator. This function is an equivalent of 'foldr' and is present-- for compatibility only.---- /Please note that fold will be deprecated in the future and removed./fold::(Int->b->b)->b->IntSet->bfold=foldr{-# INLINE fold #-}-- | /O(n)/. Fold the elements in the set using the given right-associative-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'toAscList'@.---- For example,---- > toAscList set = foldr (:) [] setfoldr::(Int->b->b)->b->IntSet->bfoldrfzt=casetofBin0mlr|m<0->go(gozl)r-- put negative numbers before_->goztwheregoz'Nil=z'goz'(Tipx)=fxz'goz'(Bin__lr)=go(goz'r)l{-# INLINE foldr #-}-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is-- evaluated before using the result in the next application. This-- function is strict in the starting value.foldr'::(Int->b->b)->b->IntSet->bfoldr'fzt=casetofBin0mlr|m<0->go(gozl)r-- put negative numbers before_->goztwhereSTRICT_1_OF_2(go)goz'Nil=z'goz'(Tipx)=fxz'goz'(Bin__lr)=go(goz'r)l{-# INLINE foldr' #-}-- | /O(n)/. Fold the elements in the set using the given left-associative-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'toAscList'@.---- For example,---- > toDescList set = foldl (flip (:)) [] setfoldl::(a->Int->a)->a->IntSet->afoldlfzt=casetofBin0mlr|m<0->go(gozr)l-- put negative numbers before_->goztwhereSTRICT_1_OF_2(go)goz'Nil=z'goz'(Tipx)=fz'xgoz'(Bin__lr)=go(goz'l)r{-# INLINE foldl #-}-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is-- evaluated before using the result in the next application. This-- function is strict in the starting value.foldl'::(a->Int->a)->a->IntSet->afoldl'fzt=casetofBin0mlr|m<0->go(gozr)l-- put negative numbers before_->goztwhereSTRICT_1_OF_2(go)goz'Nil=z'goz'(Tipx)=fz'xgoz'(Bin__lr)=go(goz'l)r{-# INLINE foldl' #-}{--------------------------------------------------------------------
List variations
--------------------------------------------------------------------}-- | /O(n)/. The elements of a set. (For sets, this is equivalent to toList)elems::IntSet->[Int]elemss=toLists{--------------------------------------------------------------------
Lists
--------------------------------------------------------------------}-- | /O(n)/. Convert the set to a list of elements.toList::IntSet->[Int]toListt=fold(:)[]t-- | /O(n)/. Convert the set to an ascending list of elements.toAscList::IntSet->[Int]toAscListt=toListt-- | /O(n*min(n,W))/. Create a set from a list of integers.fromList::[Int]->IntSetfromListxs=foldlStrictinsemptyxswhereinstx=insertxt-- | /O(n)/. Build a set from an ascending list of elements.-- /The precondition (input list is ascending) is not checked./fromAscList::[Int]->IntSetfromAscList[]=NilfromAscList(x0:xs0)=fromDistinctAscList(combineEqx0xs0)wherecombineEqx'[]=[x']combineEqx'(x:xs)|x==x'=combineEqx'xs|otherwise=x':combineEqxxs-- | /O(n)/. Build a set from an ascending list of distinct elements.-- /The precondition (input list is strictly ascending) is not checked./fromDistinctAscList::[Int]->IntSetfromDistinctAscList[]=NilfromDistinctAscList(z0:zs0)=workz0zs0Nadawhereworkx[]stk=finishx(Tipx)stkworkx(z:zs)stk=reducezzs(branchMaskzx)x(Tipx)stkreducezzs_pxtxNada=workzzs(PushpxtxNada)reducezzsmpxtxstk@(Pushpytystk')=letmxy=branchMaskpxpypxy=maskpxmxyinifshortermmxythenreducezzsmpxy(Binpxymxytytx)stk'elseworkzzs(Pushpxtxstk)finish_tNada=tfinishpxtx(Pushpytystk)=finishp(joinpytypxtx)stkwherem=branchMaskpxpyp=maskpxmdataStack=Push{-# UNPACK #-}!Prefix!IntSet!Stack|Nada{--------------------------------------------------------------------
Eq
--------------------------------------------------------------------}instanceEqIntSetwheret1==t2=equalt1t2t1/=t2=nequalt1t2equal::IntSet->IntSet->Boolequal(Binp1m1l1r1)(Binp2m2l2r2)=(m1==m2)&&(p1==p2)&&(equall1l2)&&(equalr1r2)equal(Tipx)(Tipy)=(x==y)equalNilNil=Trueequal__=Falsenequal::IntSet->IntSet->Boolnequal(Binp1m1l1r1)(Binp2m2l2r2)=(m1/=m2)||(p1/=p2)||(nequall1l2)||(nequalr1r2)nequal(Tipx)(Tipy)=(x/=y)nequalNilNil=Falsenequal__=True{--------------------------------------------------------------------
Ord
--------------------------------------------------------------------}instanceOrdIntSetwherecompares1s2=compare(toAscLists1)(toAscLists2)-- tentative implementation. See if more efficient exists.{--------------------------------------------------------------------
Show
--------------------------------------------------------------------}instanceShowIntSetwhereshowsPrecpxs=showParen(p>10)$showString"fromList ".shows(toListxs){-
XXX unused code
showSet :: [Int] -> ShowS
showSet []
= showString "{}"
showSet (x:xs)
= showChar '{' . shows x . showTail xs
where
showTail [] = showChar '}'
showTail (x':xs') = showChar ',' . shows x' . showTail xs'
-}{--------------------------------------------------------------------
Read
--------------------------------------------------------------------}instanceReadIntSetwhere#ifdef __GLASGOW_HASKELL__readPrec=parens$prec10$doIdent"fromList"<-lexPxs<-readPrecreturn(fromListxs)readListPrec=readListPrecDefault#elsereadsPrecp=readParen(p>10)$\r->do("fromList",s)<-lexr(xs,t)<-readssreturn(fromListxs,t)#endif{--------------------------------------------------------------------
Typeable
--------------------------------------------------------------------}#include "Typeable.h"INSTANCE_TYPEABLE0(IntSet,intSetTc,"IntSet"){--------------------------------------------------------------------
NFData
--------------------------------------------------------------------}-- The IntSet constructors consist only of strict fields of Ints and-- IntSets, thus the default NFData instance which evaluates to whnf-- should sufficeinstanceNFDataIntSet{--------------------------------------------------------------------
Debugging
--------------------------------------------------------------------}-- | /O(n)/. Show the tree that implements the set. The tree is shown-- in a compressed, hanging format.showTree::IntSet->StringshowTrees=showTreeWithTrueFalses{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
the tree that implements the set. If @hang@ is
'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
@wide@ is 'True', an extra wide version is shown.
-}showTreeWith::Bool->Bool->IntSet->StringshowTreeWithhangwidet|hang=(showsTreeHangwide[]t)""|otherwise=(showsTreewide[][]t)""showsTree::Bool->[String]->[String]->IntSet->ShowSshowsTreewidelbarsrbarst=casetofBinpmlr->showsTreewide(withBarrbars)(withEmptyrbars)r.showWidewiderbars.showsBarslbars.showString(showBinpm).showString"\n".showWidewidelbars.showsTreewide(withEmptylbars)(withBarlbars)lTipx->showsBarslbars.showString" ".showsx.showString"\n"Nil->showsBarslbars.showString"|\n"showsTreeHang::Bool->[String]->IntSet->ShowSshowsTreeHangwidebarst=casetofBinpmlr->showsBarsbars.showString(showBinpm).showString"\n".showWidewidebars.showsTreeHangwide(withBarbars)l.showWidewidebars.showsTreeHangwide(withEmptybars)rTipx->showsBarsbars.showString" ".showsx.showString"\n"Nil->showsBarsbars.showString"|\n"showBin::Prefix->Mask->StringshowBin__="*"-- ++ show (p,m)showWide::Bool->[String]->String->StringshowWidewidebars|wide=showString(concat(reversebars)).showString"|\n"|otherwise=idshowsBars::[String]->ShowSshowsBarsbars=casebarsof[]->id_->showString(concat(reverse(tailbars))).showStringnodenode::Stringnode="+--"withBar,withEmpty::[String]->[String]withBarbars="| ":barswithEmptybars=" ":bars{--------------------------------------------------------------------
Helpers
--------------------------------------------------------------------}{--------------------------------------------------------------------
Join
--------------------------------------------------------------------}join::Prefix->IntSet->Prefix->IntSet->IntSetjoinp1t1p2t2|zerop1m=Binpmt1t2|otherwise=Binpmt2t1wherem=branchMaskp1p2p=maskp1m{-# INLINE join #-}{--------------------------------------------------------------------
@bin@ assures that we never have empty trees within a tree.
--------------------------------------------------------------------}bin::Prefix->Mask->IntSet->IntSet->IntSetbin__lNil=lbin__Nilr=rbinpmlr=Binpmlr{-# INLINE bin #-}{--------------------------------------------------------------------
Endian independent bit twiddling
--------------------------------------------------------------------}zero::Int->Mask->Boolzeroim=(natFromInti).&.(natFromIntm)==0{-# INLINE zero #-}nomatch,match::Int->Prefix->Mask->Boolnomatchipm=(maskim)/=p{-# INLINE nomatch #-}matchipm=(maskim)==p{-# INLINE match #-}-- Suppose a is largest such that 2^a divides 2*m.-- Then mask i m is i with the low a bits zeroed out.mask::Int->Mask->Prefixmaskim=maskW(natFromInti)(natFromIntm){-# INLINE mask #-}{--------------------------------------------------------------------
Big endian operations
--------------------------------------------------------------------}maskW::Nat->Nat->PrefixmaskWim=intFromNat(i.&.(complement(m-1)`xor`m)){-# INLINE maskW #-}shorter::Mask->Mask->Boolshorterm1m2=(natFromIntm1)>(natFromIntm2){-# INLINE shorter #-}branchMask::Prefix->Prefix->MaskbranchMaskp1p2=intFromNat(highestBitMask(natFromIntp1`xor`natFromIntp2)){-# INLINE branchMask #-}{----------------------------------------------------------------------
Finding the highest bit (mask) in a word [x] can be done efficiently in
three ways:
* convert to a floating point value and the mantissa tells us the
[log2(x)] that corresponds with the highest bit position. The mantissa
is retrieved either via the standard C function [frexp] or by some bit
twiddling on IEEE compatible numbers (float). Note that one needs to
use at least [double] precision for an accurate mantissa of 32 bit
numbers.
* use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
* use processor specific assembler instruction (asm).
The most portable way would be [bit], but is it efficient enough?
I have measured the cycle counts of the different methods on an AMD
Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
highestBitMask: method cycles
--------------
frexp 200
float 33
bit 11
asm 12
highestBit: method cycles
--------------
frexp 195
float 33
bit 11
asm 11
Wow, the bit twiddling is on today's RISC like machines even faster
than a single CISC instruction (BSR)!
----------------------------------------------------------------------}{----------------------------------------------------------------------
[highestBitMask] returns a word where only the highest bit is set.
It is found by first setting all bits in lower positions than the
highest bit and than taking an exclusive or with the original value.
Allthough the function may look expensive, GHC compiles this into
excellent C code that subsequently compiled into highly efficient
machine code. The algorithm is derived from Jorg Arndt's FXT library.
----------------------------------------------------------------------}highestBitMask::Nat->NathighestBitMaskx0=case(x0.|.shiftRLx01)ofx1->case(x1.|.shiftRLx12)ofx2->case(x2.|.shiftRLx24)ofx3->case(x3.|.shiftRLx38)ofx4->case(x4.|.shiftRLx416)ofx5->case(x5.|.shiftRLx532)of-- for 64 bit platformsx6->(x6`xor`(shiftRLx61)){-# INLINE highestBitMask #-}{--------------------------------------------------------------------
Utilities
--------------------------------------------------------------------}foldlStrict::(a->b->a)->a->[b]->afoldlStrictf=gowheregoz[]=zgoz(x:xs)=letz'=fzxinz'`seq`goz'xs{-# INLINE foldlStrict #-}