{-# LANGUAGE GADTs #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE FlexibleInstances #-}{-# 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.--moduleFeldspar.Vector.PushwhereimportqualifiedPreludeimportFeldsparhiding(sugar,desugar)importqualifiedFeldspar.VectorasVimportLanguage.Syntactic(Syntactic(..))dataPushVectorawherePush::((DataIndex->a->M())->M())->DataLength->PushVectorainstanceSyntaxa=>Syntactic(PushVectora)wheretypeDomain(PushVectora)=FeldDomainAlltypeInternal(PushVectora)=[Internala]desugar=desugar.freezePushsugar=thawPush.sugar-- | Store push vectors in memory.freezePush::Syntaxa=>PushVectora->Data[Internala]freezePush(Pushkl)=runMutableArray$doarr<-newArr_lk(\ia->setArrarri(resugara))returnarr-- | Store a push vector to memory and return it as an ordinary vector.freezeToVector::Syntaxa=>PushVectora->V.VectorafreezeToVector=V.mapresugar.V.thawVector.freezePush-- | Create a push vector from an array stored in memory.thawPush::Syntaxa=>Data[Internala]->PushVectorathawPusharr=Pushf(getLengtharr)wherefk=forM(getLengtharr)$\ix->kix(resugar(arr!ix))instanceSyntaxa=>Syntax(PushVectora)-- | Any kind of vector, push or pull, can cheaply be converted to a push vectorclassPushyarrwheretoPush::Syntaxa=>arra->PushVectorainstancePushyPushVectorwheretoPush=idinstancePushyV.VectorwheretoPushvec=Push(\k->forM(lengthvec)(\i->ki(vec!i)))(lengthvec)instanceFunctorPushVectorwherefmapf(Pushgl)=Push(\k->g(\ia->ki(fa)))l-- | Concatenating two arrays.(++)::(Pushyarr,Syntaxa)=>arra->arra->PushVectorav1++v2=Push(\func->ffunc>>g(\ia->func(l1+i)a))(l1+l2)wherePushfl1=toPushv1Pushgl2=toPushv2-- | Given an array of pairs, flatten the array so that the elements of the-- pairs end up next to each other in the resulting vector.unpair::(Pushyarr,Syntaxa)=>arr(a,a)->PushVectoraunpairarr=Push(\k->f(everyOtherk))(2*l)wherePushfl=toPusharreveryOther::(DataIndex->a->Mb)->DataIndex->(a,a)->MbeveryOtherf=\ix(a1,a2)->f(ix*2)a1>>f(ix*2+1)a2-- | Interleaves the elements of two vectors.zipUnpair::Syntaxa=>V.Vectora->V.Vectora->PushVectorazipUnpairv1v2=unpair(V.zipv1v2)-- | An overloaded function for reordering elements of a vector.classIxmaparrwhereixmap::Syntaxa=>(DataIndex->DataIndex)->arra->arrainstanceIxmapV.Vectorwhereixmapfvec=V.indexed(lengthvec)(\i->vec!(fi))instanceIxmapPushVectorwhereixmapf(Pushgl)=Push(\k->g(\ia->k(fi)a))l-- | Reverse a vector. Works for both push and pull vectors.reverse::(Ixmaparr,Lenarr,Syntaxa)=>arra->arrareversearr=ixmap(\ix->lengtharr-ix-1)arr-- | Split a pull vector in half.---- If the input vector has an odd length the second result vector-- will be one element longer than the first.halve::Syntaxa=>V.Vectora->(V.Vectora,V.Vectora)halvev=(V.indexed(l`div`2)ixf,V.indexed((l+1)`div`2)(\i->ixf(i+(l`div`2))))wherel=lengthvixf=(v!)-- | Split a vector in half and interleave the two two halves.riffle::Syntaxa=>V.Vectora->PushVectorariffle=unpair.uncurryV.zip.halve-- | A class for overloading `length` for both pull and push vectorsclassLenarrwherelength::arra->DataLengthinstanceLenV.Vectorwherelength=V.lengthinstanceLenPushVectorwherelength(Push_l)=l-- | This function can distribute array computations on chunks of a large-- pull vector. A call `chunk l f g v` will split the vector `v` into chunks-- of size `l` and apply `f` to these chunks. In case the length of `v` is-- not a multiple of `l` then the rest of `v` will be processed by `g`.chunk::(Pushyarr1,Pushyarr2,Syntaxb)=>DataLength-- ^ Size of the chunks->(V.Vectora->arr1b)-- ^ Applied to every chunk->(V.Vectora->arr2b)-- ^ Applied to the rest of the vector->V.Vectora->PushVectorbchunkcfgv=Pushloop(noc*c)++toPush(g(V.drop(noc*c)v))wherel=lengthvnoc=l`div`cloopfunc=forMnoc$\i->dolet(Pushk_)=toPush$f(V.takec(V.drop(c*i)v))k(\ja->func(c*i+j)a)-- | The empty push vector.empty::PushVectoraempty=Push(const(return()))0-- | Flattens a pull vector containing push vectors into an unnested push vector---- Note that there are no restrictions on the lengths of the push vectors-- inside the pull vector.flatten::Syntaxa=>V.Vector(PushVectora)->PushVectoraflattenv=Pushflenwherelen=V.sum(V.maplengthv)fk=dol<-newRef0forM(lengthv)$\i->dolet(Pushgm)=v!in<-getReflg(\ja->k(n+j)a)setRefl(n+m)