Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE BangPatterns, CPP, NoImplicitPrelude #-}moduleGHC.Event.Array(Array,capacity,clear,concat,copy,duplicate,empty,ensureCapacity,findIndex,forM_,length,loop,new,removeAt,snoc,unsafeLoad,unsafeRead,unsafeWrite,useAsPtr)whereimportData.Bits((.|.),shiftR)importData.IORef(IORef,atomicModifyIORef',newIORef,readIORef,writeIORef)importData.MaybeimportForeign.C.Types(CSize(..))importForeign.ForeignPtr(ForeignPtr,withForeignPtr)importForeign.Ptr(Ptr,nullPtr,plusPtr)importForeign.Storable(Storable(..))importGHC.Basehiding(empty)importGHC.ForeignPtr(mallocPlainForeignPtrBytes,newForeignPtr_)importGHC.Num(Num(..))importGHC.Real(fromIntegral)importGHC.Show(show)#include "MachDeps.h"#define BOUNDS_CHECKING 1#if defined(BOUNDS_CHECKING)-- This fugly hack is brought by GHC's apparent reluctance to deal-- with MagicHash and UnboxedTuples when inferring types. Eek!#define CHECK_BOUNDS(_func_,_len_,_k_) \if (_k_) < 0 || (_k_) >= (_len_) then errorWithoutStackTrace ("GHC.Event.Array." ++ (_func_) ++ ": bounds error, index " ++ show (_k_) ++ ", capacity " ++ show (_len_)) else#else#define CHECK_BOUNDS(_func_,_len_,_k_)#endif-- Invariant: size <= capacitynewtypeArraya=Array(IORef(ACa))-- The actual array content.dataACa=AC!(ForeignPtra)-- Elements!Int-- Number of elements (length)!Int-- Maximum number of elements (capacity)empty::IO(Arraya)empty=dop<-newForeignPtr_nullPtrArray`fmap`newIORef(ACp00)allocArray::Storablea=>Int->IO(ForeignPtra)allocArrayn=allocHackundefinedwhereallocHack::Storablea=>a->IO(ForeignPtra)allocHackdummy=mallocPlainForeignPtrBytes(n*sizeOfdummy)reallocArray::Storablea=>ForeignPtra->Int->Int->IO(ForeignPtra)reallocArraypnewSizeoldSize=reallocHackundefinedpwherereallocHack::Storablea=>a->ForeignPtra->IO(ForeignPtra)reallocHackdummysrc=doletsize=sizeOfdummydst<-mallocPlainForeignPtrBytes(newSize*size)withForeignPtrsrc$\s->when(s/=nullPtr&&oldSize>0).withForeignPtrdst$\d->do_<-memcpyds(fromIntegral(oldSize*size))return()returndstnew::Storablea=>Int->IO(Arraya)newc=does<-allocArraycapfmapArray(newIORef(ACes0cap))wherecap=firstPowerOf2cduplicate::Storablea=>Arraya->IO(Arraya)duplicatea=dupHackundefinedawheredupHack::Storableb=>b->Arrayb->IO(Arrayb)dupHackdummy(Arrayref)=doACeslencap<-readIORefrefary<-allocArraycapwithForeignPtrary$\dest->withForeignPtres$\src->do_<-memcpydestsrc(fromIntegral(len*sizeOfdummy))return()Array`fmap`newIORef(ACarylencap)length::Arraya->IOIntlength(Arrayref)=doAC_len_<-readIORefrefreturnlencapacity::Arraya->IOIntcapacity(Arrayref)=doAC__cap<-readIORefrefreturncapunsafeRead::Storablea=>Arraya->Int->IOaunsafeRead(Arrayref)ix=doACes_cap<-readIORefrefCHECK_BOUNDS("unsafeRead",cap,ix)withForeignPtres$\p->peekElemOffpixunsafeWrite::Storablea=>Arraya->Int->a->IO()unsafeWrite(Arrayref)ixa=doac<-readIORefrefunsafeWrite'acixaunsafeWrite'::Storablea=>ACa->Int->a->IO()unsafeWrite'(ACes_cap)ixa=doCHECK_BOUNDS("unsafeWrite'",cap,ix)withForeignPtres$\p->pokeElemOffpixaunsafeLoad::Arraya->(Ptra->Int->IOInt)->IOIntunsafeLoad(Arrayref)load=doACes_cap<-readIORefreflen'<-withForeignPtres$\p->loadpcapwriteIORefref(ACeslen'cap)returnlen'ensureCapacity::Storablea=>Arraya->Int->IO()ensureCapacity(Arrayref)c=doac@(AC__cap)<-readIORefrefac'@(AC__cap')<-ensureCapacity'accwhen(cap'/=cap)$writeIORefrefac'ensureCapacity'::Storablea=>ACa->Int->IO(ACa)ensureCapacity'ac@(ACeslencap)c=doifc>capthendoes'<-reallocArrayescap'capreturn(ACes'lencap')elsereturnacwherecap'=firstPowerOf2cuseAsPtr::Arraya->(Ptra->Int->IOb)->IObuseAsPtr(Arrayref)f=doACeslen_<-readIORefrefwithForeignPtres$\p->fplensnoc::Storablea=>Arraya->a->IO()snoc(Arrayref)e=doac@(AC_len_)<-readIORefrefletlen'=len+1ac'@(ACes_cap)<-ensureCapacity'aclen'unsafeWrite'ac'lenewriteIORefref(ACeslen'cap)clear::Arraya->IO()clear(Arrayref)=doatomicModifyIORef'ref$\(ACes_cap)->(ACes0cap,())forM_::Storablea=>Arraya->(a->IO())->IO()forM_aryg=forHackarygundefinedwhereforHack::Storableb=>Arrayb->(b->IO())->b->IO()forHack(Arrayref)fdummy=doACeslen_<-readIORefrefletsize=sizeOfdummyoffset=len*sizewithForeignPtres$\p->doletgon|n>=offset=return()|otherwise=dof=<<peek(p`plusPtr`n)go(n+size)go0loop::Storablea=>Arraya->b->(b->a->IO(b,Bool))->IO()looparyzg=loopHackaryzgundefinedwhereloopHack::Storableb=>Arrayb->c->(c->b->IO(c,Bool))->b->IO()loopHack(Arrayref)yfdummy=doACeslen_<-readIORefrefletsize=sizeOfdummyoffset=len*sizewithForeignPtres$\p->doletgonk|n>=offset=return()|otherwise=do(k',cont)<-fk=<<peek(p`plusPtr`n)whencont$go(n+size)k'go0yfindIndex::Storablea=>(a->Bool)->Arraya->IO(Maybe(Int,a))findIndex=findHackundefinedwherefindHack::Storableb=>b->(b->Bool)->Arrayb->IO(Maybe(Int,b))findHackdummyp(Arrayref)=doACeslen_<-readIORefrefletsize=sizeOfdummyoffset=len*sizewithForeignPtres$\ptr->letgo!n!i|n>=offset=returnNothing|otherwise=doval<-peek(ptr`plusPtr`n)ifpvalthenreturn$Just(i,val)elsego(n+size)(i+1)ingo00concat::Storablea=>Arraya->Arraya->IO()concat(Arrayd)(Arrays)=doda@(AC_dlen_)<-readIORefdsa@(AC_slen_)<-readIORefswriteIORefd=<<copy'dadlensa0slen-- | Copy part of the source array into the destination array. The-- destination array is resized if not large enough.copy::Storablea=>Arraya->Int->Arraya->Int->Int->IO()copy(Arrayd)dstart(Arrays)sstartmaxCount=doda<-readIORefdsa<-readIORefswriteIORefd=<<copy'dadstartsasstartmaxCount-- | Copy part of the source array into the destination array. The-- destination array is resized if not large enough.copy'::Storablea=>ACa->Int->ACa->Int->Int->IO(ACa)copy'ddstartssstartmaxCount=copyHackdsundefinedwherecopyHack::Storableb=>ACb->ACb->b->IO(ACb)copyHackdac@(AC_oldLen_)(ACsrcslen_)dummy=dowhen(maxCount<0||dstart<0||dstart>oldLen||sstart<0||sstart>slen)$errorWithoutStackTrace"copy: bad offsets or lengths"letsize=sizeOfdummycount=minmaxCount(slen-sstart)ifcount==0thenreturndacelsedoACdstdlendcap<-ensureCapacity'dac(dstart+count)withForeignPtrdst$\dptr->withForeignPtrsrc$\sptr->do_<-memcpy(dptr`plusPtr`(dstart*size))(sptr`plusPtr`(sstart*size))(fromIntegral(count*size))return$ACdst(maxdlen(dstart+count))dcapremoveAt::Storablea=>Arraya->Int->IO()removeAtai=removeHackaundefinedwhereremoveHack::Storableb=>Arrayb->b->IO()removeHack(Arrayary)dummy=doACfpoldLencap<-readIORefarywhen(i<0||i>=oldLen)$errorWithoutStackTrace"removeAt: invalid index"letsize=sizeOfdummynewLen=oldLen-1when(newLen>0&&i<newLen).withForeignPtrfp$\ptr->do_<-memmove(ptr`plusPtr`(size*i))(ptr`plusPtr`(size*(i+1)))(fromIntegral(size*(newLen-i)))return()writeIORefary(ACfpnewLencap){-The firstPowerOf2 function works by setting all bits on the right-handside of the most significant flagged bit to 1, and then incrementingthe entire value at the end so it "rolls over" to the nearest power oftwo.-}-- | Computes the next-highest power of two for a particular integer,-- @n@.  If @n@ is already a power of two, returns @n@.  If @n@ is-- zero, returns zero, even though zero is not a power of two.firstPowerOf2::Int->IntfirstPowerOf2!n=let!n1=n-1!n2=n1.|.(n1`shiftR`1)!n3=n2.|.(n2`shiftR`2)!n4=n3.|.(n3`shiftR`4)!n5=n4.|.(n4`shiftR`8)!n6=n5.|.(n5`shiftR`16)#if WORD_SIZE_IN_BITS == 32inn6+1#elif WORD_SIZE_IN_BITS == 64!n7=n6.|.(n6`shiftR`32)inn7+1#else# error firstPowerOf2 not defined on this architecture#endifforeignimportccallunsafe"string.h memcpy"memcpy::Ptra->Ptra->CSize->IO(Ptra)foreignimportccallunsafe"string.h memmove"memmove::Ptra->Ptra->CSize->IO(Ptra)