Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
66579ff9
Commit
66579ff9
authored
Oct 03, 2008
by
simonpj@microsoft.com
Browse files
Add ASSERTs to all calls of nameModule
nameModule fails on an InternalName. These ASSERTS tell you which call failed.
parent
766b34f8
Changes
16
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/DataCon.lhs
View file @
66579ff9
...
...
@@ -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}
...
...
compiler/basicTypes/RdrName.lhs
View file @
66579ff9
...
...
@@ -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,
...
...
compiler/deSugar/DsMeta.hs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/ghci/ByteCodeLink.lhs
View file @
66579ff9
...
...
@@ -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)))
...
...
compiler/ghci/InteractiveUI.hs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/iface/BinIface.hs
View file @
66579ff9
...
...
@@ -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
)
...
...
compiler/iface/IfaceEnv.lhs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/iface/LoadIface.lhs
View file @
66579ff9
...
...
@@ -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,
...
...
compiler/iface/MkIface.lhs
View file @
66579ff9
...
...
@@ -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) . name
M
odule)
. filter ((== this_mod) . name
_m
odule)
. 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
...
...
compiler/iface/TcIface.lhs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/main/HscTypes.lhs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/prelude/TysWiredIn.lhs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/rename/RnNames.lhs
View file @
66579ff9
...
...
@@ -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}
...
...
compiler/typecheck/Inst.lhs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/typecheck/TcSplice.lhs
View file @
66579ff9
...
...
@@ -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
...
...
compiler/types/Generics.lhs
View file @
66579ff9
...
...
@@ -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}
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment