---- 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 GADTs #-}{-# LANGUAGE TypeOperators #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE UndecidableInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}moduleFeldspar.Compiler.Imperative.FromCore.MutablewhereimportLanguage.SyntacticimportLanguage.Syntactic.Constructs.BindingimportLanguage.Syntactic.Constructs.Binding.HigherOrderimportFeldspar.Core.TypesimportFeldspar.Core.InterpretationimportFeldspar.Core.Constructs.BindingimportFeldspar.Core.Constructs.MutableimportFeldspar.Core.Constructs.MutableArrayimportFeldspar.Core.Constructs.MutableReferenceimportFeldspar.Compiler.Imperative.Frontendhiding(Type)importFeldspar.Compiler.Imperative.FromCore.Interpretationinstance(Compiledomdom,Project(CLambdaType)dom)=>Compile(MONADMut)domwherecompileProgSymBind_loc(ma:*(lam:$body):*Nil)|Just(SubConstr2(Lambdav))<-prjLambdalam=doe<-compileExprmawithAliasve$compileProglocbody{- TODO reenable this implementation! The case above inlines too much if v is used more than once in the body
compileProgSym Bind _ loc (ma :* (Symbol (Decor info lam) :$ body) :* Nil)
| Just (Lambda v) <- prjCtx typeCtx lam
= do
let var = mkVar (compileTypeRep $ argType $ infoType info) v
withDecl var $ do
compileProg var ma
compileProg loc body
-}compileProgSymThen_loc(ma:*mb:*Nil)=docompileExprmacompileProglocmbcompileProgSymReturninfoloc(a:*Nil)|MutTypeUnitType<-infoTypeinfo=return()|otherwise=compileProglocacompileProgSymWhen_loc(c:*action:*Nil)=doc'<-compileExprc(_,Bldsbody)<-confiscateBlock$compileProglocactiontellProg[Ifc'(Blockdsbody)Skip]instance(Compiledomdom,Project(CLambdaType)dom)=>CompileMutabledomwherecompileProgSymRun_loc(ma:*Nil)=compileProglocmacompileExprSymRun_(ma:*Nil)=compileExprmainstance(Compiledomdom,Project(CLambdaType)dom)=>CompileMutableReferencedomwherecompileProgSymNewRef_loc(a:*Nil)=compileProglocacompileProgSymGetRef_loc(r:*Nil)=compileProglocrcompileProgSymSetRef__(r:*a:*Nil)=dovar<-compileExprrcompileProgvaracompileExprSymGetRef_(r:*Nil)=compileExprrcompileExprSymfeatinfoargs=compileProgFreshfeatinfoargsinstance(Compiledomdom,Project(CLambdaType)dom)=>CompileMutableArraydomwherecompileProgSymNewArr__loc(len:*Nil)=dol<-compileExprlentellProg[initArraylocl]compileProgSymNewArr_loc(len:*a:*Nil)=doletix=VarU32"i"a'<-compileExpral<-compileExprlentellProg[initArraylocl]tellProg[For"i"l1(Seq[assignProg(loc:!:ix)a'])]compileProgSymGetArr_loc(arr:*i:*Nil)=doarr'<-compileExprarri'<-compileExpriassignloc(arr':!:i')compileProgSymSetArr__(arr:*i:*a:*Nil)=doarr'<-compileExprarri'<-compileExpria'<-compileExpraassign(arr':!:i')a'compileProgSymainfolocargs=compileExprLocainfolocargscompileExprSymArrLengthinfo(arr:*Nil)=doa'<-compileExprarrreturn$Fun(compileTypeRep(infoTypeinfo)(infoSizeinfo))"getLength"[a']compileExprSymainfoargs=compileProgFreshainfoargs