{-# LANGUAGE CPP #-}moduleNameShape(NameShape(..),emptyNameShape ,mkNameShape ,extendNameShape ,nameShapeExports ,substNameShape ,maybeSubstNameShape ,)where#include "HsVersions.h"
importGhcPreludeimportOutputableimportHscTypesimportModuleimportUniqFMimportAvailimportFieldLabelimportNameimportNameEnvimportTcRnMonad importUtilimportIfaceEnv importControl.Monad-- Note [NameShape]-- ~~~~~~~~~~~~~~~~-- When we write a declaration in a signature, e.g., data T, we-- ascribe to it a *name variable*, e.g., {m.T}. This-- name variable may be substituted with an actual original-- name when the signature is implemented (or even if we-- merge the signature with one which reexports this entity-- from another module).-- When we instantiate a signature m with a module M,-- we also need to substitute over names. To do so, we must-- compute the *name substitution* induced by the *exports*-- of the module in question. A NameShape represents-- such a name substitution for a single module instantiation.-- The "shape" in the name comes from the fact that the computation-- of a name substitution is essentially the *shaping pass* from-- Backpack'14, but in a far more restricted form.-- The name substitution for an export list is easy to explain. If we are-- filling the module variable <m>, given an export N of the form-- M.n or {m'.n} (where n is an OccName), the induced name-- substitution is from {m.n} to N. So, for example, if we have-- A=impl:B, and the exports of impl:B are impl:B.f and-- impl:C.g, then our name substitution is {A.f} to impl:B.f-- and {A.g} to impl:C.g-- The 'NameShape' type is defined in TcRnTypes, because TcRnTypes-- needs to refer to NameShape, and having TcRnTypes import-- NameShape (even by SOURCE) would cause a large number of-- modules to be pulled into the DynFlags cycle.{-
data NameShape = NameShape {
 ns_mod_name :: ModuleName,
 ns_exports :: [AvailInfo],
 ns_map :: OccEnv Name
 }
-}-- NB: substitution functions need 'HscEnv' since they need the name cache-- to allocate new names if we change the 'Module' of a 'Name'-- | Create an empty 'NameShape' (i.e., the renaming that-- would occur with an implementing module with no exports)-- for a specific hole @mod_name@.emptyNameShape::ModuleName->NameShapeemptyNameShape mod_name =NameShapemod_name []emptyOccEnv-- | Create a 'NameShape' corresponding to an implementing-- module for the hole @mod_name@ that exports a list of 'AvailInfo's.mkNameShape::ModuleName->[AvailInfo]->NameShapemkNameShape mod_name as=NameShapemod_name as$mkOccEnv$doa <-asn <-availNamea :availNamesWithSelectorsa return(occNamen ,n )-- | Given an existing 'NameShape', merge it with a list of 'AvailInfo's-- with Backpack style mix-in linking. This is used solely when merging-- signatures together: we successively merge the exports of each-- signature until we have the final, full exports of the merged signature.---- What makes this operation nontrivial is what we are supposed to do when-- we want to merge in an export for M.T when we already have an existing-- export {H.T}. What should happen in this case is that {H.T} should be-- unified with @M.T@: we've determined a more *precise* identity for the-- export at 'OccName' @T@.---- Note that we don't do unrestricted unification: only name holes from-- @ns_mod_name ns@ are flexible. This is because we have a much more-- restricted notion of shaping than in Backpack'14: we do shaping-- *as* we do type-checking. Thus, once we shape a signature, its-- exports are *final* and we're not allowed to refine them further,extendNameShape::HscEnv->NameShape->[AvailInfo]->IO(EitherSDocNameShape)extendNameShape hsc_env ns as=caseuAvailInfos (ns_mod_namens )(ns_exportsns )asofLefterr ->return(Lefterr )Rightnsubst ->doas1 <-mapM(liftIO.substNameAvailInfo hsc_env nsubst )(ns_exportsns )as2 <-mapM(liftIO.substNameAvailInfo hsc_env nsubst )asletnew_avails =mergeAvails as1 as2 return.Right$ns {ns_exports=new_avails ,-- TODO: stop repeatedly rebuilding the OccEnvns_map=mkOccEnv$doa <-new_avails n <-availNamea :availNamesa return(occNamen ,n )}-- | The export list associated with this 'NameShape' (i.e., what-- the exports of an implementing module which induces this 'NameShape'-- would be.)nameShapeExports::NameShape->[AvailInfo]nameShapeExports =ns_exports-- | Given a 'Name', substitute it according to the 'NameShape' implied-- substitution, i.e. map @{A.T}@ to @M.T@, if the implementing module-- exports @M.T@.substNameShape::NameShape->Name->NamesubstNameShape ns n |nameModulen ==ns_module ns ,Justn' <-lookupOccEnv(ns_mapns )(occNamen )=n' |otherwise=n -- | Like 'substNameShape', but returns @Nothing@ if no substitution-- works.maybeSubstNameShape::NameShape->Name->MaybeNamemaybeSubstNameShape ns n |nameModulen ==ns_module ns =lookupOccEnv(ns_mapns )(occNamen )|otherwise=Nothing-- | The 'Module' of any 'Name's a 'NameShape' has action over.ns_module::NameShape->Modulens_module =mkHoleModule.ns_mod_name{-
************************************************************************
* *
 Name substitutions
* *
************************************************************************
-}-- | Substitution on @{A.T}@. We enforce the invariant that the-- 'nameModule' of keys of this map have 'moduleUnitId' @hole@-- (meaning that if we have a hole substitution, the keys of the map-- are never affected.) Alternatively, this is isomorphic to-- @Map ('ModuleName', 'OccName') 'Name'@.typeShNameSubst =NameEnvName-- NB: In this module, we actually only ever construct 'ShNameSubst'-- at a single 'ModuleName'. But 'ShNameSubst' is more convenient to-- work with.-- | Substitute names in a 'Name'.substName::ShNameSubst ->Name->NamesubstName env n |Justn' <-lookupNameEnvenv n =n' |otherwise=n -- | Substitute names in an 'AvailInfo'. This has special behavior-- for type constructors, where it is sufficient to substitute the 'availName'-- to induce a substitution on 'availNames'.substNameAvailInfo::HscEnv->ShNameSubst ->AvailInfo->IOAvailInfosubstNameAvailInfo _env (Availn )=return(Avail(substName env n ))substNameAvailInfohsc_env env (AvailTCn ns fs )=letmb_mod =fmapnameModule(lookupNameEnvenv n )inAvailTC(substName env n )<$>mapM(initIfaceLoad hsc_env .setNameModule mb_mod )ns <*>mapM(setNameFieldSelector hsc_env mb_mod )fs -- | Set the 'Module' of a 'FieldSelector'setNameFieldSelector::HscEnv->MaybeModule->FieldLabel->IOFieldLabelsetNameFieldSelector _Nothingf =returnf setNameFieldSelectorhsc_env mb_mod (FieldLabell b sel )=dosel' <-initIfaceLoad hsc_env $setNameModule mb_mod sel return(FieldLabell b sel' ){-
************************************************************************
* *
 AvailInfo merging
* *
************************************************************************
-}-- | Merges to 'AvailInfo' lists together, assuming the 'AvailInfo's have-- already been unified ('uAvailInfos').mergeAvails::[AvailInfo]->[AvailInfo]->[AvailInfo]mergeAvails as1 as2 =letmkNE as=mkNameEnv[(availNamea ,a )|a <-as]innameEnvElts(plusNameEnv_CplusAvail(mkNE as1 )(mkNE as2 )){-
************************************************************************
* *
 AvailInfo unification
* *
************************************************************************
-}-- | Unify two lists of 'AvailInfo's, given an existing substitution @subst@,-- with only name holes from @flexi@ unifiable (all other name holes rigid.)uAvailInfos::ModuleName->[AvailInfo]->[AvailInfo]->EitherSDocShNameSubst uAvailInfos flexi as1 as2 =-- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $letmkOE as=listToUFM$doa <-asn <-availNamesa return(nameOccNamen ,a )infoldM(\subst (a1 ,a2 )->uAvailInfo flexi subst a1 a2 )emptyNameEnv(eltsUFM(intersectUFM_C(,)(mkOE as1 )(mkOE as2 )))-- Edward: I have to say, this is pretty clever.-- | Unify two 'AvailInfo's, given an existing substitution @subst@,-- with only name holes from @flexi@ unifiable (all other name holes rigid.)uAvailInfo::ModuleName->ShNameSubst ->AvailInfo->AvailInfo->EitherSDocShNameSubst uAvailInfo flexi subst (Availn1 )(Availn2 )=uName flexi subst n1 n2 uAvailInfoflexi subst (AvailTCn1 __)(AvailTCn2 __)=uName flexi subst n1 n2 uAvailInfo__a1 a2 =Left$text"While merging export lists, could not combine"<+>ppra1 <+>text"with"<+>ppra2 <+>parens(text"one is a type, the other is a plain identifier")-- | Unify two 'Name's, given an existing substitution @subst@,-- with only name holes from @flexi@ unifiable (all other name holes rigid.)uName::ModuleName->ShNameSubst ->Name->Name->EitherSDocShNameSubst uName flexi subst n1 n2 |n1 ==n2 =Rightsubst |isFlexi n1 =uHoleName flexi subst n1 n2 |isFlexi n2 =uHoleName flexi subst n2 n1 |otherwise=Left(text"While merging export lists, could not unify"<+>pprn1 <+>text"with"<+>pprn2 $$extra )whereisFlexi n =isHoleNamen &&moduleName(nameModulen )==flexi extra |isHoleNamen1 ||isHoleNamen2 =text"Neither name variable originates from the current signature."|otherwise=empty-- | Unify a name @h@ which 'isHoleName' with another name, given an existing-- substitution @subst@, with only name holes from @flexi@ unifiable (all-- other name holes rigid.)uHoleName::ModuleName->ShNameSubst ->Name{- hole name -}->Name->EitherSDocShNameSubst uHoleName flexi subst h n =ASSERT(isHoleNameh)caselookupNameEnvsubst h ofJustn' ->uName flexi subst n' n -- Do a quick check if the other name is substituted.Nothing|Justn' <-lookupNameEnvsubst n ->ASSERT(isHoleNamen)uNameflexisubsthn'|otherwise->Right(extendNameEnvsubst h n )