tcg_hpc = other_hpc_info
}
= do
- used_names <- mkUsedNames tc_result
+ let used_names = mkUsedNames tc_result
deps <- mkDependencies tc_result
let hpc_info = emptyHpcInfo other_hpc_info
mkIface_ hsc_env maybe_old_fingerprint
fix_env warns hpc_info (imp_mods imports) mod_details
-mkUsedNames :: TcGblEnv -> IO NameSet
-mkUsedNames
- TcGblEnv{ tcg_inst_uses = dfun_uses_var,
- tcg_dus = dus
- }
- = do { dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
- ; return (allUses dus `unionNameSets` dfun_uses) }
+mkUsedNames :: TcGblEnv -> NameSet
+mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
- (map IfaceInstABI orph_insts, orph_rules, fam_insts)
+ (map ifDFun orph_insts, orph_rules, fam_insts)
-- the export list hash doesn't depend on the fingerprints of
-- the Names it mentions, only the Names themselves, hence putNameLiterally.
Items (c)-(f) are not stored in the IfaceDecl, but instead appear
elsewhere in the interface file. But they are *fingerprinted* with
-the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
-and fingerprinting that as part of the Id.
+the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
+and fingerprinting that as part of the declaration.
\begin{code}
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
freeNamesDeclExtras (IfaceIdExtras _ rules)
= unionManyNameSets (map freeNamesIfRule rules)
-freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
- = unionManyNameSets (map freeNamesSub subs)
-freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
- = unionManyNameSets (map freeNamesSub subs)
+freeNamesDeclExtras (IfaceDataExtras _ insts subs)
+ = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
+freeNamesDeclExtras (IfaceClassExtras _ insts subs)
+ = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
freeNamesDeclExtras (IfaceSynExtras _)
= emptyNameSet
freeNamesDeclExtras IfaceOtherDeclExtras
(lookupOccEnvL rule_env n)
IfaceData{ifCons=cons} ->
IfaceDataExtras (fix_fn n)
- (map IfaceInstABI $ lookupOccEnvL inst_env n)
+ (map ifDFun $ lookupOccEnvL inst_env n)
(map (id_extras . ifConOcc) (visibleIfConDecls cons))
IfaceClass{ifSigs=sigs} ->
IfaceClassExtras (fix_fn n)
- (map IfaceInstABI $ lookupOccEnvL inst_env n)
+ (map ifDFun $ lookupOccEnvL inst_env n)
[id_extras op | IfaceClassOp op _ _ <- sigs]
IfaceSyn{} -> IfaceSynExtras (fix_fn n)
_other -> IfaceOtherDeclExtras
id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
--
--- When hashing an instance, we hash only its structure, not the
--- fingerprints of the things it mentions. See the section on instances
--- in the commentary,
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
+-- When hashing an instance, we hash only the DFunId, because that
+-- depends on all the information about the instance.
--
-newtype IfaceInstABI = IfaceInstABI IfaceInst
-
-instance Binary IfaceInstABI where
- get = panic "no get for IfaceInstABI"
- put_ bh (IfaceInstABI inst) = do
- let ud = getUserData bh
- bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
- put_ bh' inst
+type IfaceInstABI = IfExtName
lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
lookupOccEnvL env k = lookupOccEnv env k `orElse` []
(sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
op_ty = funResultTy rho_ty
- toDmSpec NoDefMeth = NoDM
- toDmSpec GenDefMeth = GenericDM
- toDmSpec (DefMeth _) = VanillaDM
+ toDmSpec NoDefMeth = NoDM
+ toDmSpec (GenDefMeth _) = GenericDM
+ toDmSpec (DefMeth _) = VanillaDM
toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
is_local name = nameIsLocalOrFrom mod name
-- Compute orphanhood. See Note [Orphans] in IfaceSyn
- (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
+ (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
-- Slightly awkward: we need the Class to get the fundeps
(tvs, fds) = classTvsFds cls
- arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
+ arg_names = [filterNameSet is_local (orphNamesOfType ty) | ty <- tys]
orph | is_local cls_name = Just (nameOccName cls_name)
| all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
| otherwise = Nothing
--------------------------
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails VanillaId = IfVanillaId
-toIfaceIdDetails (DFunId {}) = IfDFunId
+toIfaceIdDetails (DFunId ns _) = IfDFunId ns
toIfaceIdDetails (RecSelId { sel_naughty = n
, sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
if_rhs = toIfaceExpr rhs
toIfUnfolding lb (DFunUnfolding _ar _con ops)
- = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
+ = Just (HsUnfold lb (IfDFunUnfold (map (fmap toIfaceExpr) ops)))
-- No need to serialise the data constructor;
-- we can recover it from the type of the dfun
= pprTrace "toHsRule: builtin" (ppr fn) $
bogusIfaceRule fn
-coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
- ru_act = act, ru_bndrs = bndrs,
- ru_args = args, ru_rhs = rhs,
- ru_auto = auto })
+coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn,
+ ru_act = act, ru_bndrs = bndrs,
+ ru_args = args, ru_rhs = rhs,
+ ru_auto = auto })
= IfaceRule { ifRuleName = name, ifActivation = act,
ifRuleBndrs = map toIfaceBndr bndrs,
ifRuleHead = fn,
-- Compute orphanhood. See Note [Orphans] in IfaceSyn
-- A rule is an orphan only if none of the variables
-- mentioned on its left-hand side are locally defined
- lhs_names = fn : nameSetToList (exprsFreeNames args)
- -- No need to delete bndrs, because
- -- exprsFreeNames finds only External names
+ lhs_names = nameSetToList (ruleLhsOrphNames rule)
orph = case filter (nameIsLocalOrFrom mod) lhs_names of
(n : _) -> Just (nameOccName n)
projects / ghc-hetmet.git / blobdiff