projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove dead code
[ghc-hetmet.git]
/
compiler
/
iface
/
MkIface.lhs
diff --git
a/compiler/iface/MkIface.lhs
b/compiler/iface/MkIface.lhs
index
1346a9a
..
7edf0a6
100644
(file)
--- a/
compiler/iface/MkIface.lhs
+++ b/
compiler/iface/MkIface.lhs
@@
-370,7
+370,7
@@
mkHashFun
mkHashFun hsc_env eps
= \name ->
let
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)
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
]
, let out = localOccs $ freeNamesDeclABI abi
]
+ name_module n = ASSERT( isExternalName n ) nameModule n
localOccs = map (getUnique . getParent . getOccName)
localOccs = map (getUnique . getParent . getOccName)
- . filter ((== this_mod) . nameModule)
+ . filter ((== this_mod) . name_module)
. nameSetToList
where getParent occ = lookupOccEnv parent_map occ `orElse` occ
. 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
| 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"
| 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 ()
-- 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
computeFingerprint :: Binary a
=> DynFlags
@@
-818,7
+820,10
@@
mk_usage_info pit hsc_env this_mod direct_imports used_names
| otherwise
= case nameModule_maybe name of
Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
| otherwise
= case nameModule_maybe name of
Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
- Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
+ Just mod -> -- We use this fiddly lambda function rather than
+ -- (++) as the argument to extendModuleEnv_C to
+ -- avoid quadratic behaviour (trac #2680)
+ extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
where occ = nameOccName name
-- We want to create a Usage for a home module if
where occ = nameOccName name
-- We want to create a Usage for a home module if
@@
-927,10
+932,12
@@
mkIfaceExports exports
-- else the plusFM will simply discard one! They
-- should have been combined by now.
add env (Avail n)
-- 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)
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)
where
tc_occ = nameOccName tc
mods = nub (map nameModule ns)
@@
-1368,7
+1375,7
@@
instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
do_rough (Just n) = Just (toIfaceTyCon_name n)
dfun_name = idName dfun_id
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
is_local name = nameIsLocalOrFrom mod name
-- Compute orphanhood. See Note [Orphans] in IfaceSyn