writeIfaceFile, -- Write the interface file
- checkOldIface -- See if recompilation is required, by
+ checkOldIface, -- See if recompilation is required, by
-- comparing version information
+
+ tyThingToIfaceDecl -- Converting things to their Iface equivalents
) where
\end{code}
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, tyConArgVrcs, synTyConRhs, isGadtSyntaxTyCon,
- tyConArity, tyConTyVars, algTyConRhs, tyConExtName )
+ tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
+ tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
+ tyConFamInst_maybe )
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 )
import InstEnv ( Instance(..) )
import TcRnMonad
import HscTypes ( ModIface(..), ModDetails(..),
+ ModGuts(..), HscEnv(..), hscEPS, Dependencies(..),
+ FixItem(..),
ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
- typeEnvElts,
+ typeEnvElts, mkIfaceFamInstsCache,
GenAvailInfo(..), availName,
ExternalPackageState(..),
Usage(..), IsBootInterface,
)
-import DynFlags ( GhcMode(..), DynFlag(..), dopt )
+import DynFlags ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
import Name ( Name, nameModule, nameOccName, nameParent,
isExternalName, isInternalName, nameParent_maybe, isWiredInName,
isImplicitName, NamedThing(..) )
-- is identical, so no need to write it
mkIface hsc_env maybe_old_iface
- (ModGuts{ mg_module = this_mod,
- mg_boot = is_boot,
- mg_usages = usages,
- mg_deps = deps,
- mg_rdr_env = rdr_env,
- mg_fix_env = fix_env,
- mg_deprecs = src_deprecs })
- (ModDetails{ md_insts = insts,
- md_rules = rules,
- md_types = type_env,
- md_exports = exports })
+ (ModGuts{ mg_module = this_mod,
+ mg_boot = is_boot,
+ mg_usages = usages,
+ mg_deps = deps,
+ mg_rdr_env = rdr_env,
+ mg_fix_env = fix_env,
+ mg_deprecs = src_deprecs })
+ (ModDetails{ md_insts = insts,
+ md_fam_insts= _fam_inst, -- we use the type_env instead
+ md_rules = rules,
+ md_types = type_env,
+ md_exports = exports })
-- NB: notice that mkIface does not look at the bindings
-- only at the TypeEnv. The previous Tidy phase has
-- Don't put implicit Ids and class tycons in the interface file
-- Nor wired-in things; the compiler knows about them anyhow
- ; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
- ; deprecs = mkIfaceDeprec src_deprecs
- ; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
- ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
+ ; fixities = [ (occ,fix)
+ | FixItem occ fix _ <- nameEnvElts fix_env]
+ ; deprecs = mkIfaceDeprec src_deprecs
+ ; iface_rules = map (coreRuleToIfaceRule
+ ext_nm_lhs ext_nm_rhs) rules
+ ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
+ ; iface_fam_insts = extractIfFamInsts decls
; intermediate_iface = ModIface {
mi_module = this_mod,
mi_usages = usages,
mi_exports = mkIfaceExports exports,
mi_insts = sortLe le_inst iface_insts,
+ mi_fam_insts= mkIfaceFamInstsCache decls,
mi_rules = sortLe le_rule iface_rules,
mi_fixities = fixities,
mi_deprecs = deprecs,
; return (new_iface, no_change_at_all) }
where
- r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
- i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2
+ r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
+ i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2
dflags = hsc_dflags hsc_env
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
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),
- ifVrcs = tyConArgVrcs tycon }
+ 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)
(sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
op_ty = funResultTy rho_ty
- toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
+ toIfaceFD (tvs1, tvs2) = (map (occNameFS.getOccName) tvs1, map (occNameFS.getOccName) tvs2)
tyThingToIfaceDecl ext (ATyCon tycon)
| isSynTyCon tycon
- = IfaceSyn { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifVrcs = tyConArgVrcs tycon,
- 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,
- ifVrcs = tyConArgVrcs tycon,
- ifGeneric = tyConHasGenerics tycon }
+ ifGeneric = tyConHasGenerics tycon,
+ ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
| isForeignTyCon tycon
= IfaceForeign { ifName = getOccName tycon,
ifGadtSyntax = False,
ifGeneric = False,
ifRec = NonRecursive,
- ifVrcs = tyConArgVrcs tycon }
+ 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)) =
+ Just $ IfaceFamInst { ifFamInstTyCon = toIfaceTyCon ext famTyCon
+ , ifFamInstTys = map (toIfaceType ext) instTys
+ }
+
tyThingToIfaceDecl ext (ADataCon dc)
= pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
-toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
+toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (occNameFS (getOccName x)) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
toIfaceExpr ext (Cast e co) = IfaceCast (toIfaceExpr ext e) (toIfaceType ext co)
toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
---------------------
-toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
+toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map (occNameFS.getOccName) bs, toIfaceExpr ext r)
---------------------
toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
| Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
-- Foreign calls have special syntax
| isExternalName name = IfaceExt (ext name)
- | otherwise = IfaceLcl (nameOccName name)
+ | otherwise = IfaceLcl (occNameFS (nameOccName name))
where
name = idName v
\end{code}
projects / ghc-hetmet.git / blobdiff