{-
- Copyright (c) 2009, 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.Compiler.Transformation.LiftingwhereimportFeldspar.Core.GraphimportFeldspar.Core.Typeshiding(typeOf)importFeldspar.Compiler.Transformation.GraphUtilsimportData.ListreplaceNoInlines::HierarchicalGraph->HierarchicalGraphreplaceNoInlinesg=HierGraph(replaceNoInlinesHr(graphHierarchyg))(hierGraphInterfaceg)replaceNoInlinesHrList::[Hierarchy]->[Hierarchy]replaceNoInlinesHrListhrlist=mapreplaceNoInlinesHrhrlistreplaceNoInlinesHr::Hierarchy->HierarchyreplaceNoInlinesHr(Hierarchyhrlist)=Hierarchy(mapreplaceNoInlinesNodehrlist)replaceNoInlinesNode::(Node,[Hierarchy])->(Node,[Hierarchy])replaceNoInlinesNode(n,hs)=casefunctionnofNoInlinenameinterface->casereplaceListof[]->(n,replaceNoInlinesHrLisths)_->(nNew,replaceNoInlinesHrListhsNew)wherereplaceList=foldl(collectChangesHr(interfaceInputinterface,hs))(collectChangesInterfaceinterfacehs)hs(nNew_,hsNew_)=changeInp(interfaceInputinterface)replaceList(n,hs)fullReplaceList=[((interfaceInputinterface,[]),inpVarsChange)]++(mapfstreplaceList)(nNew,hsNew)=(nNew_{function=replaceVarsfullReplaceList(functionnNew_)},map(replaceVarsfullReplaceList)hsNew_)_->(n,replaceNoInlinesHrLisths)changeInp::NodeId->[((Variable,Variable->Variable),TupleStorableType)]->(Node,[Hierarchy])->(Node,[Hierarchy])changeInpinpNodechLs(node,hs)=(newNode,newHs)wherenewNode=Node(nodeIdnode)(addIfcInpTypesnewTyps(functionnode))(addInps(map(fst.fst)chLs)(inputnode))(addInpTypesnewTyps(inputTypenode))(outputTypenode)newHs=map(addOutTypesHrinpNodenewTyps)hsnewTyps=mapsndchLsaddInpsvarsinput=Tup([input]++(map(One.Variable)vars))addInpTypestypesinpType=Tup([inpType]++types)addIfcInpTypestypes(NoInlinestrifc@(Interface{interfaceInputType=ifcType}))=NoInlinestrifc{interfaceInputType=Tup([ifcType]++types)}addOutTypesHr::NodeId->[TupleStorableType]->Hierarchy->HierarchyaddOutTypesHridtypes(HierarchyndHrs)=Hierarchy(map(addOutTypesNodeidtypes)ndHrs)addOutTypesNode::NodeId->[TupleStorableType]->(Node,[Hierarchy])->(Node,[Hierarchy])addOutTypesNodeidtypes(node@(Node{nodeId=nId,outputType=outType}),hs)=if(id==nId)then(node{outputType=Tup([outType]++types)},hs)else(node,hs)collectChangesInterface::Interface->[Hierarchy]->[((Variable,Variable->Variable),TupleStorableType)]collectChangesInterfaceifacehs=map(genChange(interfaceInputiface))$zip[1..]$filter((mustChangehs).fst)(tupleZipList(interfaceOutputiface,interfaceOutputTypeiface))genChange::NodeId->(NodeId,(Source,StorableType))->((Variable,Variable->Variable),TupleStorableType)genChangeinpId(index,(Variable(id,list),typ))=(((id,list),varChangeinpIdindex),Onetyp)mustChange::[Hierarchy]->Source->BoolmustChangehsx=casexof(Variable(id,list))->(notInHridhs)_->FalseinpVarsChange::Variable->VariableinpVarsChange(id,list)=(id,[0]++list)varChange::NodeId->Int->Variable->VariablevarChangeidindex_=(id,[index])classCollectChangesHrawherecollectChangesHr::(NodeId,[Hierarchy])->[((Variable,Variable->Variable),TupleStorableType)]->a->[((Variable,Variable->Variable),TupleStorableType)]instanceCollectChangesHrHierarchywherecollectChangesHrnhschangesList(HierarchynodeHsList)=foldl(collectChangesHrnhs)changesListnodeHsListinstanceCollectChangesHr(Node,[Hierarchy])wherecollectChangesHrnhschangesList(node,hsList)=foldl(collectChangesHrnhs)(collectChangesHrnhschangesListnode)hsListinstanceCollectChangesHrNodewherecollectChangesHrnhschangesListnode=collectChangesHrnhs(collectChangesHrnhschangesList(filter((mustChange(sndnhs)).fst)(tupleZipList(inputnode,inputTypenode))))(functionnode)instanceCollectChangesHr[(Source,StorableType)]wherecollectChangesHr(nodeId,hs)changesListsourceList=changesList++(map(genChangenodeId)$zip[((lengthchangesList)+1)..]$sourceList)instanceCollectChangesHrFunctionwherecollectChangesHrnhschangesList(NoInline_ifc)=collectChangesHrnhschangesListifccollectChangesHrnhschangesList(Parallel_ifc)=collectChangesHrnhschangesListifccollectChangesHrnhschangesList(IfThenElseifc1ifc2)=collectChangesHrnhs(collectChangesHrnhschangesListifc1)ifc2collectChangesHrnhschangesList(Whileifc1ifc2)=collectChangesHrnhs(collectChangesHrnhschangesListifc1)ifc2collectChangesHr(nodeId,hs)changesList_=changesListinstanceCollectChangesHrInterfacewherecollectChangesHr(nodeId,hs)changesListifc=changesList++(map(genChangenodeId)$zip[((lengthchangesList)+1)..]$filter(mustChangehs.fst)(tupleZipList(interfaceOutputifc,interfaceOutputTypeifc)))classNotInHrawherenotInHr::NodeId->a->BoolinstanceNotInHr[Hierarchy]wherenotInHridhs=and$map(notInHrid)hsinstanceNotInHrHierarchywherenotInHrid(HierarchynodeHs)=and$map(notInHrid)nodeHsinstanceNotInHr(Node,[Hierarchy])wherenotInHrid(node,hs)=(notInHridnode)&&(notInHridhs)instanceNotInHrNodewherenotInHridnode=id/=(nodeIdnode)