let sorted_deps = sortDependencies (mi_deps iface0)
-- the export hash of a module depends on the orphan hashes of the
- -- orphan modules below us in the dependeny tree. This is the way
+ -- orphan modules below us in the dependency tree. This is the way
-- that changes in orphans get propagated all the way up the
-- dependency tree. We only care about orphan modules in the current
-- package, because changes to orphans outside this package will be
-- Group by module and sort by occurrence
mkIfaceExports exports
= [ (mod, eltsFM avails)
- | (mod, avails) <- sortBy (stableModuleCmp `on` fst) (fmToList groupFM)
+ | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
+ (moduleEnvToList groupFM)
-- NB. the fmToList is in a random order,
-- because Ord Module is not a predictable
-- ordering. Hence we perform a final sort
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]
orph | is_local cls_name = Just (nameOccName cls_name)
- | all isJust mb_ns = head mb_ns
+ | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
| otherwise = Nothing
mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
--------------------------
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails VanillaId = IfVanillaId
-toIfaceIdDetails DFunId = IfVanillaId
+toIfaceIdDetails (DFunId {}) = IfDFunId
toIfaceIdDetails (RecSelId { sel_naughty = n
, sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
toIfaceIdInfo id_info
= catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
- inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
+ inline_hsinfo, unfold_hsinfo]
where
------------ Arity --------------
arity_info = arityInfo id_info
Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
_other -> Nothing
- ------------ Worker --------------
- work_info = workerInfo id_info
- has_worker = workerExists work_info
- wrkr_hsinfo = case work_info of
- HasWorker work_id wrap_arity ->
- Just (HsWorker ((idName work_id)) wrap_arity)
- NoWorker -> Nothing
-
------------ Unfolding --------------
- -- The unfolding is redundant if there is a worker
- unfold_info = unfoldingInfo id_info
- rhs = unfoldingTemplate unfold_info
- no_unfolding = neverUnfold unfold_info
- -- The CoreTidy phase retains unfolding info iff
- -- we want to expose the unfolding, taking into account
- -- unconditional NOINLINE, etc. See TidyPgm.addExternal
- unfold_hsinfo | no_unfolding = Nothing
- | has_worker = Nothing -- Unfolding is implicit
- | otherwise = Just (HsUnfold (toIfaceExpr rhs))
+ unfold_hsinfo = toIfUnfolding (unfoldingInfo id_info)
------------ Inline prag --------------
inline_prag = inlinePragInfo id_info
inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
- | no_unfolding && not has_worker
- && isFunLike (inlinePragmaRuleMatchInfo inline_prag)
- = Nothing
- -- If the iface file give no unfolding info, we
- -- don't need to say when inlining is OK!
- | otherwise = Just (HsInline inline_prag)
+ | otherwise = Just (HsInline inline_prag)
+
+--------------------------
+toIfUnfolding :: Unfolding -> Maybe IfaceInfoItem
+toIfUnfolding (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity, uf_guidance = guidance })
+ = case guidance of
+ InlineRule { ug_ir_info = InlSat } -> Just (HsUnfold (IfInlineRule arity True (toIfaceExpr rhs)))
+ InlineRule { ug_ir_info = InlUnSat } -> Just (HsUnfold (IfInlineRule arity False (toIfaceExpr rhs)))
+ InlineRule { ug_ir_info = InlWrapper w } -> Just (HsUnfold (IfWrapper arity (idName w)))
+ UnfoldNever -> Nothing
+ UnfoldIfGoodArgs {} -> Just (HsUnfold (IfCoreUnfold (toIfaceExpr rhs)))
+ UnfoldAlways -> panic "toIfUnfolding:UnfoldAlways"
+ -- Never happens because we never have
+ -- bindings for unfold-always things
+toIfUnfolding (DFunUnfolding _con ops)
+ = Just (HsUnfold (IfDFunUnfold (map toIfaceExpr ops)))
+ -- No need to serialise the data constructor;
+ -- we can recover it from the type of the dfun
+toIfUnfolding _
+ = Nothing
--------------------------
coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
---------------------
toIfaceNote :: Note -> IfaceNote
toIfaceNote (SCC cc) = IfaceSCC cc
-toIfaceNote InlineMe = IfaceInlineMe
toIfaceNote (CoreNote s) = IfaceCoreNote s
---------------------