#include "HsVersions.h"
import IfaceSyn -- All of it
-import IfaceType ( toIfaceTvBndrs, toIfaceType, toIfaceContext )
+import IfaceType ( toIfaceTvBndrs, toIfaceType, toIfaceContext,
+ ifaceTyConOccName )
import LoadIface ( readIface, loadInterface, pprModIface )
import Id ( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..),
import TcType ( deNoteType )
import TysPrim ( alphaTyVars )
import InstEnv ( Instance(..) )
+import FamInstEnv ( FamInst(..) )
import TcRnMonad
import HscTypes ( ModIface(..), ModDetails(..),
ModGuts(..), HscEnv(..), hscEPS, Dependencies(..),
FixItem(..),
ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
- typeEnvElts, mkIfaceFamInstsCache,
+ typeEnvElts,
GenAvailInfo(..), availName,
ExternalPackageState(..),
Usage(..), IsBootInterface,
-- 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_fam_insts= _fam_inst, -- we use the type_env instead
- 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_insts,
+ 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
; iface_rules = map (coreRuleToIfaceRule
ext_nm_lhs ext_nm_rhs) rules
; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
- ; iface_fam_insts = extractIfFamInsts decls
+ ; iface_fam_insts = map (famInstToIfaceFamInst ext_nm_lhs)
+ fam_insts
; 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_fam_insts= sortLe le_fam_inst iface_fam_insts,
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
+ i1 `le_fam_inst` i2 = ifFamInstTyConOcc i1 <= ifFamInstTyConOcc i2
dflags = hsc_dflags hsc_env
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
+ ifFamInstTyConOcc = ifaceTyConOccName . ifFamInstTyCon
-----------------------------
famInstToIface Nothing = Nothing
famInstToIface (Just (famTyCon, instTys)) =
- Just $ IfaceFamInst { ifFamInstTyCon = toIfaceTyCon ext famTyCon
- , ifFamInstTys = map (toIfaceType ext) instTys
- }
+ Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys)
tyThingToIfaceDecl ext (ADataCon dc)
= pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
--------------------------
+famInstToIfaceFamInst :: (Name -> IfaceExtName) -> FamInst -> IfaceFamInst
+famInstToIfaceFamInst ext_lhs fi@(FamInst { fi_tycon = tycon,
+ fi_fam = fam, fi_tcs = mb_tcs })
+ = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon ext_lhs tycon
+ , ifFamInstFam = ext_lhs fam
+ , ifFamInstTys = map do_rough mb_tcs }
+ where
+ do_rough Nothing = Nothing
+ do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
+
+--------------------------
toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
toIfaceIdInfo ext id_info
= catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,