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,
isLocalId, idName,
)
-import DataCon ( StrictnessMark(..), dataConId, dataConSig, dataConFieldLabels, dataConStrictMarks )
+import DataCon ( dataConId, dataConSig, dataConFieldLabels, dataConStrictMarks )
import IdInfo -- Lots
import CoreSyn ( CoreRule(..) )
import CoreFVs ( ruleLhsFreeNames )
import NameSet
import OccName ( pprOccName )
import TyCon ( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon, tyConGenIds,
- tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize, isClassTyCon
+ tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize,
+ isClassTyCon, isForeignTyCon
)
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)
= 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
tcdSysNames = map getName (tyConGenIds tycon),
tcdLoc = noSrcLoc }
+ | isForeignTyCon tycon
+ = ForeignType { tcdName = getName tycon,
+ tcdFoType = DNType, -- The only case at present
+ tcdLoc = noSrcLoc }
+
| otherwise = pprPanic "ifaceTyCls" (ppr tycon)
tyvars = tyConTyVars tycon
where
(tyvars1, _, ex_tyvars, ex_theta, arg_tys, tycon1) = dataConSig data_con
field_labels = dataConFieldLabels data_con
- strict_marks = dataConStrictMarks data_con
+ strict_marks = drop (length ex_theta) (dataConStrictMarks data_con)
+ -- The 'drop' is because dataConStrictMarks
+ -- includes the existential dictionaries
details | null field_labels
= ASSERT( tycon == tycon1 && tyvars == tyvars1 )
- VanillaCon (zipWith mk_bang_ty strict_marks arg_tys)
+ VanillaCon (zipWith BangType strict_marks (map toHsType arg_tys))
| otherwise
= RecCon (zipWith mk_field strict_marks field_labels)
- mk_bang_ty NotMarkedStrict ty = Unbanged (toHsType ty)
- mk_bang_ty (MarkedUnboxed _ _) ty = Unpacked (toHsType ty)
- mk_bang_ty MarkedStrict ty = Banged (toHsType ty)
-
mk_field strict_mark field_label
- = ([getName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
+ = ([getName field_label], BangType strict_mark (toHsType (fieldLabelType field_label)))
ifaceTyCls (AnId id) so_far
| isImplicitId id = so_far