Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE BangPatterns, NoImplicitPrelude, RecordWildCards #-}{-# OPTIONS_GHC -Wno-name-shadowing #-}moduleGHC.Event.IntTable(IntTable,new,lookup,insertWith,reset,delete,updateWith)whereimportData.Bits((.&.),shiftL,shiftR)importData.IORef(IORef,newIORef,readIORef,writeIORef)importData.Maybe(Maybe(..),isJust)importForeign.ForeignPtr(ForeignPtr,mallocForeignPtr,withForeignPtr)importForeign.Storable(peek,poke)importGHC.Base(Monad(..),(=<<),($),($!),const,liftM,otherwise,when)importGHC.Classes(Eq(..),Ord(..))importGHC.Event.Arr(Arr)importGHC.Num(Num(..))importGHC.Prim(seq)importGHC.Types(Bool(..),IO(..),Int(..))importqualifiedGHC.Event.ArrasArr-- A very simple chained integer-keyed mutable hash table. We use-- power-of-two sizing, grow at a load factor of 0.75, and never-- shrink. The "hash function" is the identity function.newtypeIntTablea=IntTable(IORef(ITa))dataITa=IT{tabArr::{-# UNPACK#-}!(Arr(Bucketa)),tabSize::{-# UNPACK#-}!(ForeignPtrInt)}dataBucketa=Empty|Bucket{bucketKey::{-# UNPACK#-}!Int,bucketValue::a,bucketNext::Bucketa}lookup::Int->IntTablea->IO(Maybea)lookupk(IntTableref)=doletgoBucket{..}|bucketKey==k=JustbucketValue|otherwise=gobucketNextgo_=Nothingit@IT{..}<-readIORefrefbkt<-Arr.readtabArr(indexOfkit)return$!gobktnew::Int->IO(IntTablea)newcapacity=IntTable`liftM`(newIORef=<<new_capacity)new_::Int->IO(ITa)new_capacity=doarr<-Arr.newEmptycapacitysize<-mallocForeignPtrwithForeignPtrsize$\ptr->pokeptr0returnIT{tabArr=arr,tabSize=size}grow::ITa->IORef(ITa)->Int->IO()growolditrefsize=donewit<-new_(Arr.size(tabArroldit)`shiftL`1)letcopySlotn!i|n==size=return()|otherwise=doletcopyBucket!mEmpty=copySlotm(i+1)copyBucketmbkt@Bucket{..}=doletidx=indexOfbucketKeynewitnext<-Arr.read(tabArrnewit)idxArr.write(tabArrnewit)idxbkt{bucketNext=next}copyBucket(m+1)bucketNextcopyBucketn=<<Arr.read(tabArroldit)icopySlot00withForeignPtr(tabSizenewit)$\ptr->pokeptrsizewriteIORefrefnewit-- | @insertWith f k v table@ inserts @k@ into @table@ with value @v@.-- If @k@ already appears in @table@ with value @v0@, the value is updated-- to @f v0 v@ and @Just v0@ is returned.insertWith::(a->a->a)->Int->a->IntTablea->IO(Maybea)insertWithfkvinttable@(IntTableref)=doit@IT{..}<-readIORefrefletidx=indexOfkitgoseenbkt@Bucket{..}|bucketKey==k=dolet!v'=fvbucketValue!next=seen<>bucketNextEmpty<>bs=bsb@Bucket{..}<>bs=b{bucketNext=bucketNext<>bs}Arr.writetabArridx(Bucketkv'next)return(JustbucketValue)|otherwise=gobkt{bucketNext=seen}bucketNextgoseen_=withForeignPtrtabSize$\ptr->dosize<-peekptrifsize+1>=Arr.sizetabArr-(Arr.sizetabArr`shiftR`2)thengrowitrefsize>>insertWithfkvinttableelsedov`seq`Arr.writetabArridx(Bucketkvseen)pokeptr(size+1)returnNothinggoEmpty=<<Arr.readtabArridx{-# INLINABLEinsertWith#-}-- | Used to undo the effect of a prior insertWith.reset::Int->Maybea->IntTablea->IO()resetk(Justv)tbl=insertWithconstkvtbl>>return()resetkNothingtbl=deletektbl>>return()indexOf::Int->ITa->IntindexOfkIT{..}=k.&.(Arr.sizetabArr-1)-- | Remove the given key from the table and return its associated value.delete::Int->IntTablea->IO(Maybea)deletekt=updateWith(constNothing)ktupdateWith::(a->Maybea)->Int->IntTablea->IO(Maybea)updateWithfk(IntTableref)=doit@IT{..}<-readIORefrefletidx=indexOfkitgobkt@Bucket{..}|bucketKey==k=casefbucketValueofJustval->let!nb=bkt{bucketValue=val}in(False,JustbucketValue,nb)Nothing->(True,JustbucketValue,bucketNext)|otherwise=casegobucketNextof(fbv,ov,nb)->(fbv,ov,bkt{bucketNext=nb})goe=(False,Nothing,e)(del,oldVal,newBucket)<-go`liftM`Arr.readtabArridxwhen(isJustoldVal)$doArr.writetabArridxnewBucketwhendel$withForeignPtrtabSize$\ptr->dosize<-peekptrpokeptr(size-1)returnoldVal