summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc')
-rw-r--r--compiler/GHC/Tc/Deriv/Generics.hs4
-rw-r--r--compiler/GHC/Tc/Errors.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs16
-rw-r--r--compiler/GHC/Tc/Instance/Family.hs2
-rw-r--r--compiler/GHC/Tc/Instance/Typeable.hs4
-rw-r--r--compiler/GHC/Tc/Module.hs2
-rw-r--r--compiler/GHC/Tc/TyCl.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/Utils.hs6
-rw-r--r--compiler/GHC/Tc/Types.hs6
-rw-r--r--compiler/GHC/Tc/Types/EvTerm.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs103
-rw-r--r--compiler/GHC/Tc/Utils/Env.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs4
13 files changed, 77 insertions, 80 deletions
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index 31dc85d7e9..9205856996 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -31,7 +31,7 @@ import GHC.Core.TyCon
import GHC.Core.FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom )
import GHC.Tc.Instance.Family
import GHC.Types.Module ( moduleName, moduleNameFS
- , moduleUnitId, unitIdFS, getModule )
+ , moduleUnit, unitFS, getModule )
import GHC.Iface.Env ( newGlobalBinder )
import GHC.Types.Name hiding ( varName )
import GHC.Types.Name.Reader
@@ -615,7 +615,7 @@ tc_mkRepTy gk_ tycon k =
dtName = mkStrLitTy . occNameFS . nameOccName $ tyConName_user
mdName = mkStrLitTy . moduleNameFS . moduleName
. nameModule . tyConName $ tycon
- pkgName = mkStrLitTy . unitIdFS . moduleUnitId
+ pkgName = mkStrLitTy . unitFS . moduleUnit
. nameModule . tyConName $ tycon
isNT = mkTyConTy $ if isNewTyCon tycon
then promotedTrueDataCon
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index e4746032d3..b90eae080b 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -2149,7 +2149,7 @@ sameOccExtra ty1 ty2
, let n1 = tyConName tc1
n2 = tyConName tc2
same_occ = nameOccName n1 == nameOccName n2
- same_pkg = moduleUnitId (nameModule n1) == moduleUnitId (nameModule n2)
+ same_pkg = moduleUnit (nameModule n1) == moduleUnit (nameModule n2)
, n1 /= n2 -- Different Names
, same_occ -- but same OccName
= text "NB:" <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)
@@ -2166,7 +2166,7 @@ sameOccExtra ty1 ty2
, ppUnless (same_pkg || pkg == mainUnitId) $
nest 4 $ text "in package" <+> quotes (ppr pkg) ])
where
- pkg = moduleUnitId mod
+ pkg = moduleUnit mod
mod = nameModule nm
loc = nameSrcSpan nm
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 67ef5a3e6c..2b308bf753 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -1087,7 +1087,7 @@ instance TH.Quasi TcM where
RealSrcSpan s _ -> return s
; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
, TH.loc_module = moduleNameString (moduleName m)
- , TH.loc_package = unitIdString (moduleUnitId m)
+ , TH.loc_package = unitString (moduleUnit m)
, TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r)
, TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) }
@@ -2216,7 +2216,7 @@ reifyName thing
where
name = getName thing
mod = ASSERT( isExternalName name ) nameModule name
- pkg_str = unitIdString (moduleUnitId mod)
+ pkg_str = unitString (moduleUnit mod)
mod_str = moduleNameString (moduleName mod)
occ_str = occNameString occ
occ = nameOccName name
@@ -2234,7 +2234,7 @@ reifyFieldLabel fl
where
name = flSelector fl
mod = ASSERT( isExternalName name ) nameModule name
- pkg_str = unitIdString (moduleUnitId mod)
+ pkg_str = unitString (moduleUnit mod)
mod_str = moduleNameString (moduleName mod)
occ_str = unpackFS (flLabel fl)
@@ -2296,7 +2296,7 @@ lookupThAnnLookup :: TH.AnnLookup -> TcM CoreAnnTarget
lookupThAnnLookup (TH.AnnLookupName th_nm) = fmap NamedTarget (lookupThName th_nm)
lookupThAnnLookup (TH.AnnLookupModule (TH.Module pn mn))
= return $ ModuleTarget $
- mkModule (stringToUnitId $ TH.pkgString pn) (mkModuleName $ TH.modString mn)
+ mkModule (stringToUnit $ TH.pkgString pn) (mkModuleName $ TH.modString mn)
reifyAnnotations :: Data a => TH.AnnLookup -> TcM [a]
reifyAnnotations th_name
@@ -2310,13 +2310,13 @@ reifyAnnotations th_name
------------------------------
modToTHMod :: Module -> TH.Module
-modToTHMod m = TH.Module (TH.PkgName $ unitIdString $ moduleUnitId m)
+modToTHMod m = TH.Module (TH.PkgName $ unitString $ moduleUnit m)
(TH.ModName $ moduleNameString $ moduleName m)
reifyModule :: TH.Module -> TcM TH.ModuleInfo
reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do
this_mod <- getModule
- let reifMod = mkModule (stringToUnitId pkgString) (mkModuleName mString)
+ let reifMod = mkModule (stringToUnit pkgString) (mkModuleName mString)
if (reifMod == this_mod) then reifyThisModule else reifyFromIface reifMod
where
reifyThisModule = do
@@ -2326,10 +2326,10 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do
reifyFromIface reifMod = do
iface <- loadInterfaceForModule (text "reifying module from TH for" <+> ppr reifMod) reifMod
let usages = [modToTHMod m | usage <- mi_usages iface,
- Just m <- [usageToModule (moduleUnitId reifMod) usage] ]
+ Just m <- [usageToModule (moduleUnit reifMod) usage] ]
return $ TH.ModuleInfo usages
- usageToModule :: UnitId -> Usage -> Maybe Module
+ usageToModule :: Unit -> Usage -> Maybe Module
usageToModule _ (UsageFile {}) = Nothing
usageToModule this_pkg (UsageHomeModule { usg_mod_name = mn }) = Just $ mkModule this_pkg mn
usageToModule _ (UsagePackageModule { usg_mod = m }) = Just m
diff --git a/compiler/GHC/Tc/Instance/Family.hs b/compiler/GHC/Tc/Instance/Family.hs
index 6f1ac07f74..507da20c92 100644
--- a/compiler/GHC/Tc/Instance/Family.hs
+++ b/compiler/GHC/Tc/Instance/Family.hs
@@ -632,7 +632,7 @@ loadDependentFamInstModules fam_insts
want_module mod -- See Note [Home package family instances]
| mod == this_mod = False
- | home_fams_only = moduleUnitId mod == moduleUnitId this_mod
+ | home_fams_only = moduleUnit mod == moduleUnit this_mod
| otherwise = True
home_fams_only = all (nameIsHomePackage this_mod . fi_fam) fam_insts
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
index 2c7656a20c..2de4e057b0 100644
--- a/compiler/GHC/Tc/Instance/Typeable.hs
+++ b/compiler/GHC/Tc/Instance/Typeable.hs
@@ -205,7 +205,7 @@ mkModIdRHS mod
= do { trModuleDataCon <- tcLookupDataCon trModuleDataConName
; trNameLit <- mkTrNameLit
; return $ nlHsDataCon trModuleDataCon
- `nlHsApp` trNameLit (unitIdFS (moduleUnitId mod))
+ `nlHsApp` trNameLit (unitFS (moduleUnit mod))
`nlHsApp` trNameLit (moduleNameFS (moduleName mod))
}
@@ -265,7 +265,7 @@ todoForTyCons mod mod_id tycons = do
}
where
mod_fpr = fingerprintString $ moduleNameString $ moduleName mod
- pkg_fpr = fingerprintString $ unitIdString $ moduleUnitId mod
+ pkg_fpr = fingerprintString $ unitString $ moduleUnit mod
todoForExportedKindReps :: [(Kind, Name)] -> TcM TypeRepTodo
todoForExportedKindReps kinds = do
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index e202fdcec7..516aea677e 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -35,7 +35,7 @@ module GHC.Tc.Module (
checkBootDecl, checkHiBootIface',
findExtraSigImports,
implicitRequirements,
- checkUnitId,
+ checkUnit,
mergeSignatures,
tcRnMergeSignatures,
instantiateSignature,
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 1f44338a4c..93637329ad 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -4037,7 +4037,7 @@ checkValidDataCon dflags existential_ok tc con
-- when we actually fill in the abstract type. As such, don't
-- warn in this case (it gives users the wrong idea about whether
-- or not UNPACK on abstract types is supported; it is!)
- , unitIdIsDefinite (thisPackage dflags)
+ , unitIsDefinite (thisPackage dflags)
= addWarnTc NoReason (bad_bang n (text "Ignoring unusable UNPACK pragma"))
where
is_strict = case strict_mark of
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index 890222b8aa..ad0aec3ac1 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -181,11 +181,11 @@ checkNameIsAcyclic n m = SynCycleM $ \s ->
Left err -> Left err
-- | Checks if any of the passed in 'TyCon's have cycles.
--- Takes the 'UnitId' of the home package (as we can avoid
+-- Takes the 'Unit' of the home package (as we can avoid
-- checking those TyCons: cycles never go through foreign packages) and
-- the corresponding @LTyClDecl Name@ for each 'TyCon', so we
-- can give better error messages.
-checkSynCycles :: UnitId -> [TyCon] -> [LTyClDecl GhcRn] -> TcM ()
+checkSynCycles :: Unit -> [TyCon] -> [LTyClDecl GhcRn] -> TcM ()
checkSynCycles this_uid tcs tyclds = do
case runSynCycleM (mapM_ (go emptyNameSet []) tcs) emptyNameSet of
Left (loc, err) -> setSrcSpan loc $ failWithTc err
@@ -215,7 +215,7 @@ checkSynCycles this_uid tcs tyclds = do
-- This won't hold once we get recursive packages with Backpack,
-- but for now it's fine.
| not (isHoleModule mod ||
- moduleUnitId mod == this_uid ||
+ moduleUnit mod == this_uid ||
isInteractiveModule mod)
= return ()
| Just ty <- synTyConRhs_maybe tc =
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index be345c4f30..2dab080afb 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -381,7 +381,7 @@ data FrontendResult
--
-- if I have a Module, this_mod, in hand representing the module
-- currently being compiled,
--- then moduleUnitId this_mod == thisPackage dflags
+-- then moduleUnit this_mod == thisPackage dflags
--
-- - For any code involving Names, we want semantic modules.
-- See lookupIfaceTop in GHC.Iface.Env, mkIface and addFingerprints
@@ -1350,12 +1350,12 @@ data ImportAvails
-- compiling M might not need to consult X.hi, but X
-- is still listed in M's dependencies.
- imp_dep_pkgs :: Set InstalledUnitId,
+ imp_dep_pkgs :: Set UnitId,
-- ^ Packages needed by the module being compiled, whether directly,
-- or via other modules in this package, or via modules imported
-- from other packages.
- imp_trust_pkgs :: Set InstalledUnitId,
+ imp_trust_pkgs :: Set UnitId,
-- ^ This is strictly a subset of imp_dep_pkgs and records the
-- packages the current module needs to trust for Safe Haskell
-- compilation to succeed. A package is required to be trusted if
diff --git a/compiler/GHC/Tc/Types/EvTerm.hs b/compiler/GHC/Tc/Types/EvTerm.hs
index 1352ceca90..063b5652cc 100644
--- a/compiler/GHC/Tc/Types/EvTerm.hs
+++ b/compiler/GHC/Tc/Types/EvTerm.hs
@@ -41,7 +41,7 @@ evCallStack cs = do
m <- getModule
srcLocDataCon <- lookupDataCon srcLocDataConName
let mkSrcLoc l = mkCoreConApps srcLocDataCon <$>
- sequence [ mkStringExprFS (unitIdFS $ moduleUnitId m)
+ sequence [ mkStringExprFS (unitFS $ moduleUnit m)
, mkStringExprFS (moduleNameFS $ moduleName m)
, mkStringExprFS (srcSpanFile l)
, return $ mkIntExprInt platform (srcSpanStartLine l)
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 53d76f7b2a..70e163c0c6 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -10,8 +10,8 @@ module GHC.Tc.Utils.Backpack (
findExtraSigImports,
implicitRequirements',
implicitRequirements,
- checkUnitId,
- tcRnCheckUnitId,
+ checkUnit,
+ tcRnCheckUnit,
tcRnMergeSignatures,
mergeSignatures,
tcRnInstantiateSignature,
@@ -231,17 +231,17 @@ check_inst sig_inst = do
-- | Return this list of requirement interfaces that need to be merged
-- to form @mod_name@, or @[]@ if this is not a requirement.
-requirementMerges :: PackageState -> ModuleName -> [IndefModule]
+requirementMerges :: PackageState -> ModuleName -> [InstantiatedModule]
requirementMerges pkgstate mod_name =
fmap fixupModule $ fromMaybe [] (Map.lookup mod_name (requirementContext pkgstate))
where
- -- update ComponentId cached details as they may have changed since the
- -- time the ComponentId was created
- fixupModule (IndefModule iud name) = IndefModule iud' name
+ -- update IndefUnitId ppr info as they may have changed since the
+ -- time the IndefUnitId was created
+ fixupModule (Module iud name) = Module iud' name
where
- iud' = iud { indefUnitIdComponentId = cid' }
- cid = indefUnitIdComponentId iud
- cid' = updateComponentId pkgstate cid
+ iud' = iud { instUnitInstanceOf = cid' }
+ cid = instUnitInstanceOf iud
+ cid' = updateIndefUnitId pkgstate cid
-- | For a module @modname@ of type 'HscSource', determine the list
-- of extra "imports" of other requirements which should be considered part of
@@ -268,11 +268,11 @@ findExtraSigImports' :: HscEnv
-> ModuleName
-> IO (UniqDSet ModuleName)
findExtraSigImports' hsc_env HsigFile modname =
- fmap unionManyUniqDSets (forM reqs $ \(IndefModule iuid mod_name) ->
+ fmap unionManyUniqDSets (forM reqs $ \(Module iuid mod_name) ->
(initIfaceLoad hsc_env
. withException
$ moduleFreeHolesPrecise (text "findExtraSigImports")
- (mkModule (IndefiniteUnitId iuid) mod_name)))
+ (mkModule (VirtUnit iuid) mod_name)))
where
pkgstate = pkgState (hsc_dflags hsc_env)
reqs = requirementMerges pkgstate modname
@@ -309,37 +309,34 @@ implicitRequirements' hsc_env normal_imports
forM normal_imports $ \(mb_pkg, L _ imp) -> do
found <- findImportedModule hsc_env imp mb_pkg
case found of
- Found _ mod | thisPackage dflags /= moduleUnitId mod ->
+ Found _ mod | thisPackage dflags /= moduleUnit mod ->
return (uniqDSetToList (moduleFreeHoles mod))
_ -> return []
where dflags = hsc_dflags hsc_env
--- | Given a 'UnitId', make sure it is well typed. This is because
+-- | Given a 'Unit', make sure it is well typed. This is because
-- unit IDs come from Cabal, which does not know if things are well-typed or
-- not; a component may have been filled with implementations for the holes
-- that don't actually fulfill the requirements.
---
--- INVARIANT: the UnitId is NOT a InstalledUnitId
-checkUnitId :: UnitId -> TcM ()
-checkUnitId uid = do
- case splitUnitIdInsts uid of
- (_, Just indef) ->
- let insts = indefUnitIdInsts indef in
- forM_ insts $ \(mod_name, mod) ->
- -- NB: direct hole instantiations are well-typed by construction
- -- (because we FORCE things to be merged in), so don't check them
- when (not (isHoleModule mod)) $ do
- checkUnitId (moduleUnitId mod)
- _ <- mod `checkImplements` IndefModule indef mod_name
- return ()
- _ -> return () -- if it's hashed, must be well-typed
+checkUnit :: Unit -> TcM ()
+checkUnit HoleUnit = return ()
+checkUnit (RealUnit _) = return () -- if it's already compiled, must be well-typed
+checkUnit (VirtUnit indef) = do
+ let insts = instUnitInsts indef
+ forM_ insts $ \(mod_name, mod) ->
+ -- NB: direct hole instantiations are well-typed by construction
+ -- (because we FORCE things to be merged in), so don't check them
+ when (not (isHoleModule mod)) $ do
+ checkUnit (moduleUnit mod)
+ _ <- mod `checkImplements` Module indef mod_name
+ return ()
-- | Top-level driver for signature instantiation (run when compiling
-- an @hsig@ file.)
-tcRnCheckUnitId ::
- HscEnv -> UnitId ->
+tcRnCheckUnit ::
+ HscEnv -> Unit ->
IO (Messages, Maybe ())
-tcRnCheckUnitId hsc_env uid =
+tcRnCheckUnit hsc_env uid =
withTiming dflags
(text "Check unit id" <+> ppr uid)
(const ()) $
@@ -348,7 +345,7 @@ tcRnCheckUnitId hsc_env uid =
False
mAIN -- bogus
(realSrcLocSpan (mkRealSrcLoc (fsLit loc_str) 0 0)) -- bogus
- $ checkUnitId uid
+ $ checkUnit uid
where
dflags = hsc_dflags hsc_env
loc_str = "Command line argument: -unit-id " ++ showSDoc dflags (ppr uid)
@@ -486,7 +483,7 @@ inheritedSigPvpWarning =
-- logically "implicit" entities are defined indirectly in an interface
-- file. #13151 gives a proposal to make these *truly* implicit.
-merge_msg :: ModuleName -> [IndefModule] -> SDoc
+merge_msg :: ModuleName -> [InstantiatedModule] -> SDoc
merge_msg mod_name [] =
text "while checking the local signature" <+> ppr mod_name <+>
text "for consistency"
@@ -547,9 +544,9 @@ mergeSignatures
addErrCtxt (merge_msg mod_name reqs) $ do
-- STEP 2: Read in the RAW forms of all of these interfaces
- ireq_ifaces0 <- forM reqs $ \(IndefModule iuid mod_name) ->
- let m = mkModule (IndefiniteUnitId iuid) mod_name
- im = fst (splitModuleInsts m)
+ ireq_ifaces0 <- forM reqs $ \(Module iuid mod_name) ->
+ let m = mkModule (VirtUnit iuid) mod_name
+ im = fst (getModuleInstantiation m)
in fmap fst
. withException
$ findAndReadIface (text "mergeSignatures") im m False
@@ -567,11 +564,11 @@ mergeSignatures
-- 3. Thinning the interface according to an explicit export
-- list.
--
- gen_subst (nsubst,oks,ifaces) (imod@(IndefModule iuid _), ireq_iface) = do
- let insts = indefUnitIdInsts iuid
+ gen_subst (nsubst,oks,ifaces) (imod@(Module iuid _), ireq_iface) = do
+ let insts = instUnitInsts iuid
isFromSignaturePackage =
- let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid))
- pkg = getInstalledPackageDetails pkgstate inst_uid
+ let inst_uid = instUnitInstanceOf iuid
+ pkg = getInstalledPackageDetails pkgstate (indefUnit inst_uid)
in null (unitExposedModules pkg)
-- 3(a). Rename the exports according to how the dependency
-- was instantiated. The resulting export list will be accurate
@@ -732,8 +729,8 @@ mergeSignatures
tcg_env <- getGblEnv
-- STEP 4: Rename the interfaces
- ext_ifaces <- forM thinned_ifaces $ \((IndefModule iuid _), ireq_iface) ->
- tcRnModIface (indefUnitIdInsts iuid) (Just nsubst) ireq_iface
+ ext_ifaces <- forM thinned_ifaces $ \((Module iuid _), ireq_iface) ->
+ tcRnModIface (instUnitInsts iuid) (Just nsubst) ireq_iface
lcl_iface <- tcRnModIface (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0
let ifaces = lcl_iface : ext_ifaces
@@ -899,8 +896,8 @@ tcRnInstantiateSignature hsc_env this_mod real_loc =
exportOccs :: [AvailInfo] -> [OccName]
exportOccs = concatMap (map occName . availNames)
-impl_msg :: Module -> IndefModule -> SDoc
-impl_msg impl_mod (IndefModule req_uid req_mod_name) =
+impl_msg :: Module -> InstantiatedModule -> SDoc
+impl_msg impl_mod (Module req_uid req_mod_name) =
text "while checking that" <+> ppr impl_mod <+>
text "implements signature" <+> ppr req_mod_name <+>
text "in" <+> ppr req_uid
@@ -908,10 +905,10 @@ impl_msg impl_mod (IndefModule req_uid req_mod_name) =
-- | Check if module implements a signature. (The signature is
-- always un-hashed, which is why its components are specified
-- explicitly.)
-checkImplements :: Module -> IndefModule -> TcRn TcGblEnv
-checkImplements impl_mod req_mod@(IndefModule uid mod_name) =
+checkImplements :: Module -> InstantiatedModule -> TcRn TcGblEnv
+checkImplements impl_mod req_mod@(Module uid mod_name) =
addErrCtxt (impl_msg impl_mod req_mod) $ do
- let insts = indefUnitIdInsts uid
+ let insts = instUnitInsts uid
-- STEP 1: Load the implementing interface, and make a RdrEnv
-- for its exports. Also, add its 'ImportAvails' to 'tcg_imports',
@@ -954,8 +951,8 @@ checkImplements impl_mod req_mod@(IndefModule uid mod_name) =
-- the ORIGINAL signature. We are going to eventually rename it,
-- but we must proceed slowly, because it is NOT known if the
-- instantiation is correct.
- let sig_mod = mkModule (IndefiniteUnitId uid) mod_name
- isig_mod = fst (splitModuleInsts sig_mod)
+ let sig_mod = mkModule (VirtUnit uid) mod_name
+ isig_mod = fst (getModuleInstantiation sig_mod)
mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod sig_mod False
isig_iface <- case mb_isig_iface of
Succeeded (iface, _) -> return iface
@@ -1003,9 +1000,9 @@ instantiateSignature = do
-- TODO: setup the local RdrEnv so the error messages look a little better.
-- But this information isn't stored anywhere. Should we RETYPECHECK
-- the local one just to get the information? Hmm...
- MASSERT( moduleUnitId outer_mod == thisPackage dflags )
+ MASSERT( moduleUnit outer_mod == thisPackage dflags )
inner_mod `checkImplements`
- IndefModule
- (newIndefUnitId (thisComponentId dflags)
- (thisUnitIdInsts dflags))
+ Module
+ (mkInstantiatedUnit (thisComponentId dflags)
+ (thisUnitIdInsts dflags))
(moduleName outer_mod)
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index d1a92298db..4658b63f00 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -1022,7 +1022,7 @@ mkWrapperName what nameBase
thisMod <- getModule
let -- Note [Generating fresh names for ccall wrapper]
wrapperRef = nextWrapperNum dflags
- pkg = unitIdString (moduleUnitId thisMod)
+ pkg = unitString (moduleUnit thisMod)
mod = moduleNameString (moduleName thisMod)
wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \mod_env ->
let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 60714e4cc1..5d753e7b23 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -264,7 +264,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_rdr_env = emptyGlobalRdrEnv,
tcg_fix_env = emptyNameEnv,
tcg_field_env = emptyNameEnv,
- tcg_default = if moduleUnitId mod == primUnitId
+ tcg_default = if moduleUnit mod == primUnitId
then Just [] -- See Note [Default types]
else Nothing,
tcg_type_env = emptyNameEnv,
@@ -1841,7 +1841,7 @@ initIfaceTcRn thing_inside
; let !mod = tcg_semantic_mod tcg_env
-- When we are instantiating a signature, we DEFINITELY
-- do not want to knot tie.
- is_instantiate = unitIdIsDefinite (thisPackage dflags) &&
+ is_instantiate = unitIsDefinite (thisPackage dflags) &&
not (null (thisUnitIdInsts dflags))
; let { if_env = IfGblEnv {
if_doc = text "initIfaceTcRn",
View Lorry Controller Status