Commit 66579ff9 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Add ASSERTs to all calls of nameModule

nameModule fails on an InternalName.  These ASSERTS tell you
which call failed.
parent 766b34f8
......@@ -800,7 +800,7 @@ dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++
fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
where name = dataConName dc
mod = nameModule name
mod = ASSERT( isExternalName name ) nameModule name
\end{code}
\begin{code}
......
......@@ -143,7 +143,8 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName
setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
setRdrNameSpace (Exact n) ns = Orig (nameModule n)
setRdrNameSpace (Exact n) ns = ASSERT( isExternalName n )
Orig (nameModule n)
(setOccNameSpace ns (nameOccName n))
\end{code}
......@@ -163,7 +164,8 @@ mkOrig mod occ = Orig mod occ
-- is derived from that of it's parent using the supplied function
mkDerivedRdrName :: Name -> (OccName -> OccName) -> RdrName
mkDerivedRdrName parent mk_occ
= mkOrig (nameModule parent) (mk_occ (nameOccName parent))
= ASSERT2( isExternalName parent, ppr parent )
mkOrig (nameModule parent) (mk_occ (nameOccName parent))
---------------
-- These two are used when parsing source files
......@@ -556,7 +558,7 @@ hideSomeUnquals rdr_env occs
qual_gre gre@(GRE { gre_name = name, gre_prov = LocalDef })
= gre { gre_prov = Imported [imp_spec] }
where -- Local defs get transfomed to (fake) imported things
mod = moduleName (nameModule name)
mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name)
imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod,
is_qual = True,
......
......@@ -28,6 +28,8 @@ module DsMeta( dsBracket,
quoteExpName, quotePatName
) where
#include "HsVersions.h"
import {-# SOURCE #-} DsExpr ( dsExpr )
import MatchLit
......@@ -949,7 +951,7 @@ globalVar name
; MkC uni <- coreIntLit (getKey (getUnique name))
; rep2 mkNameLName [occ,uni] }
where
mod = nameModule name
mod = ASSERT( isExternalName name) nameModule name
name_mod = moduleNameString (moduleName mod)
name_pkg = packageIdString (modulePackageId mod)
name_occ = nameOccName name
......
......@@ -265,7 +265,7 @@ nameToCLabel n suffix
else qual_name
where
pkgid = modulePackageId mod
mod = nameModule n
mod = ASSERT( isExternalName n ) nameModule n
package_part = unpackFS (zEncodeFS (packageIdFS (modulePackageId mod)))
module_part = unpackFS (zEncodeFS (moduleNameFS (moduleName mod)))
occ_part = unpackFS (zEncodeFS (occNameFS (nameOccName n)))
......
......@@ -1088,7 +1088,8 @@ checkModule m = do
case GHC.moduleInfo r of
cm | Just scope <- GHC.modInfoTopLevelScope cm ->
let
(local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
(local,global) = ASSERT( all isExternalName scope )
partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
in
(text "global names: " <+> ppr global) $$
(text "local names: " <+> ppr local)
......@@ -1275,7 +1276,8 @@ browseModule bang modl exports_only = do
-- We would like to improve this; see #1799.
sorted_names = loc_sort local ++ occ_sort external
where
(local,external) = partition ((==modl) . nameModule) names
(local,external) = ASSERT( all isExternalName names )
partition ((==modl) . nameModule) names
occ_sort = sortBy (compare `on` nameOccName)
-- try to sort by src location. If the first name in
-- our list has a good source location, then they all should.
......@@ -1896,7 +1898,7 @@ wantNameFromInterpretedModule noCanDo str and_then =
case names of
[] -> return ()
(n:_) -> do
let modl = GHC.nameModule n
let modl = ASSERT( isExternalName n ) GHC.nameModule n
if not (GHC.isExternalName n)
then noCanDo n $ ppr n <>
text " is not defined in an interpreted module"
......@@ -2068,7 +2070,8 @@ breakSwitch (arg1:rest)
wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
then findBreakAndSet (GHC.nameModule name) $
then ASSERT( isExternalName name )
findBreakAndSet (GHC.nameModule name) $
findBreakByCoord (Just (GHC.srcLocFile loc))
(GHC.srcLocLine loc,
GHC.srcLocCol loc)
......@@ -2215,7 +2218,8 @@ list2 [arg] = do
let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
then do
tickArray <- getTickArray (GHC.nameModule name)
tickArray <- ASSERT( isExternalName name )
getTickArray (GHC.nameModule name)
let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
(GHC.srcLocLine loc, GHC.srcLocCol loc)
tickArray
......
......@@ -263,7 +263,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName bh name _ = do
let mod = nameModule name
let mod = ASSERT2( isExternalName name, ppr name ) nameModule name
put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
......
......@@ -212,7 +212,8 @@ lookupOrigNameCache nc mod occ -- The normal case
extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
extendOrigNameCache nc name
= extendNameCache nc (nameModule name) (nameOccName name) name
= ASSERT2( isExternalName name, ppr name )
extendNameCache nc (nameModule name) (nameOccName name) name
extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache nc mod occ name
......
......@@ -120,7 +120,8 @@ loadInterfaceForName doc name
{ this_mod <- getModule
; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
}
; initIfaceTcRn $ loadSysInterface doc (nameModule name)
; ASSERT2( isExternalName name, ppr name )
initIfaceTcRn $ loadSysInterface doc (nameModule name)
}
-- | An 'IfM' function to load the home interface for a wired-in thing,
......
......@@ -370,7 +370,7 @@ mkHashFun
mkHashFun hsc_env eps
= \name ->
let
mod = nameModule name
mod = ASSERT2( isExternalName name, ppr name ) nameModule name
occ = nameOccName name
iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
pprPanic "lookupVers2" (ppr mod <+> ppr occ)
......@@ -411,8 +411,9 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
, let out = localOccs $ freeNamesDeclABI abi
]
name_module n = ASSERT( isExternalName n ) nameModule n
localOccs = map (getUnique . getParent . getOccName)
. filter ((== this_mod) . nameModule)
. filter ((== this_mod) . name_module)
. nameSetToList
where getParent occ = lookupOccEnv parent_map occ `orElse` occ
......@@ -442,7 +443,8 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
| isWiredInName name = putNameLiterally bh name
-- wired-in names don't have fingerprints
| otherwise
= let hash | nameModule name /= this_mod = global_hash_fn name
= ASSERT( isExternalName name )
let hash | nameModule name /= this_mod = global_hash_fn name
| otherwise =
snd (lookupOccEnv local_env (getOccName name)
`orElse` pprPanic "urk! lookup local fingerprint"
......@@ -698,9 +700,9 @@ lookupOccEnvL env k = lookupOccEnv env k `orElse` []
-- used when we want to fingerprint a structure without depending on the
-- fingerprints of external Names that it refers to.
putNameLiterally :: BinHandle -> Name -> IO ()
putNameLiterally bh name = do
put_ bh $! nameModule name
put_ bh $! nameOccName name
putNameLiterally bh name = ASSERT( isExternalName name )
do { put_ bh $! nameModule name
; put_ bh $! nameOccName name }
computeFingerprint :: Binary a
=> DynFlags
......@@ -927,10 +929,12 @@ mkIfaceExports exports
-- else the plusFM will simply discard one! They
-- should have been combined by now.
add env (Avail n)
= add_one env (nameModule n) (Avail (nameOccName n))
= ASSERT( isExternalName n )
add_one env (nameModule n) (Avail (nameOccName n))
add env (AvailTC tc ns)
= foldl add_for_mod env mods
= ASSERT( all isExternalName ns )
foldl add_for_mod env mods
where
tc_occ = nameOccName tc
mods = nub (map nameModule ns)
......@@ -1368,7 +1372,7 @@ instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
do_rough (Just n) = Just (toIfaceTyCon_name n)
dfun_name = idName dfun_id
mod = nameModule dfun_name
mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
is_local name = nameIsLocalOrFrom mod name
-- Compute orphanhood. See Note [Orphans] in IfaceSyn
......
......@@ -127,7 +127,8 @@ checkWiredInTyCon tc
= return ()
| otherwise
= do { mod <- getModule
; unless (mod == nameModule tc_name)
; ASSERT( isExternalName tc_name )
unless (mod == nameModule tc_name)
(initIfaceTcRn (loadWiredInHomeIface tc_name))
-- Don't look for (non-existent) Float.hi when
-- compiling Float.lhs, which mentions Float of course
......@@ -144,7 +145,8 @@ importDecl name
do { traceIf nd_doc
-- Load the interface, which should populate the PTE
; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
; mb_iface <- ASSERT2( isExternalName name, ppr name )
loadInterface nd_doc (nameModule name) ImportBySystem
; case mb_iface of {
Failed err_msg -> return (Failed err_msg) ;
Succeeded _ -> do
......@@ -1047,7 +1049,8 @@ ifCheckWiredInThing name
-- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
-- the HPT, so without the test we'll demand-load it into the PIT!
-- C.f. the same test in checkWiredInTyCon above
; unless (mod == nameModule name)
; ASSERT2( isExternalName name, ppr name )
unless (mod == nameModule name)
(loadWiredInHomeIface name) }
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
......
......@@ -105,7 +105,7 @@ import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
import RdrName
import Name ( Name, NamedThing, getName, nameOccName, nameModule )
import Name
import NameEnv
import NameSet
import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv,
......@@ -1160,7 +1160,7 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
| otherwise = panic "mkPrintUnqualified"
where
right_name gre = nameModule (gre_name gre) == mod
right_name gre = nameModule_maybe (gre_name gre) == Just mod
unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
qual_gres = filter right_name (lookupGlobalRdrEnv env occ)
......@@ -1330,7 +1330,7 @@ lookupType dflags hpt pte name
lookupNameEnv (md_types (hm_details hm)) name
| otherwise
= lookupNameEnv pte name
where mod = nameModule name
where mod = ASSERT( isExternalName name ) nameModule name
this_pkg = thisPackage dflags
-- | As 'lookupType', but with a marginally easier-to-use interface
......
......@@ -56,6 +56,8 @@ module TysWiredIn (
parrTyCon_RDR, parrTyConName
) where
#include "HsVersions.h"
import {-# SOURCE #-} MkId( mkDataConIds )
-- friends:
......@@ -66,8 +68,7 @@ import TysPrim
import Constants ( mAX_TUPLE_SIZE )
import Module ( Module )
import RdrName
import Name ( Name, BuiltInSyntax(..), nameUnique, nameOccName,
nameModule, mkWiredInName )
import Name
import OccName ( mkTcOccFS, mkDataOccFS, mkTupleOcc, mkDataConWorkerOcc,
tcName, dataName )
import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
......@@ -254,7 +255,8 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
(mkDataConIds bogus_wrap_name wrk_name data_con)
modu = nameModule dc_name
modu = ASSERT( isExternalName dc_name )
nameModule dc_name
wrk_occ = mkDataConWorkerOcc (nameOccName dc_name)
wrk_key = incrUnique (nameUnique dc_name)
wrk_name = mkWiredInName modu wrk_occ wrk_key
......
......@@ -1006,7 +1006,7 @@ finishWarnings dflags mod_warn tcg_env
(parens imp_msg) <> colon,
(ppr deprec_txt) ])
where
name_mod = nameModule name
name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
imp_mod = importSpecModule imp_spec
imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra
extra | imp_mod == moduleName name_mod = empty
......@@ -1024,7 +1024,7 @@ lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable
-> GlobalRdrElt -> Maybe WarningTxt
-- The name is definitely imported, so look in HPT, PIT
lookupImpDeprec dflags hpt pit gre
= case lookupIfaceByModule dflags hpt pit (nameModule name) of
= case lookupIfaceByModule dflags hpt pit mod of
Just iface -> mi_warn_fn iface name `mplus` -- Bleat if the thing, *or
case gre_par gre of
ParentIs p -> mi_warn_fn iface p -- its parent*, is warn'd
......@@ -1032,7 +1032,8 @@ lookupImpDeprec dflags hpt pit gre
Nothing -> Nothing -- See Note [Used names with interface not loaded]
where
name = gre_name gre
name = gre_name gre
mod = ASSERT2( isExternalName name, ppr name ) nameModule name
\end{code}
Note [Used names with interface not loaded]
......@@ -1343,7 +1344,7 @@ printMinimalImports imps
where
all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
doc = text "Compute minimal imports from" <+> ppr n
n_mod = nameModule n
n_mod = ASSERT( isExternalName n ) nameModule n
\end{code}
......
......@@ -859,7 +859,8 @@ record_dfun_usage :: Id -> TcRn ()
record_dfun_usage dfun_id
= do { hsc_env <- getTopEnv
; let dfun_name = idName dfun_id
dfun_mod = nameModule dfun_name
dfun_mod = ASSERT( isExternalName dfun_name )
nameModule dfun_name
; if isInternalName dfun_name || -- Internal name => defined in this module
modulePackageId dfun_mod /= thisPackage (hsc_dflags hsc_env)
then return () -- internal, or in another package
......
......@@ -940,7 +940,7 @@ reifyName thing
-- have free variables, we may need to generate NameL's for them.
where
name = getName thing
mod = nameModule name
mod = ASSERT( isExternalName name ) nameModule name
pkg_str = packageIdString (modulePackageId mod)
mod_str = moduleNameString (moduleName mod)
occ_str = occNameString occ
......
......@@ -398,7 +398,7 @@ mkGenericNames tycon
where
tc_name = tyConName tycon
tc_occ = nameOccName tc_name
tc_mod = nameModule tc_name
tc_mod = ASSERT( isExternalName tc_name ) nameModule tc_name
from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ)
to_RDR = mkOrig tc_mod (mkGenOcc2 tc_occ)
\end{code}
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment