{-# LANGUAGE
MultiParamTypeClasses,
TypeSynonymInstances,
FlexibleContexts #-}moduleCsoundExpr.Translator.Cs.CsTree(-- typesCsTree,Rate(..),CsExpr(..),Value(..),OprType(..),Ftable(..),GEN(..),Name,Label,-- constructorsopc,oprPrefix,oprInfix,int,double,string,ftable,param,argIn,argOut,-- predicatesisArg,isFtable,isVal,isOpc,isOpr,isParam,isString,equalStructure,equalStructureByParams,-- selectorstoFtable,ftableGENArgs,ftableSize,ftableGENId,getFtable,mapFtable,toDouble,opcName,oprName,oprType,paramId,value,argName,argRate)whereimportData.FunctionimportCsoundExpr.Translator.ExprTree.ExprTreeimportCsoundExpr.Translator.ExprTree.TreeimportCsoundExpr.Translator.Cs.IMimportCsoundExpr.Translator.Cs.UtilsimportCsoundExpr.Translator.ExprTree.Tree------------------------------------------------- typestypeCsTree=ExprTreeLabelRateCsExprdataRate=A|K|I|S|GA|GK|GI|GS|SetupRatederiving(Show,Eq,Ord)dataCsExpr=ValValue|ParamId|ArgRateName|OpcName|OprNameOprTypederiving(Show,Eq,Ord)dataValue=ValueIntInt|ValueDoubleDouble|ValueStringString|ValueFtableFtablederiving(Show,Eq,Ord)dataOprType=Infix|Prefixderiving(Show,Eq,Ord)dataFtable=EmptyFtable|FtableSizeGENderiving(Show,Eq,Ord)dataGEN=GENId[CsTree]deriving(Show,Eq,Ord)--type Id = Int--type Size = InttypeName=StringtypeLabel=Int-------------------------------------------- instancesinstanceIMCsTreeCsTreewherefrom=idto=id------------------- Listsval::CsExpr->CsTreevalx=purex[]param::IMCsTreea=>Id->aparam=from.val.Paramint::IMCsTreea=>Int->aint=from.val.Val.ValueIntdouble::IMCsTreea=>Double->adouble=from.val.Val.ValueDoubleftable::IMCsTreea=>Ftable->aftable=from.val.Val.ValueFtablestring::IMCsTreea=>String->astring=from.mapType(const[S]).val.Val.ValueStringargIn::IMCsTreea=>Rate->Name->aargInrate=from.val.ArgrateargOut::IMCsTreea=>Rate->Name->a->CsTreeargOutratename=mapType(const[rate]).pure'(Argratename).return.towherepure'::CsExpr->[CsTree]->CsTreepure'=pure------------------------------opc::Name->CsExpropc=OpcoprPrefix::Name->CsExproprPrefix=flipOprPrefixoprInfix::Name->CsExproprInfix=flipOprInfix-------------------------------------------- CsTree SelectorsmapFtable::(Ftable->Ftable)->CsTree->CsTreemapFtablef=mapTag(mapSnd$phif)wherephifx=casexof(Val(ValueFtablex))->Val(ValueFtable$fx)_->error"value is not ftable"getFtable::CsTree->FtablegetFtable=select.exprOp.exprTreeTagwhereselectx=casexof(Val(ValueFtablex))->x_->error"value is not ftable"------------------------------------------------------------- CsExpr selectorsparamId::CsExpr->IdparamIdx=casexof(Paramx)->x_->error"expr is no Param"value::CsExpr->Valuevaluex=casexof(Valx)->x_->error"expr is no Val"opcName::CsExpr->NameopcNamex=casexof(Opcx)->x_->error"expr is no Opc"oprName::CsExpr->NameoprNamex=casexof(Oprx_)->x_->error"expr is no Opr"oprType::CsExpr->OprTypeoprTypex=casexof(Opr_x)->x_->error"expr is no Opr"argName::CsExpr->NameargNamex=casexof(Arg_x)->x_->error"expr is not Arg"argRate::CsExpr->RateargRatex=casexof(Argx_)->x_->error"expr is not Arg"---------------------------------------------------ftableSize::Ftable->SizeftableSizex=casexofEmptyFtable->0(Ftablex_)->xftableGENId::Ftable->IdftableGENIdx=casexofEmptyFtable->0(Ftable_(GENx_))->xftableGENArgs::Ftable->[CsTree]ftableGENArgsx=casexofEmptyFtable->[](Ftable_(GEN_ts))->ts------------------------------------------------------------------------------------------------------ predicatesisParam::CsExpr->BoolisParamx=casexof(Param_)->True_->FalseisVal::CsExpr->BoolisValx=casexof(Val_)->True_->FalseisOpc::CsExpr->BoolisOpcx=casexof(Opc_)->True_->FalseisOpr::CsExpr->BoolisOprx=casexof(Opr__)->True_->FalseisArg::CsExpr->BoolisArgx=casexof(Arg__)->True_->False--------------- value predicatesisFtable::Value->BoolisFtablex=casexof(ValueFtable_)->True_->FalsetoFtable::Value->FtabletoFtablex=casexof(ValueFtableq)->q_->error"value is not ftable"isDouble::Value->BoolisDoublex=casexofValueDoubleq->True_->FalsetoDouble::Value->MaybeDoubletoDoublex=casexofValueDoubleq->Justq_->NothingisString::Value->BoolisStringx=casexof(ValueString_)->True_->False------------------------ tree predicatesequalStructure::CsTree->CsTree->BoolequalStructure=equalTreeStructureBypredwherepredab|isVal'a&&isVal'b=eqValab|otherwise=a==bisVal'=isVal.exprOp.exprTagvalue'=value.exprOp.exprTageqVal=equalValueStructure`on`value'equalStructureByParams::CsTree->CsTree->BoolequalStructureByParams=equalTreeStructureBypredwherepredab|isVal'a&&isVal'b=eqValab|isParam'a&&isVal'b&&paramId'a>3=True|isVal'a&&isParam'b&&paramId'b>3=True|otherwise=a==bisVal'=isVal.exprOp.exprTagvalue'=value.exprOp.exprTagisParam'=isParam.exprOp.exprTagparamId'=paramId.exprOp.exprTageqVal=equalValueStructure`on`value'equalValueStructure::Value->Value->BoolequalValueStructureab=case(a,b)of((ValueInt_),(ValueInt_))->True((ValueString_),(ValueString_))->True((ValueDouble_),(ValueDouble_))->True((ValueFtable_),(ValueFtable_))->True_->False