+ toIfaceClassOp (sel_id, def_meth)
+ = ASSERT(sel_tyvars == clas_tyvars)
+ IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
+ where
+ -- Be careful when splitting the type, because of things
+ -- like class Foo a where
+ -- op :: (?x :: String) => a -> a
+ -- and class Baz a where
+ -- op :: (Ord a) => a -> a
+ (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
+ op_ty = funResultTy rho_ty
+
+ toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
+
+tyThingToIfaceDecl (ATyCon tycon)
+ | isSynTyCon tycon
+ = IfaceSyn { ifName = getOccName tycon,
+ ifTyVars = toIfaceTvBndrs tyvars,
+ ifOpenSyn = syn_isOpen,
+ ifSynRhs = toIfaceType syn_tyki }
+
+ | isAlgTyCon tycon
+ = IfaceData { ifName = getOccName tycon,
+ ifTyVars = toIfaceTvBndrs tyvars,
+ ifCtxt = toIfaceContext (tyConStupidTheta tycon),
+ ifCons = ifaceConDecls (algTyConRhs tycon),
+ ifRec = boolToRecFlag (isRecursiveTyCon tycon),
+ ifGadtSyntax = isGadtSyntaxTyCon tycon,
+ ifGeneric = tyConHasGenerics tycon,
+ ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
+
+ | isForeignTyCon tycon
+ = IfaceForeign { ifName = getOccName tycon,
+ ifExtName = tyConExtName tycon }
+
+ | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
+ where
+ tyvars = tyConTyVars tycon
+ (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
+ OpenSynTyCon ki -> (True , ki)
+ SynonymTyCon ty -> (False, ty)
+
+ ifaceConDecls (NewTyCon { data_con = con }) =
+ IfNewTyCon (ifaceConDecl con)
+ ifaceConDecls (DataTyCon { data_cons = cons }) =
+ IfDataTyCon (map ifaceConDecl cons)
+ ifaceConDecls OpenDataTyCon = IfOpenDataTyCon
+ ifaceConDecls OpenNewTyCon = IfOpenNewTyCon
+ ifaceConDecls AbstractTyCon = IfAbstractTyCon
+ -- The last case happens when a TyCon has been trimmed during tidying
+ -- Furthermore, tyThingToIfaceDecl is also used
+ -- in TcRnDriver for GHCi, when browsing a module, in which case the
+ -- AbstractTyCon case is perfectly sensible.
+
+ ifaceConDecl data_con
+ = IfCon { ifConOcc = getOccName (dataConName data_con),
+ ifConInfix = dataConIsInfix data_con,
+ ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
+ ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
+ ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
+ ifConCtxt = toIfaceContext (dataConTheta data_con),
+ ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
+ ifConFields = map getOccName
+ (dataConFieldLabels data_con),
+ ifConStricts = dataConStrictMarks data_con }
+
+ to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
+
+ famInstToIface Nothing = Nothing
+ famInstToIface (Just (famTyCon, instTys)) =
+ Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
+
+tyThingToIfaceDecl (ADataCon dc)
+ = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
+
+
+getFS x = occNameFS (getOccName x)
+
+--------------------------
+instanceToIfaceInst :: Instance -> IfaceInst
+instanceToIfaceInst ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
+ is_cls = cls, is_tcs = mb_tcs,
+ is_orph = orph })
+ = IfaceInst { ifDFun = getName dfun_id,
+ ifOFlag = oflag,
+ ifInstCls = cls,
+ ifInstTys = map do_rough mb_tcs,
+ ifInstOrph = orph }
+ where
+ do_rough Nothing = Nothing
+ do_rough (Just n) = Just (toIfaceTyCon_name n)
+
+--------------------------
+famInstToIfaceFamInst :: FamInst -> IfaceFamInst
+famInstToIfaceFamInst fi@(FamInst { fi_tycon = tycon,
+ fi_fam = fam, fi_tcs = mb_tcs })
+ = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
+ , ifFamInstFam = fam
+ , ifFamInstTys = map do_rough mb_tcs }
+ where
+ do_rough Nothing = Nothing
+ do_rough (Just n) = Just (toIfaceTyCon_name n)
+
+--------------------------
+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 = case work_info of { HasWorker _ _ -> True; other -> False }
+ 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 :: CoreRule -> IfaceRule
+coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
+ = pprTrace "toHsRule: builtin" (ppr fn) $
+ bogusIfaceRule fn
+
+coreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,
+ ru_act = act, ru_bndrs = bndrs,
+ ru_args = args, ru_rhs = rhs, ru_orph = orph })
+ = IfaceRule { ifRuleName = name, ifActivation = act,
+ ifRuleBndrs = map toIfaceBndr bndrs,
+ ifRuleHead = fn,
+ ifRuleArgs = map do_arg args,
+ ifRuleRhs = toIfaceExpr rhs,
+ ifRuleOrph = orph }