\begin{code}
module MkIface (
mkFinalIface,
- pprModDetails, pprIface, pprUsage
+ pprModDetails, pprIface, pprUsage,
+ ifaceTyCls,
) where
#include "HsVersions.h"
import RnMonad
import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl )
import HscTypes ( VersionInfo(..), ModIface(..), ModDetails(..),
- ModuleLocation(..),
+ ModuleLocation(..), GhciMode(..),
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
TyThing(..), DFunId, Avails,
WhatsImported(..), GenAvailInfo(..),
ImportVersion, AvailInfo, Deprecations(..),
lookupVersion,
)
-import CmStaticInfo ( GhciMode(..) )
import CmdLineOpts
import Id ( idType, idInfo, isImplicitId, idCgInfo,
)
import Class ( classExtraBigSig, classTyCon, DefMeth(..) )
import FieldLabel ( fieldLabelType )
-import Type ( splitSigmaTy, tidyTopType, deNoteType, namesOfDFunHead )
+import TcType ( tcSplitSigmaTy, tidyTopType, deNoteType, namesOfDFunHead )
import SrcLoc ( noSrcLoc )
import Outputable
import Module ( ModuleName )
-import Util ( sortLt, unJust )
+import Util ( sortLt )
import ErrUtils ( dumpIfSet_dyn )
import Monad ( when )
-- so there's no need to write a new interface file. But even if
-- the usages have changed, the module version may not have.
- hi_file_path = unJust "mkFinalIface" (ml_hi_file location)
+ hi_file_path = ml_hi_file location
new_decls = mkIfaceDecls ty_cls_dcls rule_dcls inst_dcls
inst_dcls = map ifaceInstance (md_insts new_details)
- ty_cls_dcls = foldNameEnv ifaceTyCls [] (md_types new_details)
+ ty_cls_dcls = foldNameEnv ifaceTyCls_acc [] (md_types new_details)
rule_dcls = map ifaceRule (md_rules new_details)
orphan_mod = isOrphanModule (mi_module new_iface) new_details
no_locals names = isEmptyNameSet (filterNameSet (nameIsLocalOrFrom this_mod) names)
\end{code}
+Implicit Ids and class tycons aren't included in interface files, so
+we miss them out of the accumulating parameter here.
+
+\begin{code}
+ifaceTyCls_acc :: TyThing -> [RenamedTyClDecl] -> [RenamedTyClDecl]
+ifaceTyCls_acc (AnId id) so_far | isImplicitId id = so_far
+ifaceTyCls_acc (ATyCon id) so_far | isClassTyCon id = so_far
+ifaceTyCls_acc other so_far = ifaceTyCls other : so_far
+\end{code}
+
+Convert *any* TyThing into a RenamedTyClDecl. Used both for
+generating interface files and for the ':info' command in GHCi.
+
\begin{code}
-ifaceTyCls :: TyThing -> [RenamedTyClDecl] -> [RenamedTyClDecl]
-ifaceTyCls (AClass clas) so_far
- = cls_decl : so_far
+ifaceTyCls :: TyThing -> RenamedTyClDecl
+ifaceTyCls (AClass clas) = cls_decl
where
cls_decl = ClassDecl { tcdCtxt = toHsContext sc_theta,
tcdName = getName clas,
= ASSERT(sel_tyvars == clas_tyvars)
ClassOpSig (getName sel_id) def_meth' (toHsType op_ty) noSrcLoc
where
- (sel_tyvars, _, op_ty) = splitSigmaTy (idType sel_id)
+ (sel_tyvars, _, op_ty) = tcSplitSigmaTy (idType sel_id)
def_meth' = case def_meth of
NoDefMeth -> NoDefMeth
GenDefMeth -> GenDefMeth
DefMeth id -> DefMeth (getName id)
-ifaceTyCls (ATyCon tycon) so_far
- | isClassTyCon tycon = so_far
- | otherwise = ty_decl : so_far
+ifaceTyCls (ATyCon tycon) = ty_decl
where
ty_decl | isSynTyCon tycon
= TySynonym { tcdName = getName tycon,
mk_field strict_mark field_label
= ([getName field_label], BangType strict_mark (toHsType (fieldLabelType field_label)))
-ifaceTyCls (AnId id) so_far
- | isImplicitId id = so_far
- | otherwise = iface_sig : so_far
+ifaceTyCls (AnId id) = iface_sig
where
iface_sig = IfaceSig { tcdName = getName id,
tcdType = toHsType id_type,
caf_info = cgCafInfo cg_info
hs_idinfo | opt_OmitInterfacePragmas = []
- | otherwise = arity_hsinfo ++ caf_hsinfo ++ cpr_hsinfo ++
+ | otherwise = arity_hsinfo ++ caf_hsinfo ++
strict_hsinfo ++ wrkr_hsinfo ++ unfold_hsinfo
------------ Arity --------------
NoCafRefs -> [HsNoCafRefs]
otherwise -> []
- ------------ CPR Info --------------
- cpr_hsinfo = case cprInfo id_info of
- ReturnsCPR -> [HsCprInfo]
- NoCPRInfo -> []
-
------------ Strictness --------------
- strict_hsinfo = case strictnessInfo id_info of
- NoStrictnessInfo -> []
- info -> [HsStrictness info]
+ strict_hsinfo = case newStrictnessInfo id_info of
+ Nothing -> []
+ Just sig -> [HsStrictness sig]
------------ Worker --------------
work_info = workerInfo id_info