{-# LANGUAGE CPP #-}-- | Intermediate abstract syntax tree used in the compiler. Pretty close to-- Epic syntax.moduleAgda.Compiler.Epic.AuxASTwhereimportData.Set(Set)importqualifiedData.SetasSimportAgda.Syntax.Abstract.NameimportAgda.Compiler.Epic.Interface#include "../../undefined.h"importAgda.Utils.ImpossibletypeComment=StringtypeInline=BooldataFun=Fun{funInline::Inline,funName::Var,funQName::MaybeQName,funComment::Comment,funArgs::[Var],funExpr::Expr}|EpicFun{funName::Var,funQName::MaybeQName,funComment::Comment,funEpicCode::String--EpicCode}deriving(Eq,Ord,Show)dataLit=LIntInteger|LCharChar|LStringString|LFloatDoublederiving(Show,Ord,Eq)dataExpr=VarVar|LitLit|LamVarExpr|ConTagQName[Expr]|AppVar[Expr]|CaseExpr[Branch]|IfExprExprExpr|LetVarExprExpr|LazyExpr|UNIT|IMPOSSIBLEderiving(Show,Ord,Eq)dataBranch=Branch{brTag::Tag,brName::QName,brVars::[Var],brExpr::Expr}|BrInt{brInt::Int,brExpr::Expr}|Default{brExpr::Expr}deriving(Show,Ord,Eq)getBrVars::Branch->[Var]getBrVars(Branch{brVars=vs})=vsgetBrVars_=[]---------------------------------------------------------------------------------- * Some smart constructors-- | Smart constructor for let expressions to avoid unneceessary letslett::Var->Expr->Expr->Exprlettv(Varv')e'=substvv'e'lettvee'=ifv`elem`fve'thenLetvee'elsee'-- | Some things are pointless to make lazylazy::Expr->Exprlazy(Lazye)=Lazyelazy(Litl)=LitllazyUNIT=UNITlazyx=Lazyx-- | If casing on the same expression in a sub-expression, we know what branch to-- pickcasee::Expr->[Branch]->Exprcaseexbrs=Casex[br{brExpr=casingEbr(brExprbr)}|br<-brs]wherecasingEbrexpr=letrec=casingEbrincaseexprofVarv->VarvLitl->LitlLamve->Lamv(rece)Contnes->Contn(mapreces)Appves->Appv(mapreces)Caseebrs|expr==e->casefilter(sameConbr)brsof[]->Case(rece)[b{brExpr=rec(brExprb)}|b<-brs][b]->substs(getBrVarsbr`zip`getBrVarsb)(brExprb)_->__IMPOSSIBLE__|otherwise->Case(rece)[b{brExpr=rec(brExprb)}|b<-brs]Ife1e2e3->If(rece1)(rece2)(rece3)Letve1e2->Letv(rece1)(rece2)Lazye->Lazy(rece)UNIT->UNITIMPOSSIBLE->IMPOSSIBLEsameCon(Branch{brTag=t1})(Branch{brTag=t2})=t1==t2sameCon(BrInt{brInt=i1})(BrInt{brInt=i2})=i1==i2sameCon__=False-- | Smart constructor for applications to avoid empty applicationsapps::Var->[Expr]->Exprappsv[]=Varvappsvas=Appvas---------------------------------------------------------------------------------- * Substitution-- | Substitutionsubst::Var-- ^ Substitute this ...->Var-- ^ with this ...->Expr-- ^ in this.->Exprsubstvarvar'expr=caseexprofVarv|var==v->Varvar'|otherwise->VarvLitl->LitlLamve|var==v->Lamve|otherwise->Lamv(substvarvar'e)Contqes->Contq(map(substvarvar')es)Appves|var==v->Appvar'(map(substvarvar')es)|otherwise->Appv(map(substvarvar')es)Caseebrs->Case(substvarvar'e)(map(substBranchvarvar')brs)Ifabc->lets=substvarvar'inIf(sa)(sb)(sc)Letvee'|var==v->Letv(substvarvar'e)e'|otherwise->Letv(substvarvar'e)(substvarvar'e')Lazye->Lazy(substvarvar'e)UNIT->UNITIMPOSSIBLE->IMPOSSIBLEsubsts::[(Var,Var)]->Expr->Exprsubstssse=foldr(uncurrysubst)esssubstBranch::Var->Var->Branch->BranchsubstBranchxebr=br{brExpr=substxe(brExprbr)}-- | Get the free variables in an expressionfv::Expr->[Var]fv=S.toList.fv'wherefv'::Expr->SetVarfv'expr=caseexprofVarv->S.singletonvLit_->S.emptyLamve1->S.deletev(fv'e1)Con__es->S.unions(mapfv'es)Appves->S.insertv$S.unions(mapfv'es)Caseebrs->fv'e`S.union`S.unions(mapfvBrbrs)Ifabc->S.unions(mapfv'[a,b,c])Letvee'->fv'e`S.union`(S.deletev$fv'e')Lazye->fv'eUNIT->S.emptyIMPOSSIBLE->S.emptyfvBr::Branch->SetVarfvBrb=casebofBranch__vse->fv'eS.\\S.fromListvsBrInt_e->fv'eDefaulte->fv'e