import HscTypes
import DynFlags
+import VarEnv
+import Var
import Name
import NameEnv
import NameSet
mg_deps = deps,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
- mg_deprecs = src_deprecs })
+ mg_deprecs = src_deprecs,
+ mg_hpc_info = hpc_info })
(ModDetails{ md_insts = insts,
md_fam_insts = fam_insts,
md_rules = rules,
+ md_vect_info = vect_info,
md_types = type_env,
md_exports = exports })
; iface_rules = map (coreRuleToIfaceRule this_mod) rules
; iface_insts = map instanceToIfaceInst insts
; iface_fam_insts = map famInstToIfaceFamInst fam_insts
+ ; iface_vect_info = flattenVectInfo vect_info
; intermediate_iface = ModIface {
mi_module = this_mod,
mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
mi_rules = sortLe le_rule iface_rules,
+ mi_vect_info = iface_vect_info,
+
mi_fixities = fixities,
mi_deprecs = deprecs,
mi_globals = Just rdr_env,
mi_finsts = False, -- Ditto
mi_decls = deliberatelyOmitted "decls",
mi_ver_fn = deliberatelyOmitted "ver_fn",
+ mi_hpc = isHpcUsed hpc_info,
-- And build the cached values
mi_dep_fn = mkIfaceDepCache deprecs,
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
+ flattenVectInfo (VectInfo { vectInfoVar = vVar
+ , vectInfoTyCon = vTyCon
+ }) =
+ IfaceVectInfo {
+ ifaceVectInfoVar = [ Var.varName v
+ | (v, _) <- varEnvElts vVar],
+ ifaceVectInfoTyCon = [ tyConName t
+ | (t, t_v) <- nameEnvElts vTyCon
+ , t /= t_v],
+ ifaceVectInfoTyConReuse = [ tyConName t
+ | (t, t_v) <- nameEnvElts vTyCon
+ , t == t_v]
+ }
+
-----------------------------
writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
writeIfaceFile dflags location new_iface
-- If the usages havn't changed either, we don't need to write the interface file
no_other_changes = mi_usages new_iface == mi_usages old_iface &&
- mi_deps new_iface == mi_deps old_iface
+ mi_deps new_iface == mi_deps old_iface &&
+ mi_hpc new_iface == mi_hpc old_iface
no_change_at_all = no_output_change && no_other_changes
pp_diffs = vcat [pp_change no_export_change "Export list"
| (mod, avails) <- fmToList groupFM
]
where
+ -- Group by the module where the exported entities are defined
+ -- (which may not be the same for all Names in an Avail)
-- Deliberately use FiniteMap rather than UniqFM so we
-- get a canonical ordering
groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
groupFM = foldl add emptyModuleEnv exports
- add env avail
- = extendModuleEnv_C add_avail env mod (unitFM avail_fs avail_occ)
+ add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
+ -> Module -> GenAvailInfo OccName
+ -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
+ add_one env mod avail
+ = extendModuleEnv_C plusFM env mod
+ (unitFM (occNameFS (availName avail)) avail)
+
+ -- NB: we should not get T(X) and T(Y) in the export list
+ -- else the plusFM will simply discard one! They
+ -- should have been combined by now.
+ add env (Avail n)
+ = add_one env (nameModule n) (Avail (nameOccName n))
+
+ add env (AvailTC tc ns)
+ = foldl add_for_mod env mods
where
- avail_occ = availToOccs avail
- mod = nameModule (availName avail)
- avail_fs = occNameFS (availName avail_occ)
- add_avail avail_fm _ = addToFM avail_fm avail_fs avail_occ
-
- availToOccs (Avail n) = Avail (nameOccName n)
- availToOccs (AvailTC tc ns) = AvailTC (nameOccName tc) (map nameOccName ns)
+ tc_occ = nameOccName tc
+ mods = nub (map nameModule ns)
+ -- Usually just one, but see Note [Original module]
+
+ add_for_mod env mod
+ = add_one env mod (AvailTC tc_occ names_from_mod)
+ where
+ names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
\end{code}
+Note [Orignal module]
+~~~~~~~~~~~~~~~~~~~~~
+Consider this:
+ module X where { data family T }
+ module Y( T(..) ) where { import X; data instance T Int = MkT Int }
+The exported Avail from Y will look like
+ X.T{X.T, Y.MkT}
+That is, in Y,
+ - only MkT is brought into scope by the data instance;
+ - but the parent (used for grouping and naming in T(..) exports) is X.T
+ - and in this case we export X.T too
+
+In the result of MkIfaceExports, the names are grouped by defining module,
+so we may need to split up a single Avail into multiple ones.
+
%************************************************************************
%* *
tyThingToIfaceDecl (ATyCon tycon)
| isSynTyCon tycon
- = IfaceSyn { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
+ = IfaceSyn { ifName = getOccName tycon,
+ ifTyVars = toIfaceTvBndrs tyvars,
ifOpenSyn = syn_isOpen,
- ifSynRhs = toIfaceType syn_tyki }
+ ifSynRhs = toIfaceType syn_tyki,
+ ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
+ }
| isAlgTyCon tycon
= IfaceData { ifName = getOccName tycon,
IfNewTyCon (ifaceConDecl con)
ifaceConDecls (DataTyCon { data_cons = cons }) =
IfDataTyCon (map ifaceConDecl cons)
- ifaceConDecls OpenTyCon { otIsNewtype = False } = IfOpenDataTyCon
- ifaceConDecls OpenTyCon { otIsNewtype = True } = IfOpenNewTyCon
+ ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
ifaceConDecls AbstractTyCon = IfAbstractTyCon
-- The last case happens when a TyCon has been trimmed during tidying
-- Furthermore, tyThingToIfaceDecl is also used
do_rough (Just n) = Just (toIfaceTyCon_name n)
--------------------------
+toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
+ (toIfaceType (idType id))
+ prag_info
+ where
+ -- Stripped-down version of tcIfaceIdInfo
+ -- Change this if you want to export more IdInfo for
+ -- non-top-level Ids. Don't forget to change
+ -- CoreTidy.tidyLetBndr too!
+ --
+ -- See Note [IdInfo on nested let-bindings] in IfaceSyn
+ id_info = idInfo id
+ inline_prag = inlinePragInfo id_info
+ prag_info | isAlwaysActive inline_prag = NoInfo
+ | otherwise = HasInfo [HsInline inline_prag]
+
+--------------------------
toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
toIfaceIdInfo id_info
= catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
toIfaceNote (CoreNote s) = IfaceCoreNote s
---------------------
-toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceIdBndr b) (toIfaceExpr r)
-toIfaceBind (Rec prs) = IfaceRec [(toIfaceIdBndr b, toIfaceExpr r) | (b,r) <- prs]
+toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
+toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
---------------------
toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
| Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
-- Foreign calls have special syntax
| isExternalName name = IfaceExt name
+ | Just (TickBox m ix) <- isTickBoxOp_maybe v
+ = IfaceTick m ix
| otherwise = IfaceLcl (getFS name)
where
name = idName v
projects / ghc-hetmet.git / blobdiff