{-# LANGUAGE RankNTypes #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}---- Copyright (c) 2009-2011, ERICSSON AB-- All rights reserved.---- Redistribution and use in source and binary forms, with or without-- modification, are permitted provided that the following conditions are met:---- * Redistributions of source code must retain the above copyright notice,-- this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above copyright-- notice, this list of conditions and the following disclaimer in the-- documentation and/or other materials provided with the distribution.-- * Neither the name of the ERICSSON AB nor the names of its contributors-- may be used to endorse or promote products derived from this software-- without specific prior written permission.---- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--{-# LANGUAGE UndecidableInstances #-}-- | A 'Vector' interface to packed sequences of bits--moduleFeldspar.BitVectorwhereimportqualifiedPreludeimportData.WordimportData.List(inits)importData.ProxyimportqualifiedData.TypeLevelasTLimportLanguage.Syntactichiding(fold)importFeldspar.WrapimportFeldspar.PreludeimportFeldsparhiding(sugar,desugar,resugar)importqualifiedFeldspar.VectorasVec-- * Types and classes-- | A 'Unit' is the internal representation of a 'BitVector'class(Typew,Numericw,Bitsw,Integralw)=>Unitwwherewidth::Proxyw->LengthinstanceUnitWord8wherewidth_=8instanceUnitWord16wherewidth_=16instanceUnitWord32wherewidth_=32dataBitVectorw=BitVector{segments::[Segmentw]}dataSegmentw=Segment{numUnits::DataLength,elements::DataIndex->Dataw}-- * Feldspar integration of BitVectortypeinstanceElem(BitVectorw)=DataBooltypeinstanceCollIndex(BitVectorw)=DataIndextypeinstanceCollSize(BitVectorw)=DataLengthinstance(Unita)=>Syntactic(BitVectora)wheretypeDomain(BitVectora)=FeldDomainAlltypeInternal(BitVectora)=[a]desugar=desugar.freezeBitVectorsugar=unfreezeBitVector.sugarinstance(Unita)=>Syntax(BitVectora)-- * Operationslength::forallw.(Unitw)=>BitVectorw->DataLengthlengthbv=Prelude.sum$Prelude.mapsegmentLen$segmentsbvwheresegmentLens=numUnitss*ww=value$width(Proxy::Proxyw)numOfUnits::(Unitw)=>BitVectorw->DataLengthnumOfUnitsbv=Prelude.sum$Prelude.mapnumUnits$segmentsbvfreezeBitVector::forallw.(Unitw)=>BitVectorw->Data[w]freezeBitVectorbv=freezeSegments$segmentsbvwherefreezeSegmentssegs=casesegsof[]->value[](s:ss)->parallel(numUnitss)(elementss)`append`freezeSegmentsssunfreezeBitVector::forallw.(Unitw)=>Data[w]->BitVectorwunfreezeBitVectorws=BitVector[Segment(getLengthws)(ws!)]{- TODO
-- | Variant of `unfreezeBitVector` with additional static size information.
unfreezeBitVector' :: forall w . (Unit w) => Length -> Data [w] -> BitVector w
unfreezeBitVector' len arr = unfreezeBitVector $ cap (r :> elemSize) arr
where
(_ :> elemSize) = dataSize arr
singleton :: a -> Range a
singleton x = Range x x
r = (singleton (fromIntegral len),singleton (fromIntegral len)
,singleton (fromIntegral len))
-}-- | Transforms a bool vector to a bitvector.-- Length of the vector has to be divisible by the wordlength,-- otherwise booleans at the end will be dropped.fromVector::forallw.(Unitw,Sizew~Rangew)=>Vec.Vector(DataBool)->BitVectorwfromVectorv=BitVector{segments=[Segmentwl(loopw)]-- TODO: Should Vector segments be transformed to BitVector segments-- for the sake of efficiency?}wherew=value$width(Proxy::Proxyw)wl=Vec.lengthv`div`wloopnix=forLoopn0$\ist->st`shiftLU`1.|.(v!(w*ix+i)?(1,0))toVector::forallw.(Unitw,Sizew~Rangew)=>BitVectorw->Vec.Vector(DataBool)toVectorbv=Vec.indexed(lengthbv)(bv!)instance(Unitw,Sizew~Rangew)=>Indexed(BitVectorw)wherebv!i=help0(segmentsbv)wherehelp_[]=false-- XXX Should be an error here...helpaccum[s]=ixfsaccumihelpaccum(s:ss)=i<accum+numUnitss*w?(ixfsaccumi,help(accum+numUnitss*w)ss)w=value$width(Proxy::Proxyw)ixfsaccumix=testBit(elementss((ix-accum)`div`w))(w-1-((ix-accum)`mod`w))fromBits::forallw.(Unitw)=>[Bool]->BitVectorwfromBitsbs=unfreezeBitVector$valuexswherexs=[conv(Proxy::Proxyw)$Prelude.takew(Prelude.drop(i*w)bs)|i<-[0..Prelude.lengthbs`Prelude.div`wPrelude.-1]]w=fromInteger$toInteger$width(Proxy::Proxyw)conv::(Unitw)=>Proxyw->[Bool]->wconv_=Prelude.foldl(\nb->ifbthennPrelude.*2Prelude.+1elsenPrelude.*2)0fromUnits::(Unitw)=>[w]->BitVectorwfromUnits=unfreezeBitVector.valuereplUnit::(Unitw)=>DataLength->w->BitVectorwreplUnitnu=BitVector[Segmentn$const$valueu]indexed::(Unitw,Sizew~Rangew)=>DataLength->(DataIndex->DataBool)->BitVectorwindexedlixf=fromVector$Vec.indexedlixfmap::(Unitw,Sizew~Rangew)=>(DataBool->DataBool)->BitVectorw->BitVectorwmapfbv=boolFun1freswhereresf'=BitVector$Prelude.map(\s->s{elements=f'.elementss})$segmentsbvtakeUnits::forallw.(Unitw)=>DataLength->BitVectorw->BitVectorwtakeUnitslenbv=helplen[]$segmentsbvwherehelp_acc[]=BitVectoracchelpnacc(s:ss)=n<numUnitss?(BitVector(accPrelude.++[s{numUnits=n}]),help(n-numUnitss)(accPrelude.++[s])ss)dropUnits::forallw.(Unitw)=>DataLength->BitVectorw->BitVectorwdropUnitslenbv=helplen$segmentsbvwherehelp_[]=BitVector[]helpn(s:ss)=n<numUnitss?(BitVector$s':ss,help(n-numUnitss)ss)wheres'=Segment{numUnits=numUnitss-n,elements=\i->elementss(i+n)}(++)::forallw.(Unitw)=>BitVectorw->BitVectorw->BitVectorw(BitVectorss)++(BitVectorzs)=BitVector$ssPrelude.++zsdrop::forallw.(Unitw,Sizew~Rangew)=>DataLength->Dataw->BitVectorw->BitVectorwdroplenendbv=dropSegmentslen$segmentsbvwherew=value$width(Proxy::Proxyw)dropSegments_[]=BitVector[]dropSegmentsn(s:ss)=n<sLen?(dropUnitsnsss,dropSegments(n-sLen)ss)wheresLen=numUnitss*wdropUnitsnsss=dropBitsbitsToDrop(s':ss)wheres'=Segment{numUnits=numUnitss-wordsToDrop,elements=\i->elementss(i+wordsToDrop)}wordsToDrop=n`div`wbitsToDrop=n`mod`wdropBits_[]=BitVector[]dropBitsn(s:ss)=n>0?(BitVector$s':segmentsbv',BitVector(s:ss))wheres'=Segment{numUnits=numUnitss-1,elements=\i->(elementssi`shiftLU`n).|.(elementss(i+1)`shiftRU`(w-n))}bv'=addBits(w-n)(elementss(numUnitss-1)`shiftLU`n)ssaddBitsnbs[]=BitVector[Segment1$const$bs.|.(end`shiftRU`n)]addBitsnbs(s:ss)=numUnitss>0?(BitVector$s':segmentsbv',addBitsnbsss)wheres'=Segment{numUnits=1,elements=const$bs.|.(elementss0`shiftRU`n)}bv'=dropBits(w-n)(s:ss)fold::forallwa.(Syntaxa,Unitw,Sizew~Rangew)=>(a->DataBool->a)->a->BitVectorw->afold_ini(BitVector[])=inifoldfini(BitVector(s:ss))=foldf(forLoop(numUnitss)inif')$BitVectorsswheref'::DataIndex->a->af'ist=Prelude.snd$forLoopw(elementssi,st)f''f''::DataIndex->(Dataw,a)->(Dataw,a)f''_(unit,st)=(unit`shiftLU`1,fst$testBitunit$w-1)w=value$width(Proxy::Proxyw)zipWith::forallw.(Unitw,Sizew~Rangew)=>(DataBool->DataBool->DataBool)->BitVectorw->BitVectorw->BitVectorwzipWithfbvbw=boolFun2freswhereresf'=Prelude.foldl(++)(BitVector[])[zipSegmentsf'sz|s<-segIdxsbv,z<-segIdxsbw]segIdxsbvec=Prelude.zip(segmentsbvec)$Prelude.map(Prelude.sum.Prelude.mapnumUnits)$inits$segmentsbveczipSegmentsf'(s,sStart)(z,zStart)=BitVector[Segment{numUnits=end-start,elements=\i->f'(elementss(i+sOffset))(elementsz(i+zOffset))}]wheresEnd=sStart+numUnitsszEnd=zStart+numUnitszstart=maxsStartzStartend=minsEndzEndsOffset=start-sStartzOffset=start-zStarthead::(Unitw,Sizew~Rangew)=>BitVectorw->DataBoolhead=(!0)tail::forallw.(Unitw,Sizew~Rangew)=>DataBool->BitVectorw->BitVectorwtailb=drop1(b2ib`shiftLU`(w-1))wherew=value$width(Proxy::Proxyw)-- * Boolean functions extended to wordsboolFun1::(Syntaxt,Unitw,Sizew~Rangew)=>(DataBool->DataBool)->((Dataw->Dataw)->t)->tboolFun1fc=ftrue?(ffalse?(c(const$complement0),cid),ffalse?(ccomplement,c(const0)))boolFun2::(Syntaxt,Unitw,Sizew~Rangew)=>(DataBool->DataBool->DataBool)->((Dataw->Dataw->Dataw)->t)->tboolFun2fc=ftruetrue?(ftruefalse?(ffalsetrue?(ffalsefalse?(c$\__->complement0,c$(.|.)),ffalsefalse?(c$\xy->x.|.complementy,c$\x_->x)),ffalsetrue?(ffalsefalse?(c$\xy->complementx.|.y,c$\_y->y),ffalsefalse?(c$\xy->complement(x`xor`y),c$(.&.)))),ftruefalse?(ffalsetrue?(ffalsefalse?(c$\xy->complement(x.&.y),c$\xy->x`xor`y),ffalsefalse?(c$\_y->complementy,c$\xy->x.&.complementy)),ffalsetrue?(ffalsefalse?(c$\x_->complementx,c$\xy->complementx.&.y),ffalsefalse?(c$\xy->complement(x.|.y),c$\__->0))))-- * Wrapping for bitvectorsinstance(Unitw)=>Wrap(BitVectorw)(Data[w])wherewrap=freezeBitVectorinstance(Wraptu,Unitw,TL.Nats)=>Wrap(BitVectorw->t)(Data's[w]->u)wherewrapf=\(Data'd)->wrap$f$unfreezeBitVector$setLengths'dwheres'=fromInteger$toInteger$TL.toInt(undefined::s)-- * Patch combinators for bitvectorstBV::Patchww->Patch(BitVectorw)(BitVectorw)tBV_=id