never executed always true always false
1
2 {-# LANGUAGE NondecreasingIndentation #-}
3
4 {-
5 (c) The University of Glasgow 2006-2008
6 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
7 -}
8
9 -- | Module for constructing @ModIface@ values (interface files),
10 -- writing them to disk and comparing two versions to see if
11 -- recompilation is required.
12 module GHC.Iface.Make
13 ( mkPartialIface
14 , mkFullIface
15 , mkIfaceTc
16 , mkIfaceExports
17 , coAxiomToIfaceDecl
18 , tyThingToIfaceDecl -- Converting things to their Iface equivalents
19 )
20 where
21
22 import GHC.Prelude
23
24 import GHC.Hs
25
26 import GHC.StgToCmm.Types (CgInfos (..))
27
28 import GHC.Tc.Utils.TcType
29 import GHC.Tc.Utils.Monad
30
31 import GHC.Iface.Syntax
32 import GHC.Iface.Recomp
33 import GHC.Iface.Load
34 import GHC.Iface.Ext.Fields
35
36 import GHC.CoreToIface
37
38 import qualified GHC.LanguageExtensions as LangExt
39 import GHC.Core
40 import GHC.Core.Class
41 import GHC.Core.TyCon
42 import GHC.Core.Coercion.Axiom
43 import GHC.Core.ConLike
44 import GHC.Core.DataCon
45 import GHC.Core.Type
46 import GHC.Core.Multiplicity
47 import GHC.Core.InstEnv
48 import GHC.Core.FamInstEnv
49 import GHC.Core.Unify( RoughMatchTc(..) )
50
51 import GHC.Driver.Env
52 import GHC.Driver.Backend
53 import GHC.Driver.Session
54 import GHC.Driver.Plugins (LoadedPlugin(..))
55
56 import GHC.Types.Id
57 import GHC.Types.Fixity.Env
58 import GHC.Types.SafeHaskell
59 import GHC.Types.Annotations
60 import GHC.Types.Var.Env
61 import GHC.Types.Var
62 import GHC.Types.Name
63 import GHC.Types.Avail
64 import GHC.Types.Name.Reader
65 import GHC.Types.Name.Env
66 import GHC.Types.Name.Set
67 import GHC.Types.Unique.DSet
68 import GHC.Types.Basic hiding ( SuccessFlag(..) )
69 import GHC.Types.TypeEnv
70 import GHC.Types.SourceFile
71 import GHC.Types.TyThing
72 import GHC.Types.HpcInfo
73 import GHC.Types.CompleteMatch
74
75 import GHC.Utils.Outputable
76 import GHC.Utils.Panic.Plain
77 import GHC.Utils.Misc hiding ( eqListBy )
78 import GHC.Utils.Logger
79 import GHC.Utils.Trace
80
81 import GHC.Data.FastString
82 import GHC.Data.Maybe
83
84 import GHC.HsToCore.Docs
85 import GHC.HsToCore.Usage ( mkUsageInfo, mkUsedNames )
86
87 import GHC.Unit
88 import GHC.Unit.Module.Warnings
89 import GHC.Unit.Module.ModIface
90 import GHC.Unit.Module.ModDetails
91 import GHC.Unit.Module.ModGuts
92 import GHC.Unit.Module.ModSummary
93 import GHC.Unit.Module.Deps
94
95 import Data.Function
96 import Data.List ( findIndex, mapAccumL, sortBy )
97 import Data.Ord
98 import Data.IORef
99
100
101 {-
102 ************************************************************************
103 * *
104 \subsection{Completing an interface}
105 * *
106 ************************************************************************
107 -}
108
109 mkPartialIface :: HscEnv
110 -> ModDetails
111 -> ModSummary
112 -> ModGuts
113 -> PartialModIface
114 mkPartialIface hsc_env mod_details mod_summary
115 ModGuts{ mg_module = this_mod
116 , mg_hsc_src = hsc_src
117 , mg_usages = usages
118 , mg_used_th = used_th
119 , mg_deps = deps
120 , mg_rdr_env = rdr_env
121 , mg_fix_env = fix_env
122 , mg_warns = warns
123 , mg_hpc_info = hpc_info
124 , mg_safe_haskell = safe_mode
125 , mg_trust_pkg = self_trust
126 , mg_doc_hdr = doc_hdr
127 , mg_decl_docs = decl_docs
128 , mg_arg_docs = arg_docs
129 }
130 = mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env warns hpc_info self_trust
131 safe_mode usages doc_hdr decl_docs arg_docs mod_summary mod_details
132
133 -- | Fully instantiate an interface. Adds fingerprints and potentially code
134 -- generator produced information.
135 --
136 -- CgInfos is not available when not generating code (-fno-code), or when not
137 -- generating interface pragmas (-fomit-interface-pragmas). See also
138 -- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types.
139 mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
140 mkFullIface hsc_env partial_iface mb_cg_infos = do
141 let decls
142 | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env)
143 = mi_decls partial_iface
144 | otherwise
145 = updateDecl (mi_decls partial_iface) mb_cg_infos
146
147 full_iface <-
148 {-# SCC "addFingerprints" #-}
149 addFingerprints hsc_env partial_iface{ mi_decls = decls }
150
151 -- Debug printing
152 let unit_state = hsc_units hsc_env
153 putDumpFileMaybe (hsc_logger hsc_env) Opt_D_dump_hi "FINAL INTERFACE" FormatText
154 (pprModIface unit_state full_iface)
155
156 return full_iface
157
158 updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl]
159 updateDecl decls Nothing = decls
160 updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos }) = map update_decl decls
161 where
162 update_decl (IfaceId nm ty details infos)
163 | let not_caffy = elemNameSet nm non_cafs
164 , let mb_lf_info = lookupNameEnv lf_infos nm
165 , warnPprTrace (isNothing mb_lf_info) (text "Name without LFInfo:" <+> ppr nm) True
166 -- Only allocate a new IfaceId if we're going to update the infos
167 , isJust mb_lf_info || not_caffy
168 = IfaceId nm ty details $
169 (if not_caffy then (HsNoCafRefs :) else id)
170 (case mb_lf_info of
171 Nothing -> infos -- LFInfos not available when building .cmm files
172 Just lf_info -> HsLFInfo (toIfaceLFInfo nm lf_info) : infos)
173
174 update_decl decl
175 = decl
176
177 -- | Make an interface from the results of typechecking only. Useful
178 -- for non-optimising compilation, or where we aren't generating any
179 -- object code at all ('NoBackend').
180 mkIfaceTc :: HscEnv
181 -> SafeHaskellMode -- The safe haskell mode
182 -> ModDetails -- gotten from mkBootModDetails, probably
183 -> ModSummary
184 -> TcGblEnv -- Usages, deprecations, etc
185 -> IO ModIface
186 mkIfaceTc hsc_env safe_mode mod_details mod_summary
187 tc_result@TcGblEnv{ tcg_mod = this_mod,
188 tcg_src = hsc_src,
189 tcg_imports = imports,
190 tcg_rdr_env = rdr_env,
191 tcg_fix_env = fix_env,
192 tcg_merged = merged,
193 tcg_warns = warns,
194 tcg_hpc = other_hpc_info,
195 tcg_th_splice_used = tc_splice_used,
196 tcg_dependent_files = dependent_files
197 }
198 = do
199 let used_names = mkUsedNames tc_result
200 let pluginModules = map lpModule (hsc_plugins hsc_env)
201 let home_unit = hsc_home_unit hsc_env
202 let deps = mkDependencies home_unit
203 (tcg_mod tc_result)
204 (tcg_imports tc_result)
205 (map mi_module pluginModules)
206 let hpc_info = emptyHpcInfo other_hpc_info
207 used_th <- readIORef tc_splice_used
208 dep_files <- (readIORef dependent_files)
209 -- Do NOT use semantic module here; this_mod in mkUsageInfo
210 -- is used solely to decide if we should record a dependency
211 -- or not. When we instantiate a signature, the semantic
212 -- module is something we want to record dependencies for,
213 -- but if you pass that in here, we'll decide it's the local
214 -- module and does not need to be recorded as a dependency.
215 -- See Note [Identity versus semantic module]
216 usages <- mkUsageInfo hsc_env this_mod hsc_src (imp_mods imports) used_names
217 dep_files merged
218
219 (doc_hdr', doc_map, arg_map) <- extractDocs tc_result
220
221 let partial_iface = mkIface_ hsc_env
222 this_mod hsc_src
223 used_th deps rdr_env
224 fix_env warns hpc_info
225 (imp_trust_own_pkg imports) safe_mode usages
226 doc_hdr' doc_map arg_map mod_summary
227 mod_details
228
229 mkFullIface hsc_env partial_iface Nothing
230
231 mkIface_ :: HscEnv -> Module -> HscSource
232 -> Bool -> Dependencies -> GlobalRdrEnv
233 -> NameEnv FixItem -> Warnings -> HpcInfo
234 -> Bool
235 -> SafeHaskellMode
236 -> [Usage]
237 -> Maybe HsDocString
238 -> DeclDocMap
239 -> ArgDocMap
240 -> ModSummary
241 -> ModDetails
242 -> PartialModIface
243 mkIface_ hsc_env
244 this_mod hsc_src used_th deps rdr_env fix_env src_warns
245 hpc_info pkg_trust_req safe_mode usages
246 doc_hdr decl_docs arg_docs mod_summary
247 ModDetails{ md_insts = insts,
248 md_fam_insts = fam_insts,
249 md_rules = rules,
250 md_anns = anns,
251 md_types = type_env,
252 md_exports = exports,
253 md_complete_matches = complete_matches }
254 -- NB: notice that mkIface does not look at the bindings
255 -- only at the TypeEnv. The previous Tidy phase has
256 -- put exactly the info into the TypeEnv that we want
257 -- to expose in the interface
258
259 = do
260 let home_unit = hsc_home_unit hsc_env
261 semantic_mod = homeModuleNameInstantiation home_unit (moduleName this_mod)
262 entities = typeEnvElts type_env
263 show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env)
264 decls = [ tyThingToIfaceDecl show_linear_types entity
265 | entity <- entities,
266 let name = getName entity,
267 not (isImplicitTyThing entity),
268 -- No implicit Ids and class tycons in the interface file
269 not (isWiredInName name),
270 -- Nor wired-in things; the compiler knows about them anyhow
271 nameIsLocalOrFrom semantic_mod name ]
272 -- Sigh: see Note [Root-main Id] in GHC.Tc.Module
273 -- NB: ABSOLUTELY need to check against semantic_mod,
274 -- because all of the names in an hsig p[H=<H>]:H
275 -- are going to be for <H>, not the former id!
276 -- See Note [Identity versus semantic module]
277
278 fixities = sortBy (comparing fst)
279 [(occ,fix) | FixItem occ fix <- nonDetNameEnvElts fix_env]
280 -- The order of fixities returned from nonDetNameEnvElts is not
281 -- deterministic, so we sort by OccName to canonicalize it.
282 -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details.
283 warns = src_warns
284 iface_rules = map coreRuleToIfaceRule rules
285 iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
286 iface_fam_insts = map famInstToIfaceFamInst fam_insts
287 trust_info = setSafeMode safe_mode
288 annotations = map mkIfaceAnnotation anns
289 icomplete_matches = map mkIfaceCompleteMatch complete_matches
290
291 ModIface {
292 mi_module = this_mod,
293 -- Need to record this because it depends on the -instantiated-with flag
294 -- which could change
295 mi_sig_of = if semantic_mod == this_mod
296 then Nothing
297 else Just semantic_mod,
298 mi_hsc_src = hsc_src,
299 mi_deps = deps,
300 mi_usages = usages,
301 mi_exports = mkIfaceExports exports,
302
303 -- Sort these lexicographically, so that
304 -- the result is stable across compilations
305 mi_insts = sortBy cmp_inst iface_insts,
306 mi_fam_insts = sortBy cmp_fam_inst iface_fam_insts,
307 mi_rules = sortBy cmp_rule iface_rules,
308
309 mi_fixities = fixities,
310 mi_warns = warns,
311 mi_anns = annotations,
312 mi_globals = maybeGlobalRdrEnv rdr_env,
313 mi_used_th = used_th,
314 mi_decls = decls,
315 mi_hpc = isHpcUsed hpc_info,
316 mi_trust = trust_info,
317 mi_trust_pkg = pkg_trust_req,
318 mi_complete_matches = icomplete_matches,
319 mi_doc_hdr = doc_hdr,
320 mi_decl_docs = decl_docs,
321 mi_arg_docs = arg_docs,
322 mi_final_exts = (),
323 mi_ext_fields = emptyExtensibleFields,
324 mi_src_hash = ms_hs_hash mod_summary
325 }
326 where
327 cmp_rule = lexicalCompareFS `on` ifRuleName
328 -- Compare these lexicographically by OccName, *not* by unique,
329 -- because the latter is not stable across compilations:
330 cmp_inst = comparing (nameOccName . ifDFun)
331 cmp_fam_inst = comparing (nameOccName . ifFamInstTcName)
332
333 dflags = hsc_dflags hsc_env
334
335 -- We only fill in mi_globals if the module was compiled to byte
336 -- code. Otherwise, the compiler may not have retained all the
337 -- top-level bindings and they won't be in the TypeEnv (see
338 -- Desugar.addExportFlagsAndRules). The mi_globals field is used
339 -- by GHCi to decide whether the module has its full top-level
340 -- scope available. (#5534)
341 maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
342 maybeGlobalRdrEnv rdr_env
343 | backendRetainsAllBindings (backend dflags) = Just rdr_env
344 | otherwise = Nothing
345
346 ifFamInstTcName = ifFamInstFam
347
348
349 {-
350 ************************************************************************
351 * *
352 COMPLETE Pragmas
353 * *
354 ************************************************************************
355 -}
356
357 mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
358 mkIfaceCompleteMatch (CompleteMatch cls mtc) =
359 IfaceCompleteMatch (map conLikeName (uniqDSetToList cls)) (toIfaceTyCon <$> mtc)
360
361
362 {-
363 ************************************************************************
364 * *
365 Keeping track of what we've slurped, and fingerprints
366 * *
367 ************************************************************************
368 -}
369
370
371 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
372 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = payload })
373 = IfaceAnnotation {
374 ifAnnotatedTarget = fmap nameOccName target,
375 ifAnnotatedValue = payload
376 }
377
378 mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical
379 mkIfaceExports exports
380 = sortBy stableAvailCmp (map sort_subs exports)
381 where
382 sort_subs :: AvailInfo -> AvailInfo
383 sort_subs (Avail n) = Avail n
384 sort_subs (AvailTC n []) = AvailTC n []
385 sort_subs (AvailTC n (m:ms))
386 | NormalGreName n==m = AvailTC n (m:sortBy stableGreNameCmp ms)
387 | otherwise = AvailTC n (sortBy stableGreNameCmp (m:ms))
388 -- Maintain the AvailTC Invariant
389
390 {-
391 Note [Original module]
392 ~~~~~~~~~~~~~~~~~~~~~
393 Consider this:
394 module X where { data family T }
395 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
396 The exported Avail from Y will look like
397 X.T{X.T, Y.MkT}
398 That is, in Y,
399 - only MkT is brought into scope by the data instance;
400 - but the parent (used for grouping and naming in T(..) exports) is X.T
401 - and in this case we export X.T too
402
403 In the result of mkIfaceExports, the names are grouped by defining module,
404 so we may need to split up a single Avail into multiple ones.
405 -}
406
407
408 {-
409 ************************************************************************
410 * *
411 Converting things to their Iface equivalents
412 * *
413 ************************************************************************
414 -}
415
416 tyThingToIfaceDecl :: Bool -> TyThing -> IfaceDecl
417 tyThingToIfaceDecl _ (AnId id) = idToIfaceDecl id
418 tyThingToIfaceDecl _ (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)
419 tyThingToIfaceDecl _ (ACoAxiom ax) = coAxiomToIfaceDecl ax
420 tyThingToIfaceDecl show_linear_types (AConLike cl) = case cl of
421 RealDataCon dc -> dataConToIfaceDecl show_linear_types dc -- for ppr purposes only
422 PatSynCon ps -> patSynToIfaceDecl ps
423
424 --------------------------
425 idToIfaceDecl :: Id -> IfaceDecl
426 -- The Id is already tidied, so that locally-bound names
427 -- (lambdas, for-alls) already have non-clashing OccNames
428 -- We can't tidy it here, locally, because it may have
429 -- free variables in its type or IdInfo
430 idToIfaceDecl id
431 = IfaceId { ifName = getName id,
432 ifType = toIfaceType (idType id),
433 ifIdDetails = toIfaceIdDetails (idDetails id),
434 ifIdInfo = toIfaceIdInfo (idInfo id) }
435
436 --------------------------
437 dataConToIfaceDecl :: Bool -> DataCon -> IfaceDecl
438 dataConToIfaceDecl show_linear_types dataCon
439 = IfaceId { ifName = getName dataCon,
440 ifType = toIfaceType (dataConDisplayType show_linear_types dataCon),
441 ifIdDetails = IfVanillaId,
442 ifIdInfo = [] }
443
444 --------------------------
445 coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
446 -- We *do* tidy Axioms, because they are not (and cannot
447 -- conveniently be) built in tidy form
448 coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
449 , co_ax_role = role })
450 = IfaceAxiom { ifName = getName ax
451 , ifTyCon = toIfaceTyCon tycon
452 , ifRole = role
453 , ifAxBranches = map (coAxBranchToIfaceBranch tycon
454 (map coAxBranchLHS branch_list))
455 branch_list }
456 where
457 branch_list = fromBranches branches
458
459 -- 2nd parameter is the list of branch LHSs, in case of a closed type family,
460 -- for conversion from incompatible branches to incompatible indices.
461 -- For an open type family the list should be empty.
462 -- See Note [Storing compatibility] in GHC.Core.Coercion.Axiom
463 coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
464 coAxBranchToIfaceBranch tc lhs_s
465 (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
466 , cab_eta_tvs = eta_tvs
467 , cab_lhs = lhs, cab_roles = roles
468 , cab_rhs = rhs, cab_incomps = incomps })
469
470 = IfaceAxBranch { ifaxbTyVars = toIfaceTvBndrs tvs
471 , ifaxbCoVars = map toIfaceIdBndr cvs
472 , ifaxbEtaTyVars = toIfaceTvBndrs eta_tvs
473 , ifaxbLHS = toIfaceTcArgs tc lhs
474 , ifaxbRoles = roles
475 , ifaxbRHS = toIfaceType rhs
476 , ifaxbIncomps = iface_incomps }
477 where
478 iface_incomps = map (expectJust "iface_incomps"
479 . flip findIndex lhs_s
480 . eqTypes
481 . coAxBranchLHS) incomps
482
483 -----------------
484 tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
485 -- We *do* tidy TyCons, because they are not (and cannot
486 -- conveniently be) built in tidy form
487 -- The returned TidyEnv is the one after tidying the tyConTyVars
488 tyConToIfaceDecl env tycon
489 | Just clas <- tyConClass_maybe tycon
490 = classToIfaceDecl env clas
491
492 | Just syn_rhs <- synTyConRhs_maybe tycon
493 = ( tc_env1
494 , IfaceSynonym { ifName = getName tycon,
495 ifRoles = tyConRoles tycon,
496 ifSynRhs = if_syn_type syn_rhs,
497 ifBinders = if_binders,
498 ifResKind = if_res_kind
499 })
500
501 | Just fam_flav <- famTyConFlav_maybe tycon
502 = ( tc_env1
503 , IfaceFamily { ifName = getName tycon,
504 ifResVar = if_res_var,
505 ifFamFlav = to_if_fam_flav fam_flav,
506 ifBinders = if_binders,
507 ifResKind = if_res_kind,
508 ifFamInj = tyConInjectivityInfo tycon
509 })
510
511 | isAlgTyCon tycon
512 = ( tc_env1
513 , IfaceData { ifName = getName tycon,
514 ifBinders = if_binders,
515 ifResKind = if_res_kind,
516 ifCType = tyConCType tycon,
517 ifRoles = tyConRoles tycon,
518 ifCtxt = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),
519 ifCons = ifaceConDecls (algTyConRhs tycon),
520 ifGadtSyntax = isGadtSyntaxTyCon tycon,
521 ifParent = parent })
522
523 | otherwise -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
524 -- We only convert these TyCons to IfaceTyCons when we are
525 -- just about to pretty-print them, not because we are going
526 -- to put them into interface files
527 = ( env
528 , IfaceData { ifName = getName tycon,
529 ifBinders = if_binders,
530 ifResKind = if_res_kind,
531 ifCType = Nothing,
532 ifRoles = tyConRoles tycon,
533 ifCtxt = [],
534 ifCons = IfDataTyCon [],
535 ifGadtSyntax = False,
536 ifParent = IfNoParent })
537 where
538 -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`
539 -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause
540 -- an error.
541 (tc_env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
542 tc_tyvars = binderVars tc_binders
543 if_binders = toIfaceTyCoVarBinders tc_binders
544 -- No tidying of the binders; they are already tidy
545 if_res_kind = tidyToIfaceType tc_env1 (tyConResKind tycon)
546 if_syn_type ty = tidyToIfaceType tc_env1 ty
547 if_res_var = getOccFS `fmap` tyConFamilyResVar_maybe tycon
548
549 parent = case tyConFamInstSig_maybe tycon of
550 Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)
551 (toIfaceTyCon tc)
552 (tidyToIfaceTcArgs tc_env1 tc ty)
553 Nothing -> IfNoParent
554
555 to_if_fam_flav OpenSynFamilyTyCon = IfaceOpenSynFamilyTyCon
556 to_if_fam_flav AbstractClosedSynFamilyTyCon = IfaceAbstractClosedSynFamilyTyCon
557 to_if_fam_flav (DataFamilyTyCon {}) = IfaceDataFamilyTyCon
558 to_if_fam_flav (BuiltInSynFamTyCon {}) = IfaceBuiltInSynFamTyCon
559 to_if_fam_flav (ClosedSynFamilyTyCon Nothing) = IfaceClosedSynFamilyTyCon Nothing
560 to_if_fam_flav (ClosedSynFamilyTyCon (Just ax))
561 = IfaceClosedSynFamilyTyCon (Just (axn, ibr))
562 where defs = fromBranches $ coAxiomBranches ax
563 lhss = map coAxBranchLHS defs
564 ibr = map (coAxBranchToIfaceBranch tycon lhss) defs
565 axn = coAxiomName ax
566
567 ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
568 ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
569 ifaceConDecls (TupleTyCon { data_con = con }) = IfDataTyCon [ifaceConDecl con]
570 ifaceConDecls (SumTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
571 ifaceConDecls AbstractTyCon = IfAbstractTyCon
572 -- The AbstractTyCon case happens when a TyCon has been trimmed
573 -- during tidying.
574 -- Furthermore, tyThingToIfaceDecl is also used in GHC.Tc.Module
575 -- for GHCi, when browsing a module, in which case the
576 -- AbstractTyCon and TupleTyCon cases are perfectly sensible.
577 -- (Tuple declarations are not serialised into interface files.)
578
579 ifaceConDecl data_con
580 = IfCon { ifConName = dataConName data_con,
581 ifConInfix = dataConIsInfix data_con,
582 ifConWrapper = isJust (dataConWrapId_maybe data_con),
583 ifConExTCvs = map toIfaceBndr ex_tvs',
584 ifConUserTvBinders = map toIfaceForAllBndr user_bndrs',
585 ifConEqSpec = map (to_eq_spec . eqSpecPair) eq_spec,
586 ifConCtxt = tidyToIfaceContext con_env2 theta,
587 ifConArgTys =
588 map (\(Scaled w t) -> (tidyToIfaceType con_env2 w
589 , (tidyToIfaceType con_env2 t))) arg_tys,
590 ifConFields = dataConFieldLabels data_con,
591 ifConStricts = map (toIfaceBang con_env2)
592 (dataConImplBangs data_con),
593 ifConSrcStricts = map toIfaceSrcBang
594 (dataConSrcBangs data_con)}
595 where
596 (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _)
597 = dataConFullSig data_con
598 user_bndrs = dataConUserTyVarBinders data_con
599
600 -- Tidy the univ_tvs of the data constructor to be identical
601 -- to the tyConTyVars of the type constructor. This means
602 -- (a) we don't need to redundantly put them into the interface file
603 -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
604 -- we know that the type variables will line up
605 -- The latter (b) is important because we pretty-print type constructors
606 -- by converting to Iface syntax and pretty-printing that
607 con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
608 -- A bit grimy, perhaps, but it's simple!
609
610 (con_env2, ex_tvs') = tidyVarBndrs con_env1 ex_tvs
611 user_bndrs' = map (tidyUserTyCoVarBinder con_env2) user_bndrs
612 to_eq_spec (tv,ty) = (tidyTyVar con_env2 tv, tidyToIfaceType con_env2 ty)
613
614 -- By this point, we have tidied every universal and existential
615 -- tyvar. Because of the dcUserTyCoVarBinders invariant
616 -- (see Note [DataCon user type variable binders]), *every*
617 -- user-written tyvar must be contained in the substitution that
618 -- tidying produced. Therefore, tidying the user-written tyvars is a
619 -- simple matter of looking up each variable in the substitution,
620 -- which tidyTyCoVarOcc accomplishes.
621 tidyUserTyCoVarBinder :: TidyEnv -> InvisTVBinder -> InvisTVBinder
622 tidyUserTyCoVarBinder env (Bndr tv vis) =
623 Bndr (tidyTyCoVarOcc env tv) vis
624
625 classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
626 classToIfaceDecl env clas
627 = ( env1
628 , IfaceClass { ifName = getName tycon,
629 ifRoles = tyConRoles (classTyCon clas),
630 ifBinders = toIfaceTyCoVarBinders tc_binders,
631 ifBody = body,
632 ifFDs = map toIfaceFD clas_fds })
633 where
634 (_, clas_fds, sc_theta, _, clas_ats, op_stuff)
635 = classExtraBigSig clas
636 tycon = classTyCon clas
637
638 body | isAbstractTyCon tycon = IfAbstractClass
639 | otherwise
640 = IfConcreteClass {
641 ifClassCtxt = tidyToIfaceContext env1 sc_theta,
642 ifATs = map toIfaceAT clas_ats,
643 ifSigs = map toIfaceClassOp op_stuff,
644 ifMinDef = fmap getOccFS (classMinimalDef clas)
645 }
646
647 (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
648
649 toIfaceAT :: ClassATItem -> IfaceAT
650 toIfaceAT (ATI tc def)
651 = IfaceAT if_decl (fmap (tidyToIfaceType env2 . fst) def)
652 where
653 (env2, if_decl) = tyConToIfaceDecl env1 tc
654
655 toIfaceClassOp (sel_id, def_meth)
656 = assert (sel_tyvars == binderVars tc_binders) $
657 IfaceClassOp (getName sel_id)
658 (tidyToIfaceType env1 op_ty)
659 (fmap toDmSpec def_meth)
660 where
661 -- Be careful when splitting the type, because of things
662 -- like class Foo a where
663 -- op :: (?x :: String) => a -> a
664 -- and class Baz a where
665 -- op :: (Ord a) => a -> a
666 (sel_tyvars, rho_ty) = splitForAllTyCoVars (idType sel_id)
667 op_ty = funResultTy rho_ty
668
669 toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
670 toDmSpec (_, VanillaDM) = VanillaDM
671 toDmSpec (_, GenericDM dm_ty) = GenericDM (tidyToIfaceType env1 dm_ty)
672
673 toIfaceFD (tvs1, tvs2) = (map (tidyTyVar env1) tvs1
674 ,map (tidyTyVar env1) tvs2)
675
676 --------------------------
677
678 tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
679 -- If the type variable "binder" is in scope, don't re-bind it
680 -- In a class decl, for example, the ATD binders mention
681 -- (amd must mention) the class tyvars
682 tidyTyConBinder env@(_, subst) tvb@(Bndr tv vis)
683 = case lookupVarEnv subst tv of
684 Just tv' -> (env, Bndr tv' vis)
685 Nothing -> tidyTyCoVarBinder env tvb
686
687 tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
688 tidyTyConBinders = mapAccumL tidyTyConBinder
689
690 tidyTyVar :: TidyEnv -> TyVar -> FastString
691 tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
692
693 --------------------------
694 instanceToIfaceInst :: ClsInst -> IfaceClsInst
695 instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag
696 , is_cls_nm = cls_name, is_cls = cls
697 , is_tcs = rough_tcs
698 , is_orphan = orph })
699 = assert (cls_name == className cls) $
700 IfaceClsInst { ifDFun = idName dfun_id
701 , ifOFlag = oflag
702 , ifInstCls = cls_name
703 , ifInstTys = ifaceRoughMatchTcs rough_tcs
704 , ifInstOrph = orph }
705
706 --------------------------
707 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
708 famInstToIfaceFamInst (FamInst { fi_axiom = axiom,
709 fi_fam = fam,
710 fi_tcs = rough_tcs })
711 = IfaceFamInst { ifFamInstAxiom = coAxiomName axiom
712 , ifFamInstFam = fam
713 , ifFamInstTys = ifaceRoughMatchTcs rough_tcs
714 , ifFamInstOrph = orph }
715 where
716 fam_decl = tyConName $ coAxiomTyCon axiom
717 mod = assert (isExternalName (coAxiomName axiom)) $
718 nameModule (coAxiomName axiom)
719 is_local name = nameIsLocalOrFrom mod name
720
721 lhs_names = filterNameSet is_local (orphNamesOfCoCon axiom)
722
723 orph | is_local fam_decl
724 = NotOrphan (nameOccName fam_decl)
725 | otherwise
726 = chooseOrphanAnchor lhs_names
727
728 ifaceRoughMatchTcs :: [RoughMatchTc] -> [Maybe IfaceTyCon]
729 ifaceRoughMatchTcs tcs = map do_rough tcs
730 where
731 do_rough OtherTc = Nothing
732 do_rough (KnownTc n) = Just (toIfaceTyCon_name n)
733
734 --------------------------
735 coreRuleToIfaceRule :: CoreRule -> IfaceRule
736 coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
737 = pprTrace "toHsRule: builtin" (ppr fn) $
738 bogusIfaceRule fn
739
740 coreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,
741 ru_act = act, ru_bndrs = bndrs,
742 ru_args = args, ru_rhs = rhs,
743 ru_orphan = orph, ru_auto = auto })
744 = IfaceRule { ifRuleName = name, ifActivation = act,
745 ifRuleBndrs = map toIfaceBndr bndrs,
746 ifRuleHead = fn,
747 ifRuleArgs = map do_arg args,
748 ifRuleRhs = toIfaceExpr rhs,
749 ifRuleAuto = auto,
750 ifRuleOrph = orph }
751 where
752 -- For type args we must remove synonyms from the outermost
753 -- level. Reason: so that when we read it back in we'll
754 -- construct the same ru_rough field as we have right now;
755 -- see tcIfaceRule
756 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
757 do_arg (Coercion co) = IfaceCo (toIfaceCoercion co)
758 do_arg arg = toIfaceExpr arg
759
760 bogusIfaceRule :: Name -> IfaceRule
761 bogusIfaceRule id_name
762 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
763 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
764 ifRuleRhs = IfaceExt id_name, ifRuleOrph = IsOrphan,
765 ifRuleAuto = True }