import NewDemand ( isTopSig )
import CoreSyn
import Class ( classExtraBigSig, classTyCon )
-import TyCon ( TyCon, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
+import TyCon ( TyCon, AlgTyConRhs(..), SynTyConRhs(..),
+ isRecursiveTyCon, isForeignTyCon,
isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
- tyConArity, tyConTyVars, algTyConRhs, tyConExtName )
+ tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
+ tyConFamInst_maybe, tyConFamInstIndex )
import DataCon ( dataConName, dataConFieldLabels, dataConStrictMarks,
- dataConTyCon, dataConIsInfix, dataConUnivTyVars, dataConExTyVars, dataConEqSpec,
- dataConTheta, dataConOrigArgTys )
+ dataConTyCon, dataConIsInfix, dataConUnivTyVars,
+ dataConExTyVars, dataConEqSpec, dataConTheta,
+ dataConOrigArgTys )
import Type ( TyThing(..), splitForAllTys, funResultTy )
import TcType ( deNoteType )
import TysPrim ( alphaTyVars )
occ = nameOccName name
par_occ = nameOccName (nameParent name)
-- The version of the *parent* is the one want
- vers = lookupVersion mod par_occ
+ vers = lookupVersion mod par_occ occ
- lookupVersion :: Module -> OccName -> Version
+ lookupVersion :: Module -> OccName -> OccName -> Version
-- Even though we're looking up a home-package thing, in
-- one-shot mode the imported interfaces may be in the PIT
- lookupVersion mod occ
- = mi_ver_fn iface occ `orElse`
- pprPanic "lookupVers1" (ppr mod <+> ppr occ)
+ lookupVersion mod par_occ occ
+ = mi_ver_fn iface par_occ `orElse`
+ pprPanic "lookupVers1" (ppr mod <+> ppr par_occ <+> ppr occ)
where
iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
- pprPanic "lookupVers2" (ppr mod <+> ppr occ)
+ pprPanic "lookupVers2" (ppr mod <+> ppr par_occ <+> ppr occ)
---------------------
ifName = getOccName clas,
ifTyVars = toIfaceTvBndrs clas_tyvars,
ifFDs = map toIfaceFD clas_fds,
+ ifATs = map (tyThingToIfaceDecl ext . ATyCon) clas_ats,
ifSigs = map toIfaceClassOp op_stuff,
ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
where
- (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
+ (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
+ = classExtraBigSig clas
tycon = classTyCon clas
toIfaceClassOp (sel_id, def_meth)
tyThingToIfaceDecl ext (ATyCon tycon)
| isSynTyCon tycon
- = IfaceSyn { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifSynRhs = toIfaceType ext syn_ty }
+ = IfaceSyn { ifName = getOccName tycon,
+ ifTyVars = toIfaceTvBndrs tyvars,
+ ifOpenSyn = syn_isOpen,
+ ifSynRhs = toIfaceType ext syn_tyki }
| isAlgTyCon tycon
= IfaceData { ifName = getOccName tycon,
ifCons = ifaceConDecls (algTyConRhs tycon),
ifRec = boolToRecFlag (isRecursiveTyCon tycon),
ifGadtSyntax = isGadtSyntaxTyCon tycon,
- ifGeneric = tyConHasGenerics tycon }
+ ifGeneric = tyConHasGenerics tycon,
+ ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
+ (tyConFamInstIndex tycon) }
| isForeignTyCon tycon
= IfaceForeign { ifName = getOccName tycon,
ifCons = IfAbstractTyCon,
ifGadtSyntax = False,
ifGeneric = False,
- ifRec = NonRecursive}
+ ifRec = NonRecursive,
+ ifFamInst = Nothing }
| otherwise = pprPanic "toIfaceDecl" (ppr tycon)
where
tyvars = tyConTyVars tycon
- syn_ty = synTyConRhs tycon
-
- ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
- ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
+ (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
ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
ifConCtxt = toIfaceContext ext (dataConTheta data_con),
- ifConArgTys = map (toIfaceType ext) (dataConOrigArgTys data_con),
- ifConFields = map getOccName (dataConFieldLabels data_con),
+ ifConArgTys = map (toIfaceType ext)
+ (dataConOrigArgTys data_con),
+ ifConFields = map getOccName
+ (dataConFieldLabels data_con),
ifConStricts = dataConStrictMarks data_con }
to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
+ famInstToIface Nothing _ = Nothing
+ famInstToIface (Just (famTyCon, instTys)) index =
+ Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys, index)
+
tyThingToIfaceDecl ext (ADataCon dc)
= pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier