+ -- Stripped-down version of tcIfaceIdInfo
+ -- Change this if you want to export more IdInfo for
+ -- non-top-level Ids. Don't forget to change
+ -- CoreTidy.tidyLetBndr too!
+ --
+ -- See Note [IdInfo on nested let-bindings] in IfaceSyn
+ id_info = idInfo id
+ inline_prag = inlinePragInfo id_info
+ prag_info | isAlwaysActive inline_prag = NoInfo
+ | otherwise = HasInfo [HsInline inline_prag]
+
+--------------------------
+toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
+toIfaceIdInfo id_info
+ = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
+ inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
+ where
+ ------------ Arity --------------
+ arity_info = arityInfo id_info
+ arity_hsinfo | arity_info == 0 = Nothing
+ | otherwise = Just (HsArity arity_info)
+
+ ------------ Caf Info --------------
+ caf_info = cafInfo id_info
+ caf_hsinfo = case caf_info of
+ NoCafRefs -> Just HsNoCafRefs
+ _other -> Nothing
+
+ ------------ Strictness --------------
+ -- No point in explicitly exporting TopSig
+ strict_hsinfo = case newStrictnessInfo id_info of
+ 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))
+
+ ------------ Inline prag --------------
+ inline_prag = inlinePragInfo id_info
+ inline_hsinfo | isAlwaysActive inline_prag = Nothing
+ | no_unfolding && not has_worker = Nothing
+ -- If the iface file give no unfolding info, we
+ -- don't need to say when inlining is OK!
+ | otherwise = Just (HsInline inline_prag)
+
+--------------------------
+coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
+coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
+ = 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 })
+ = IfaceRule { ifRuleName = name, ifActivation = act,
+ ifRuleBndrs = map toIfaceBndr bndrs,
+ ifRuleHead = fn,
+ ifRuleArgs = map do_arg args,
+ ifRuleRhs = toIfaceExpr rhs,
+ ifRuleOrph = orph }
+ where
+ -- For type args we must remove synonyms from the outermost
+ -- level. Reason: so that when we read it back in we'll
+ -- construct the same ru_rough field as we have right now;
+ -- see tcIfaceRule
+ do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
+ do_arg arg = toIfaceExpr arg
+
+ -- 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
+
+ orph = case filter (nameIsLocalOrFrom mod) lhs_names of
+ (n : _) -> Just (nameOccName n)
+ [] -> Nothing
+
+bogusIfaceRule :: Name -> IfaceRule
+bogusIfaceRule id_name
+ = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
+ ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
+ ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
+
+---------------------
+toIfaceExpr :: CoreExpr -> IfaceExpr
+toIfaceExpr (Var v) = toIfaceVar v
+toIfaceExpr (Lit l) = IfaceLit l
+toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
+toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
+toIfaceExpr (App f a) = toIfaceApp f [a]
+toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
+toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
+toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
+toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
+
+---------------------
+toIfaceNote :: Note -> IfaceNote
+toIfaceNote (SCC cc) = IfaceSCC cc
+toIfaceNote InlineMe = IfaceInlineMe
+toIfaceNote (CoreNote s) = IfaceCoreNote s
+
+---------------------
+toIfaceBind :: Bind Id -> IfaceBinding
+toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
+toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
+
+---------------------
+toIfaceAlt :: (AltCon, [Var], CoreExpr)
+ -> (IfaceConAlt, [FastString], IfaceExpr)
+toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
+
+---------------------
+toIfaceCon :: AltCon -> IfaceConAlt
+toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
+ | otherwise = IfaceDataAlt (getName dc)
+ where
+ tc = dataConTyCon dc
+
+toIfaceCon (LitAlt l) = IfaceLitAlt l
+toIfaceCon DEFAULT = IfaceDefault