{-# LANGUAGE CPP #-}moduleAgda.TypeChecking.CompiledClause.CompilewhereimportData.MonoidimportqualifiedData.MapasMapimportData.List(genericReplicate,nubBy)importData.FunctionimportAgda.Syntax.CommonimportAgda.Syntax.InternalimportAgda.TypeChecking.CompiledClauseimportAgda.TypeChecking.MonadimportAgda.TypeChecking.RecordPatternsimportAgda.TypeChecking.SubstituteimportAgda.TypeChecking.PrettyimportAgda.Utils.ListimportAgda.Utils.Impossible#include "../../undefined.h"compileClauses::Bool-- ^ Translate record patterns?->[Clause]->TCMCompiledClausescompileClausestranslatecs=docs<-iftranslatethenmapMtranslateRecordPatternscselsereturncsreturn$compile[(clausePatsc,clauseBodyc)|c<-cs]typeCl=([ArgPattern],ClauseBody)typeCls=[Cl]compile::Cls->CompiledClausescompilecs=casenextSplitcsofJustn->Casen$fmapcompile$splitOnncsNothing->casemapgetBodycsof-- It's possible to get more than one clause here due to-- catch-all expansion.Justt:_->Done(map(fmapname)$fst$headcs)tNothing:_->Fail[]->__IMPOSSIBLE__wherename(VarPx)=xname(DotP_)="_"nameConP{}=__IMPOSSIBLE__nameLitP{}=__IMPOSSIBLE__getBody(_,b)=bodybbody(Bindb)=body(absBodyb)body(Bodyt)=JusttbodyNoBody=NothingnextSplit::Cls->MaybeIntnextSplit[]=__IMPOSSIBLE__nextSplit((ps,_):_)=mhead[n|(a,n)<-zipps[0..],isPat(unArga)]whereisPatVarP{}=FalseisPatDotP{}=FalseisPatConP{}=TrueisPatLitP{}=TruesplitOn::Int->Cls->CaseClssplitOnncs=mconcat$map(fmap(:[]).splitCn)$expandCatchAllsncssplitC::Int->Cl->CaseClsplitCn(ps,b)=caseunArgpofConPc_qs->conCasec(ps0++qs++ps1,b)LitPl->litCasel(ps0++ps1,b)_->catchAll(ps,b)where(ps0,p,ps1)=extractNthElement'nps-- Expand catch-alls that appear before actual matches.expandCatchAlls::Int->Cls->ClsexpandCatchAllsncs=casecsof_|all(isCatchAll.nth.fst)cs->cs(ps,b):cs|not(isCatchAll(nthps))->(ps,b):expandCatchAllsncs|otherwise->map(expandpsb)expansions++(ps,b):expandCatchAllsncs_->__IMPOSSIBLE__whereisCatchAll(Arg__ConP{})=FalseisCatchAll(Arg__LitP{})=FalseisCatchAll_=Truenthqs=pwhere(_,p,_)=extractNthElement'nqsclassify(LitPl)=Leftlclassify(ConPc__)=Rightcclassify_=__IMPOSSIBLE__-- All non-catch-all patterns following this one (at position n).-- These are the cases the wildcard needs to be expanded into.expansions=nubBy((==)`on`classify).mapunArg.filter(not.isCatchAll).map(nth.fst)$csexpandpsbq=caseqofConPc_qs'->(ps0++[defaultArg$ConPcNothing(genericReplicatem$defaultArg$VarP"_")]++ps1,substBodyn'm(Conc(mapvar[m-1,m-2..0]))b)wherem=fromIntegral$lengthqs'LitPl->(ps0++[defaultArg$LitPl]++ps1,substBodyn'0(Litl)b)_->__IMPOSSIBLE__where(ps0,_,ps1)=extractNthElement'npsn'=countVarsps0countVars=sum.map(count.unArg)countVarP{}=1count(ConP__ps)=countVarspscountDotP{}=1-- dot patterns are treated as variables in the clausescount_=0varx=defaultArg$Varx[]substBody::Int->Integer->Term->ClauseBody->ClauseBodysubstBody___NoBody=NoBodysubstBody0mvb=casebofBindb->foldr(.)id(genericReplicatem(Bind.Abs"_"))$substv(absBody$raisemb)_->__IMPOSSIBLE__substBodynmvb=casebofBindb->Bind$fmap(substBody(n-1)mv)b_->__IMPOSSIBLE__