{-# LANGUAGE CPP, PatternGuards, MultiParamTypeClasses, FunctionalDependencies,
TypeSynonymInstances, FlexibleInstances, UndecidableInstances
#-}{-| The translation of abstract syntax to concrete syntax has two purposes.
First it allows us to pretty print abstract syntax values without having to
write a dedicated pretty printer, and second it serves as a sanity check
for the concrete to abstract translation: translating from concrete to
abstract and then back again should be (more or less) the identity.
-}moduleAgda.Syntax.Translation.AbstractToConcrete(ToConcrete(..),toConcreteCtx,abstractToConcrete_,runAbsToCon,RangeAndPragma(..),abstractToConcreteCtx,withScope,makeEnv,abstractToConcrete,AbsToCon,DontTouchMe,Env,noTakenNames)whereimportControl.ApplicativeimportControl.Monad.ReaderimportData.CharimportqualifiedData.MapasMapimportData.Map(Map)importqualifiedData.SetasSetimportData.Set(Set)importData.ListasListimportqualifiedData.TraversableasTravimportAgda.Syntax.CommonimportAgda.Syntax.PositionimportAgda.Syntax.InfoimportAgda.Syntax.FixityimportAgda.Syntax.ConcreteasCimportAgda.Syntax.Concrete.PrettyimportAgda.Syntax.AbstractasAimportAgda.Syntax.Abstract.ViewsasAVimportAgda.Syntax.Scope.BaseimportAgda.TypeChecking.Monad.State(getScope)importAgda.TypeChecking.Monad.Base(TCM)importAgda.Utils.MaybeimportAgda.Utils.Monadhiding(bracket)importAgda.Utils.TupleimportAgda.Utils.Suffix#include "../../undefined.h"importAgda.Utils.Impossible-- Environment ------------------------------------------------------------dataEnv=Env{takenNames::SetC.Name,currentScope::ScopeInfo}defaultEnv::EnvdefaultEnv=Env{takenNames=Set.empty,currentScope=emptyScopeInfo}makeEnv::ScopeInfo->EnvmakeEnvscope=Env{takenNames=taken,currentScope=scope}wherens=everythingInScopescopetaken=Set.unionvarsdefsvars=Set.fromList$mapfst$scopeLocalsscopedefs=Set.fromList[x|(x,_)<-Map.toList$nsNamesns]currentPrecedence::AbsToConPrecedencecurrentPrecedence=asks$scopePrecedence.currentScopewithPrecedence::Precedence->AbsToCona->AbsToConawithPrecedencep=local$\e->e{currentScope=(currentScopee){scopePrecedence=p}}withScope::ScopeInfo->AbsToCona->AbsToConawithScopescope=local$\e->e{currentScope=scope}noTakenNames::AbsToCona->AbsToConanoTakenNames=local$\e->e{takenNames=Set.empty}-- The Monad ---------------------------------------------------------------- | We make the translation monadic for modularity purposes.typeAbsToCon=ReaderEnvrunAbsToCon::AbsToCona->TCMarunAbsToConm=doscope<-getScopereturn$runReaderm(makeEnvscope)abstractToConcrete::ToConcreteac=>Env->a->cabstractToConcreteflagsa=runReader(toConcretea)flagsabstractToConcreteCtx::ToConcreteac=>Precedence->a->TCMcabstractToConcreteCtxctxx=doscope<-getScopeletscope'=scope{scopePrecedence=ctx}return$abstractToConcrete(makeEnvscope')xwherescope=(currentScopedefaultEnv){scopePrecedence=ctx}abstractToConcrete_::ToConcreteac=>a->TCMcabstractToConcrete_x=doscope<-getScopereturn$abstractToConcrete(makeEnvscope)x-- Dealing with names ------------------------------------------------------- | Names in abstract syntax are fully qualified, but the concrete syntax-- requires non-qualified names in places. In theory (if all scopes are-- correct), we should get a non-qualified name when translating back to a-- concrete name, but I suspect the scope isn't always perfect. In these-- cases we just throw away the qualified part. It's just for pretty printing-- anyway...unsafeQNameToName::C.QName->C.NameunsafeQNameToName(C.QNamex)=xunsafeQNameToName(C.Qual_x)=unsafeQNameToNamexlookupName::A.Name->AbsToConC.NamelookupNamex=donames<-asks$scopeLocals.currentScopecaselookupx$mapswapnamesofJusty->returnyNothing->return$nameConcretexwhereswap(x,y)=(y,x)lookupQName::A.QName->AbsToConC.QNamelookupQNamex=doscope<-askscurrentScopecaseinverseScopeLookupNamexscopeofJusty->returnyNothing|show(qnameToConcretex)=="_"->return$qnameToConcretex|otherwise->return$C.Qual(C.NamenoRange[Id""])$qnameToConcretex-- this is what happens for names that are not in scope (private names)lookupModule::A.ModuleName->AbsToConC.QNamelookupModulex=doscope<-askscurrentScopecaseinverseScopeLookupModulexscopeofJusty->returnyNothing->return$mnameToConcretex-- this is what happens for names that are not in scope (private names)bindName::A.Name->(C.Name->AbsToCona)->AbsToConabindNamexret=donames<-askstakenNameslety=nameConcretexcase(Set.memberynames)of_|C.isNoNamey->retyTrue->bindName(nextNamex)retFalse->local(\e->e{takenNames=Set.inserty$takenNamese,currentScope=(currentScopee){scopeLocals=(y,x):scopeLocals(currentScopee)}})$rety-- Dealing with precedences ------------------------------------------------- | General bracketing function.bracket'::(e->e)-- ^ the bracketing function->(Precedence->Bool)-- ^ Should we bracket things-- which have the given-- precedence?->e->AbsToConebracket'parenneedParene=dop<-currentPrecedencereturn$ifneedParenpthenpareneelsee-- | Expression bracketingbracket::(Precedence->Bool)->AbsToConC.Expr->AbsToConC.Exprbracketparm=doe<-mbracket'(Paren(getRangee))pare-- | Pattern bracketingbracketP_::(Precedence->Bool)->AbsToConC.Pattern->AbsToConC.PatternbracketP_parm=doe<-mbracket'(ParenP(getRangee))pare-- | Pattern bracketingbracketP::(Precedence->Bool)->(C.Pattern->AbsToCona)->((C.Pattern->AbsToCona)->AbsToCona)->AbsToConabracketPparretm=m$\p->dop<-bracket'(ParenP$getRangep)parpretp-- Dealing with infix declarations ------------------------------------------ | If a name is defined with a fixity that differs from the default, we have-- to generate a fixity declaration for that name.withInfixDecl::DefInfo->C.Name->AbsToCon[C.Declaration]->AbsToCon[C.Declaration]withInfixDeclixm=dods<-mreturn$fixDecl++synDecl++dswherefixDecl=[C.Infix(theFixity$defFixityi)[x]|theFixity(defFixityi)/=defaultFixity]synDecl=[C.Syntaxx(theNotation(defFixityi))]withInfixDecls::[(DefInfo,C.Name)]->AbsToCon[C.Declaration]->AbsToCon[C.Declaration]withInfixDecls=foldr(.)id.map(uncurrywithInfixDecl)-- Dealing with private definitions ---------------------------------------withAbstractPrivate::DefInfo->AbsToCon[C.Declaration]->AbsToCon[C.Declaration]withAbstractPrivateim=case(defAccessi,defAbstracti)of(PublicAccess,ConcreteDef)->m(p,a)->dods<-mreturn$absta$privp$dswhereprivPrivateAccessds=[C.Private(getRangeds)ds]priv_ds=dsabstAbstractDefds=[C.Abstract(getRangeds)ds]abst_ds=ds-- The To Concrete Class --------------------------------------------------classToConcreteac|a->cwheretoConcrete::a->AbsToConcbindToConcrete::a->(c->AbsToConb)->AbsToConbtoConcretex=bindToConcretexreturnbindToConcretexret=ret=<<toConcretex-- | Translate something in a context of the given precedence.toConcreteCtx::ToConcreteac=>Precedence->a->AbsToConctoConcreteCtxpx=withPrecedencep$toConcretex-- | Translate something in a context of the given precedence.bindToConcreteCtx::ToConcreteac=>Precedence->a->(c->AbsToConb)->AbsToConbbindToConcreteCtxpxret=withPrecedencep$bindToConcretexret-- General instances ------------------------------------------------------instanceToConcreteac=>ToConcrete[a][c]wheretoConcrete=mapMtoConcretebindToConcrete=threadbindToConcreteinstance(ToConcretea1c1,ToConcretea2c2)=>ToConcrete(a1,a2)(c1,c2)wheretoConcrete(x,y)=liftM2(,)(toConcretex)(toConcretey)bindToConcrete(x,y)ret=bindToConcretex$\x->bindToConcretey$\y->ret(x,y)instance(ToConcretea1c1,ToConcretea2c2,ToConcretea3c3)=>ToConcrete(a1,a2,a3)(c1,c2,c3)wheretoConcrete(x,y,z)=reorder<$>toConcrete(x,(y,z))wherereorder(x,(y,z))=(x,y,z)bindToConcrete(x,y,z)ret=bindToConcrete(x,(y,z))$ret.reorderwherereorder(x,(y,z))=(x,y,z)instanceToConcreteac=>ToConcrete(Arga)(Argc)wheretoConcrete(Argh@Hiddenrx)=Arghr<$>toConcreteCtxTopCtxxtoConcrete(Argh@Instancerx)=Arghr<$>toConcreteCtxTopCtxxtoConcrete(Argh@NotHiddenrx)=Arghr<$>toConcretexbindToConcrete(Arghrx)ret=bindToConcreteCtx(hiddenArgumentCtxh)x$ret.ArghrinstanceToConcreteac=>ToConcrete(Namednamea)(Namednamec)wheretoConcrete(Namednx)=Namedn<$>toConcretexbindToConcrete(Namednx)ret=bindToConcretex$ret.NamednnewtypeDontTouchMea=DontTouchMeainstanceToConcrete(DontTouchMea)awheretoConcrete(DontTouchMex)=returnx-- Names ------------------------------------------------------------------instanceToConcreteA.NameC.NamewheretoConcrete=lookupNamebindToConcretex=bindNamexinstanceToConcreteA.QNameC.QNamewheretoConcrete=lookupQNameinstanceToConcreteA.ModuleNameC.QNamewheretoConcrete=lookupModule-- Expression instance ----------------------------------------------------instanceToConcreteA.ExprC.ExprwheretoConcrete(Varx)=Ident.C.QName<$>toConcretextoConcrete(Defx)=Ident<$>toConcretextoConcrete(Con(AmbQ(x:_)))=Ident<$>toConcretextoConcrete(Con(AmbQ[]))=__IMPOSSIBLE__-- for names we have to use the name from the info, since the abstract-- name has been resolved to a fully qualified name (except for-- variables)toConcrete(A.Litl)=return$C.LitltoConcrete(A.QuestionMarki)=return$C.QuestionMark(getRangei)(metaNumberi)toConcrete(A.Underscorei)=return$C.Underscore(getRangei)(metaNumberi)toConcretee@(A.Appie1e2)=tryToRecoverOpAppe-- or fallback to App$bracketappBrackets$doe1'<-toConcreteCtxFunctionCtxe1e2'<-toConcreteCtxArgumentCtxe2return$C.App(getRangei)e1'e2'toConcrete(A.WithAppiees)=bracketwithAppBrackets$doe<-toConcreteCtxWithFunCtxees<-mapM(toConcreteCtxWithArgCtx)esreturn$C.WithApp(getRangei)eestoConcrete(A.AbsurdLamih)=bracketlamBrackets$return$C.AbsurdLam(getRangei)htoConcretee@(A.Lami__)=bracketlamBrackets$caselamVieweof(bs,e)->bindToConcrete(mapmakeDomainFreebs)$\bs->doe<-toConcreteCtxTopCtxereturn$C.Lam(getRangei)bsewherelamView(A.Lam_b@(A.DomainFree___)e)=caselamVieweof([],e)->([b],e)(bs@(A.DomainFree___:_),e)->(b:bs,e)_->([b],e)lamView(A.Lam_b@(A.DomainFull_)e)=caselamVieweof([],e)->([b],e)(bs@(A.DomainFull_:_),e)->(b:bs,e)_->([b],e)lamViewe=([],e)toConcrete(A.ExtendedLamidiqnamecs)=dodecls<-toConcretecsletremoveApp(C.RawAppPr(lam:es))=C.RawAppPresremoveApp(C.AppPpnp)=namedThing$unArgnpremoveApp_=__IMPOSSIBLE__letdecl2clause(C.FunClauselhsrhswh)=(lhs{lhsOriginalPattern=removeApp$lhsOriginalPatternlhs},rhs,wh)decl2clause_=__IMPOSSIBLE__return$C.ExtendedLam(getRangei)(mapdecl2clause$concatdecls)toConcrete(A.Pi_[]e)=toConcreteetoConcretet@(A.Pii__)=casepiTeltof(tel,e)->bracketpiBrackets$bindToConcretetel$\b'->doe'<-toConcreteCtxTopCtxereturn$C.Pib'e'wherepiTel(A.Pi_tele)=(tel++)-*-id$piTelepiTele=([],e)toConcrete(A.Funiab)=bracketpiBrackets$doa'<-toConcreteCtx(ifirrthenDotPatternCtxelseFunctionSpaceDomainCtx)ab'<-toConcreteCtxTopCtxbreturn$C.Fun(getRangei)(addDota'$mkArga')b'whereirr=argRelevancea==IrrelevantaddDotae=ifirrthenDot(getRangea)eelseemkArg(ArgHiddenre)=HiddenArg(getRangee)(unnamede)mkArg(ArgInstancere)=InstanceArg(getRangee)(unnamede)mkArg(ArgNotHiddenre)=etoConcrete(A.Seti0)=return$C.Set(getRangei)toConcrete(A.Setin)=return$C.SetN(getRangei)ntoConcrete(A.Propi)=return$C.Prop(getRangei)toConcrete(A.Letidse)=bracketlamBrackets$bindToConcreteds$\ds'->doe'<-toConcreteCtxTopCtxereturn$C.Let(getRangei)(concatds')e'toConcrete(A.Recifs)=bracketappBrackets$dolet(xs,es)=unzipfses<-toConcreteCtxTopCtxesreturn$C.Rec(getRangei)$zipxsestoConcrete(A.RecUpdateiefs)=bracketappBrackets$dolet(xs,es)=unzipfse<-toConcreteees<-toConcreteCtxTopCtxesreturn$C.RecUpdate(getRangei)e$zipxsestoConcrete(A.ETeltel)=dotel<-toConcretetelreturn$C.ETelteltoConcrete(A.ScopedExpr_e)=toConcreteetoConcrete(A.QuoteGoalixe)=bracketlamBrackets$bindToConcretex$\x'->doe'<-toConcreteereturn$C.QuoteGoal(getRangei)x'e'toConcrete(A.Quotei)=return$C.Quote(getRangei)toConcrete(A.QuoteTermi)=return$C.QuoteTerm(getRangei)toConcrete(A.Unquotei)=return$C.Unquote(getRangei)-- Andreas, 2010-10-05 print irrelevant things as ordinary thingstoConcrete(A.DontCaree)=toConcretee-- toConcrete (A.DontCare e) = C.DontCare <$> toConcreteCtx TopCtx e{-
-- Andreas, 2010-09-21 abuse C.Underscore to print irrelevant things
toConcrete (A.DontCare) = return $ C.Underscore noRange Nothing
-}makeDomainFree::A.LamBinding->A.LamBindingmakeDomainFreeb@(A.DomainFull(A.TypedBindingsr(Arghrel(A.TBind_[x]t))))=caseunScopetofA.UnderscoreMetaInfo{metaNumber=Nothing}->A.DomainFreehrelx_->bwhereunScope(A.ScopedExpr_e)=unScopeeunScopee=emakeDomainFreeb=b-- Binder instances -------------------------------------------------------instanceToConcreteA.LamBindingC.LamBindingwherebindToConcrete(A.DomainFreehrelx)ret=bindToConcretex$ret.C.DomainFreehrel.mkBoundName_bindToConcrete(A.DomainFullb)ret=bindToConcreteb$ret.C.DomainFullinstanceToConcreteA.TypedBindingsC.TypedBindingswherebindToConcrete(A.TypedBindingsrbs)ret=bindToConcretebs$\bs->ret(C.TypedBindingsrbs)instanceToConcreteA.TypedBindingC.TypedBindingwherebindToConcrete(A.TBindrxse)ret=bindToConcretexs$\xs->doe<-toConcreteCtxTopCtxeret(C.TBindr(mapmkBoundName_xs)e)bindToConcrete(A.TNoBinde)ret=doe<-toConcreteCtxTopCtxeret(C.TNoBinde)instanceToConcreteLetBinding[C.Declaration]wherebindToConcrete(LetBindirelxte)ret=bindToConcretex$\x->do(t,(e,[],[],[]))<-toConcrete(t,A.RHSe)ret[C.TypeSigrelxt,C.FunClause(C.LHS(C.IdentP$C.QNamex)[][][])eC.NoWhere]bindToConcrete(LetApplyixmodapp__)ret=dox'<-unqualify<$>toConcretexmodapp<-toConcretemodappletr=getRangemodappopen=maybeDontOpenid$minfoOpenShortidir=maybe(ImportDirectiver(Hiding[])[]False)id$minfoDirectivei-- This is no use since toAbstract LetDefs is in localToAbstract.local(openModule'xdirid)$ret[C.ModuleMacro(getRangei)x'modappopendir]bindToConcrete(LetOpenix)ret=dox'<-toConcretexletdir=maybedefaultImportDirid$minfoDirectiveilocal(openModule'xdirrestrictPrivate)$ret[C.Open(getRangei)x'dir]dataAsWhereDecls=AsWhereDecls[A.Declaration]instanceToConcreteAsWhereDeclsWhereClausewherebindToConcrete(AsWhereDecls[])ret=retC.NoWherebindToConcrete(AsWhereDeclsds@[Section_am__])ret=dods'<-declsToConcretedscm<-unqualify<$>lookupModuleamletwh'=(ifisNoNamecmthenAnyWhereelseSomeWherecm)$ds'local(openModule'amdefaultImportDirid)$retwh'bindToConcrete(AsWhereDeclsds)ret=ret.AnyWhere=<<declsToConcretedsmergeSigAndDef::[C.Declaration]->[C.Declaration]mergeSigAndDef(C.RecordSig_xbse:C.Recordryc_Nothingfs:ds)|x==y=C.Recordrycbs(Juste)fs:mergeSigAndDefdsmergeSigAndDef(C.DataSig__xbse:C.Datariy_Nothingcs:ds)|x==y=C.Datariybs(Juste)cs:mergeSigAndDefdsmergeSigAndDef(d:ds)=d:mergeSigAndDefdsmergeSigAndDef[]=[]openModule'::A.ModuleName->ImportDirective->(Scope->Scope)->Env->EnvopenModule'xdirrestrictenv=env{currentScope=sInfo{scopeModules=mods'}}wheresInfo=currentScopeenvamod=scopeCurrentsInfomods=scopeModulessInfonews=setScopeAccessPrivateNS$applyImportDirectivedir$maybeemptyScoperestrict$Map.lookupxmodsmods'=Map.update(Just.(`mergeScope`news))amodmods-- Declaration instances --------------------------------------------------declsToConcrete::[A.Declaration]->AbsToCon[C.Declaration]declsToConcreteds=mergeSigAndDef.concat<$>toConcretedsinstanceToConcreteA.RHS(C.RHS,[C.Expr],[C.Expr],[C.Declaration])wheretoConcrete(A.RHSe)=doe<-toConcreteereturn(C.RHSe,[],[],[])toConcreteA.AbsurdRHS=return(C.AbsurdRHS,[],[],[])toConcrete(A.WithRHS_escs)=does<-toConcreteescs<-concat<$>toConcretecsreturn(C.AbsurdRHS,[],es,cs)toConcrete(A.RewriteRHS_eqsrhswh)=dowh<-declsToConcretewh(rhs,eqs',es,whs)<-toConcreterhsunless(nulleqs')__IMPOSSIBLE__eqs<-toConcreteeqsreturn(rhs,eqs,es,wh++whs)instanceToConcrete(MaybeA.QName)(MaybeC.Name)wheretoConcreteNothing=returnNothingtoConcrete(Justx)=dox'<-toConcrete(qnameNamex)return$Justx'-- | Helper function used in instance @ToConcrete Definition@.telToTypedBindingss::[C.LamBinding]->[C.TypedBindings]telToTypedBindingss=maplamBindingToTypedBindingswherelamBindingToTypedBindings::C.LamBinding->C.TypedBindingslamBindingToTypedBindingsb=casebofC.DomainFullt->tC.DomainFreehrn->C.TypedBindingsnoRange$Arghr$C.TBindnoRange[n]$C.UnderscorenoRangeNothinginstanceToConcrete(ConstrA.Constructor)C.DeclarationwheretoConcrete(Constr(A.ScopedDeclscope[d]))=withScopescope$toConcrete(Constrd)toConcrete(Constr(A.Axiomirelxt))=dox'<-unsafeQNameToName<$>toConcretext'<-toConcreteCtxTopCtxtreturn$C.TypeSigrelx't'toConcrete(Constrd)=head<$>toConcretedinstanceToConcreteA.Clause[C.Declaration]wheretoConcrete(A.Clauselhsrhswh)=bindToConcretelhs$\lhs->caselhsofC.LHSpwps__->dobindToConcrete(AsWhereDeclswh)$\wh'->do(rhs',eqs,with,wcs)<-toConcreteCtxTopCtxrhsreturn$FunClause(C.LHSpwpseqswith)rhs'wh':wcsC.Ellipsis{}->__IMPOSSIBLE__-- TODO: Is the case above impossible? Previously there was-- no code for it, but GHC 7's completeness checker spotted-- that the case was not covered.instanceToConcreteA.ModuleApplicationC.ModuleApplicationwheretoConcrete(A.SectionApptelyes)=doy<-toConcreteybindToConcretetel$\tel->does<-toConcreteesletr=fuseRangeyesreturn$C.SectionApprtel(foldl(C.Appr)(C.Identy)es)toConcrete(A.RecordModuleIFSrec)=dorec<-toConcreterecreturn$C.RecordModuleIFS(getRangerec)recinstanceToConcreteA.Declaration[C.Declaration]wheretoConcrete(ScopedDeclscopeds)=withScopescope(declsToConcreteds)toConcrete(Axiomirelxt)=dox'<-unsafeQNameToName<$>toConcretexwithAbstractPrivatei$withInfixDeclix'$dot'<-toConcreteCtxTopCtxtreturn[C.Postulate(getRangei)[C.TypeSigrelx't']]toConcrete(A.Fieldixt)=dox'<-unsafeQNameToName<$>toConcretexwithAbstractPrivatei$withInfixDeclix'$dot'<-toConcreteCtxTopCtxtreturn[C.Fieldx't']toConcrete(A.Primitiveixt)=dox'<-unsafeQNameToName<$>toConcretexwithAbstractPrivatei$withInfixDeclix'$dot'<-toConcreteCtxTopCtxtreturn[C.Primitive(getRangei)[C.TypeSigRelevantx't']]-- Primitives are always relevant.toConcrete(A.FunDefi_cs)=withAbstractPrivatei$concat<$>toConcretecstoConcrete(A.DataSigixbst)=withAbstractPrivatei$bindToConcretebs$\tel'->dox'<-unsafeQNameToName<$>toConcretext'<-toConcreteCtxTopCtxtreturn[C.DataSig(getRangei)Inductivex'(mapC.DomainFulltel')t']toConcrete(A.DataDefixbscs)=withAbstractPrivatei$bindToConcrete(mapmakeDomainFreebs)$\tel'->do(x',cs')<-(unsafeQNameToName-*-id)<$>toConcrete(x,mapConstrcs)return[C.Data(getRangei)Inductivex'tel'Nothingcs']toConcrete(A.RecSigixbst)=withAbstractPrivatei$bindToConcretebs$\tel'->dox'<-unsafeQNameToName<$>toConcretext'<-toConcreteCtxTopCtxtreturn[C.RecordSig(getRangei)x'(mapC.DomainFulltel')t']toConcrete(A.RecDefixcbstcs)=withAbstractPrivatei$bindToConcrete(mapmakeDomainFreebs)$\tel'->do(x',cs')<-(unsafeQNameToName-*-id)<$>toConcrete(x,mapConstrcs)return[C.Record(getRangei)x'Nothingtel'Nothingcs']toConcrete(A.Mutualids)=declsToConcretedstoConcrete(A.Sectionixtelds)=dox<-toConcretexbindToConcretetel$\tel->dods<-declsToConcretedsreturn[C.Module(getRangei)xtelds]toConcrete(A.Applyixmodapp__)=dox<-unsafeQNameToName<$>toConcretexmodapp<-toConcretemodappletr=getRangemodappopen=maybeDontOpenid$minfoOpenShortidir=maybe(ImportDirectiver(Hiding[])[]False)id$minfoDirectiveireturn[C.ModuleMacro(getRangei)xmodappopendir]toConcrete(A.Importix)=dox<-toConcretexletopen=maybeDontOpenid$minfoOpenShortidir=maybedefaultImportDirid$minfoDirectiveireturn[C.Import(getRangei)xNothingopendir]toConcrete(A.Pragmaip)=dop<-toConcrete$RangeAndPragma(getRangei)preturn[C.Pragmap]toConcrete(A.Openix)=dox<-toConcretexreturn[C.Open(getRangei)xdefaultImportDir]dataRangeAndPragma=RangeAndPragmaRangeA.PragmainstanceToConcreteRangeAndPragmaC.PragmawheretoConcrete(RangeAndPragmarp)=casepofA.OptionsPragmaxs->return$C.OptionsPragmarxsA.BuiltinPragmabx->dox<-toConcretexreturn$C.BuiltinPragmarbxA.CompiledTypePragmaxhs->dox<-toConcretexreturn$C.CompiledTypePragmarxhsA.CompiledDataPragmaxhshcs->dox<-toConcretexreturn$C.CompiledDataPragmarxhshcsA.CompiledPragmaxhs->dox<-toConcretexreturn$C.CompiledPragmarxhsA.CompiledEpicPragmaxe->dox<-toConcretexreturn$C.CompiledEpicPragmarxeA.CompiledJSPragmaxe->dox<-toConcretexreturn$C.CompiledJSPragmarxeA.StaticPragmax->dox<-toConcretexreturn$C.StaticPragmarxA.EtaPragmax->C.EtaPragmar<$>toConcretex-- Left hand sides --------------------------------------------------------noImplicitArgs=filter(noImplicit.namedThing.unArg)noImplicitPats=filternoImplicitnoImplicit(A.ImplicitP_)=FalsenoImplicit_=TrueinstanceToConcreteA.LHSC.LHSwherebindToConcrete(A.LHSixargswps)ret=dobindToConcreteCtxTopCtx(A.DefPinfoxargs)$\lhs->bindToConcreteCtxTopCtx(noImplicitPatswps)$\wps->ret$C.LHSlhswps[][]whereinfo=PatRange(getRangei)appBrackets'::[arg]->Precedence->BoolappBrackets'[]_=FalseappBrackets'(_:_)ctx=appBracketsctx-- TODO: bind variables properlyinstanceToConcreteA.PatternC.PatternwheretoConcrete(VarPx)=toConcretex>>=return.IdentP.C.QNametoConcrete(A.WildPi)=return$C.WildP(getRangei)toConcrete(ConPi(AmbQ[])args)=__IMPOSSIBLE__toConcretep@(ConPi(AmbQ(x:_))args)=tryToRecoverOpAppPp$bracketP_(appBrackets'args)$dox<-toConcretexargs<-toConcreteCtxArgumentCtx(noImplicitArgsargs)return$foldlAppP(C.IdentPx)argstoConcretep@(DefPixargs)=tryToRecoverOpAppPp$bracketP_(appBrackets'args)$dox<-toConcretexargs<-toConcreteCtxArgumentCtx(noImplicitArgsargs)return$foldlAppP(C.IdentPx)argstoConcrete(A.AsPixp)=do(x,p)<-toConcreteCtxArgumentCtx(x,p)return$C.AsP(getRangei)xptoConcrete(A.AbsurdPi)=return$C.AbsurdP(getRangei)toConcrete(A.LitPl)=return$C.LitPltoConcrete(A.DotPie)=doe<-toConcreteCtxDotPatternCtxereturn$C.DotP(getRangei)e-- just for debugging purposes (shouldn't show up in practise)toConcrete(A.ImplicitPi)=return$C.IdentP(C.QName$C.NamenoRange[C.Id"(implicit)"])-- Helpers for recovering C.OpApp ------------------------------------------dataHd=HdVarA.Name|HdConA.QName|HdDefA.QNamecOpApp::Range->C.Name->[C.Expr]->C.ExprcOpApprnes=C.OpApprn(mapOrdinaryes)tryToRecoverOpApp::A.Expr->AbsToConC.Expr->AbsToConC.ExprtryToRecoverOpAppedef=recoverOpAppbracketcOpAppviewedefwhereviewe=caseAV.appVieweof--NonApplication _ -> NothingApplication(Varx)args->Just(HdVarx,args)Application(Deff)args->Just(HdDeff,args)Application(Con(AmbQ(c:_)))args->Just(HdConc,args)Application(Con(AmbQ[]))args->__IMPOSSIBLE___->NothingtryToRecoverOpAppP::A.Pattern->AbsToConC.Pattern->AbsToConC.PatterntryToRecoverOpAppPpdef=recoverOpAppbracketP_C.OpAppPviewpdefwhereviewp=casepofConP_(AmbQ(c:_))ps->Just(HdConc,ps)DefP_fps->Just(HdDeff,ps)_->NothingrecoverOpApp::(ToConcreteac,HasRangec)=>((Precedence->Bool)->AbsToConc->AbsToConc)->(Range->C.Name->[c]->c)->(a->Maybe(Hd,[NamedArga]))->a->AbsToConc->AbsToConcrecoverOpAppbracketopAppviewemdefault=casevieweofNothing->mdefaultJust(hd,args)|allnotHiddenargs->doletargs'=map(namedThing.unArg)argscasehdofHdVarn|isNoNamen->mdefault|otherwise->dox<-toConcretendoCName(theFixity$nameFixityn)xargs'HdDefqn->doQNameqnargs'HdConqn->doQNameqnargs'|otherwise->mdefaultwhereisNoNamex=C.isNoName$A.nameConcretexnotHiddena=argHidinga==NotHidden-- qualified names can't use mixfix syntaxdoQNameqnas=dox<-toConcreteqncasexofC.QNamex->doCName(theFixity$nameFixity$qnameNameqn)xas_->mdefault-- fall-back (wrong number of arguments or no holes)doCName_cn@(C.Name_xs)es|lengthxs==1=mdefault|lengthes/=numHoles=mdefault|List.nulles=mdefaultwherenumHoles=length[()|Hole<-xs]msg="doCName "++showListxs""++" on "++show(lengthes)++" args"-- binary casedoCNamefixitycn@(C.Name_xs)as|Hole<-headxs,Hole<-lastxs=doleta1=headasan=lastasas'=caseasofas@(_:_:_)->init$tailas_->__IMPOSSIBLE__e1<-toConcreteCtx(LeftOperandCtxfixity)a1es<-mapM(toConcreteCtxInsideOperandCtx)as'en<-toConcreteCtx(RightOperandCtxfixity)anbracket(opBracketsfixity)$return$opApp(getRange(e1,en))cn([e1]++es++[en])-- prefixdoCNamefixitycn@(C.Name_xs)as|Hole<-lastxs=doletan=lastasas'=caseasofas@(_:_)->initas_->__IMPOSSIBLE__es<-mapM(toConcreteCtxInsideOperandCtx)as'en<-toConcreteCtx(RightOperandCtxfixity)anbracket(opBracketsfixity)$return$opApp(getRange(cn,en))cn(es++[en])-- postfixdoCNamefixitycn@(C.Name_xs)as|Hole<-headxs=doleta1=headasas'=tailase1<-toConcreteCtx(LeftOperandCtxfixity)a1es<-mapM(toConcreteCtxInsideOperandCtx)as'bracket(opBracketsfixity)$return$opApp(getRange(e1,cn))cn([e1]++es)-- roundfixdoCName_cnas=does<-mapM(toConcreteCtxInsideOperandCtx)asbracketroundFixBrackets$return$opApp(getRangecn)cnes