%%(c)TheUniversityofGlasgow2006%(c)TheAQUAProject,GlasgowUniversity,1996-1998%Thismodulecontains"tidying"codefor*nested*expressions,bindings,rules.Thecodefor*top-level*bindingsisinTidyPgm.\begin{code}moduleCoreTidy(tidyExpr,tidyVarOcc,tidyRule,tidyRules)where#include "HsVersions.h"importCoreSynimportCoreArityimportIdimportIdInfoimportTypeimportVarimportVarEnvimportUniqFMimportNamehiding(tidyNameOcc)importSrcLocimportMaybesimportData.List\end{code}%************************************************************************%**\subsection{Tidyingexpressions,rules}%**%************************************************************************\begin{code}tidyBind::TidyEnv->CoreBind->(TidyEnv,CoreBind)tidyBindenv(NonRecbndrrhs)=tidyLetBndrenv(bndr,rhs)=:\(env',bndr')->(env',NonRecbndr'(tidyExprenv'rhs))tidyBindenv(Recprs)=mapAccumLtidyLetBndrenvprs=:\(env',bndrs')->map(tidyExprenv')(mapsndprs)=:\rhss'->(env',Rec(zipbndrs'rhss'))------------ Expressions --------------tidyExpr::TidyEnv->CoreExpr->CoreExprtidyExprenv(Varv)=Var(tidyVarOccenvv)tidyExprenv(Typety)=Type(tidyTypeenvty)tidyExpr_(Litlit)=LitlittidyExprenv(Appfa)=App(tidyExprenvf)(tidyExprenva)tidyExprenv(Notene)=Note(tidyNoteenvn)(tidyExprenve)tidyExprenv(Casteco)=Cast(tidyExprenve)(tidyTypeenvco)tidyExprenv(Letbe)=tidyBindenvb=:\(env',b')->Letb'(tidyExprenv'e)tidyExprenv(Caseebtyalts)=tidyBndrenvb=:\(env',b)->Case(tidyExprenve)b(tidyTypeenvty)(map(tidyAltbenv')alts)tidyExprenv(Lambe)=tidyBndrenvb=:\(env',b)->Lamb(tidyExprenv'e)------------ Case alternatives --------------tidyAlt::CoreBndr->TidyEnv->CoreAlt->CoreAlttidyAlt_case_bndrenv(con,vs,rhs)=tidyBndrsenvvs=:\(env',vs)->(con,vs,tidyExprenv'rhs)------------ Notes --------------tidyNote::TidyEnv->Note->NotetidyNote_note=note------------ Rules --------------tidyRules::TidyEnv->[CoreRule]->[CoreRule]tidyRules_[]=[]tidyRulesenv(rule:rules)=tidyRuleenvrule=:\rule->tidyRulesenvrules=:\rules->(rule:rules)tidyRule::TidyEnv->CoreRule->CoreRuletidyRule_rule@(BuiltinRule{})=ruletidyRuleenvrule@(Rule{ru_bndrs=bndrs,ru_args=args,ru_rhs=rhs,ru_fn=fn,ru_rough=mb_ns})=tidyBndrsenvbndrs=:\(env',bndrs)->map(tidyExprenv')args=:\args->rule{ru_bndrs=bndrs,ru_args=args,ru_rhs=tidyExprenv'rhs,ru_fn=tidyNameOccenvfn,ru_rough=map(fmap(tidyNameOccenv'))mb_ns}\end{code}%************************************************************************%**\subsection{Tidyingnon-top-levelbinders}%**%************************************************************************\begin{code}tidyNameOcc::TidyEnv->Name->Name-- In rules and instances, we have Names, and we must tidy them too-- Fortunately, we can lookup in the VarEnv with a nametidyNameOcc(_,var_env)n=caselookupUFMvar_envnofNothing->nJustv->idNamevtidyVarOcc::TidyEnv->Var->VartidyVarOcc(_,var_env)v=lookupVarEnvvar_envv`orElse`v-- tidyBndr is used for lambda and case binderstidyBndr::TidyEnv->Var->(TidyEnv,Var)tidyBndrenvvar|isTyVarvar=tidyTyVarBndrenvvar|otherwise=tidyIdBndrenvvartidyBndrs::TidyEnv->[Var]->(TidyEnv,[Var])tidyBndrsenvvars=mapAccumLtidyBndrenvvarstidyLetBndr::TidyEnv->(Id,CoreExpr)->(TidyEnv,Var)-- Used for local (non-top-level) let(rec)stidyLetBndrenv(id,rhs)=((tidy_env,new_var_env),final_id)where((tidy_env,var_env),new_id)=tidyIdBndrenvid-- We need to keep around any interesting strictness and-- demand info because later on we may need to use it when-- converting to A-normal form.-- eg.-- f (g x), where f is strict in its argument, will be converted-- into case (g x) of z -> f z by CorePrep, but only if f still-- has its strictness info.---- Similarly for the demand info - on a let binder, this tells -- CorePrep to turn the let into a case.---- Similarly arity info for eta expansion in CorePrep-- -- Set inline-prag info so that we preseve it across -- separate compilation boundariesfinal_id=new_id`setIdInfo`new_infoidinfo=idInfoidnew_info=vanillaIdInfo`setArityInfo`exprArityrhs`setAllStrictnessInfo`newStrictnessInfoidinfo`setNewDemandInfo`newDemandInfoidinfo`setInlinePragInfo`inlinePragInfoidinfo-- Override the env we get back from tidyId with the new IdInfo-- so it gets propagated to the usage sites.new_var_env=extendVarEnvvar_envidfinal_id-- Non-top-level variablestidyIdBndr::TidyEnv->Id->(TidyEnv,Id)tidyIdBndrenv@(tidy_env,var_env)id=-- do this pattern match strictly, otherwise we end up holding on to-- stuff in the OccName.casetidyOccNametidy_env(getOccNameid)of{(tidy_env',occ')->let-- Give the Id a fresh print-name, *and* rename its type-- The SrcLoc isn't important now, -- though we could extract it from the Id-- -- All nested Ids now have the same IdInfo, namely vanillaIdInfo,-- which should save some space; except that we hang onto dead-ness-- (at the moment, solely to make printing tidy core nicer)-- But note that tidyLetBndr puts some of it back.ty'=tidyTypeenv(idTypeid)name'=mkInternalName(idUniqueid)occ'noSrcSpanid'=mkLocalIdWithInfoname'ty'new_infovar_env'=extendVarEnvvar_envidid'new_info|isDeadOcc(idOccInfoid)=deadIdInfo|otherwise=vanillaIdInfoin((tidy_env',var_env'),id')}deadIdInfo::IdInfodeadIdInfo=vanillaIdInfo`setOccInfo`IAmDead\end{code}\begin{code}(=:)::a->(a->b)->bm=:k=m`seq`km\end{code}