never executed always true always false
1
2
3 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
4
5 -- | This module implements interface renaming, which is
6 -- used to rewrite interface files on the fly when we
7 -- are doing indefinite typechecking and need instantiations
8 -- of modules which do not necessarily exist yet.
9
10 module GHC.Iface.Rename (
11 rnModIface,
12 rnModExports,
13 tcRnModIface,
14 tcRnModExports,
15 ) where
16
17 import GHC.Prelude
18
19 import GHC.Driver.Env
20
21 import GHC.Tc.Utils.Monad
22
23 import GHC.Iface.Syntax
24 import GHC.Iface.Env
25 import {-# SOURCE #-} GHC.Iface.Load -- a bit vexing
26
27 import GHC.Unit
28 import GHC.Unit.Module.ModIface
29 import GHC.Unit.Module.Deps
30
31 import GHC.Tc.Errors.Types
32 import GHC.Types.SrcLoc
33 import GHC.Types.Unique.FM
34 import GHC.Types.Avail
35 import GHC.Types.Error
36 import GHC.Types.FieldLabel
37 import GHC.Types.Var
38 import GHC.Types.Basic
39 import GHC.Types.Name
40 import GHC.Types.Name.Shape
41
42 import GHC.Utils.Outputable
43 import GHC.Utils.Misc
44 import GHC.Utils.Error
45 import GHC.Utils.Fingerprint
46 import GHC.Utils.Panic
47
48 import qualified Data.Traversable as T
49
50 import Data.IORef
51
52 tcRnMsgMaybe :: IO (Either (Messages TcRnMessage) a) -> TcM a
53 tcRnMsgMaybe do_this = do
54 r <- liftIO $ do_this
55 case r of
56 Left msgs -> do
57 addMessages msgs
58 failM
59 Right x -> return x
60
61 tcRnModIface :: [(ModuleName, Module)] -> Maybe NameShape -> ModIface -> TcM ModIface
62 tcRnModIface x y z = do
63 hsc_env <- getTopEnv
64 tcRnMsgMaybe $ rnModIface hsc_env x y z
65
66 tcRnModExports :: [(ModuleName, Module)] -> ModIface -> TcM [AvailInfo]
67 tcRnModExports x y = do
68 hsc_env <- getTopEnv
69 tcRnMsgMaybe $ rnModExports hsc_env x y
70
71 failWithRn :: TcRnMessage -> ShIfM a
72 failWithRn tcRnMessage = do
73 errs_var <- fmap sh_if_errs getGblEnv
74 errs <- readTcRef errs_var
75 -- TODO: maybe associate this with a source location?
76 let msg = mkPlainErrorMsgEnvelope noSrcSpan tcRnMessage
77 writeTcRef errs_var (msg `addMessage` errs)
78 failM
79
80 -- | What we have is a generalized ModIface, which corresponds to
81 -- a module that looks like p[A=\<A>]:B. We need a *specific* ModIface, e.g.
82 -- p[A=q():A]:B (or maybe even p[A=\<B>]:B) which we load
83 -- up (either to merge it, or to just use during typechecking).
84 --
85 -- Suppose we have:
86 --
87 -- p[A=\<A>]:M ==> p[A=q():A]:M
88 --
89 -- Substitute all occurrences of \<A> with q():A (renameHoleModule).
90 -- Then, for any Name of form {A.T}, replace the Name with
91 -- the Name according to the exports of the implementing module.
92 -- This works even for p[A=\<B>]:M, since we just read in the
93 -- exports of B.hi, which is assumed to be ready now.
94 --
95 -- This function takes an optional 'NameShape', which can be used
96 -- to further refine the identities in this interface: suppose
97 -- we read a declaration for {H.T} but we actually know that this
98 -- should be Foo.T; then we'll also rename this (this is used
99 -- when loading an interface to merge it into a requirement.)
100 rnModIface :: HscEnv -> [(ModuleName, Module)] -> Maybe NameShape
101 -> ModIface -> IO (Either (Messages TcRnMessage) ModIface)
102 rnModIface hsc_env insts nsubst iface =
103 initRnIface hsc_env iface insts nsubst $ do
104 mod <- rnModule (mi_module iface)
105 sig_of <- case mi_sig_of iface of
106 Nothing -> return Nothing
107 Just x -> fmap Just (rnModule x)
108 exports <- mapM rnAvailInfo (mi_exports iface)
109 decls <- mapM rnIfaceDecl' (mi_decls iface)
110 insts <- mapM rnIfaceClsInst (mi_insts iface)
111 fams <- mapM rnIfaceFamInst (mi_fam_insts iface)
112 deps <- rnDependencies (mi_deps iface)
113 -- TODO:
114 -- mi_rules
115 return iface { mi_module = mod
116 , mi_sig_of = sig_of
117 , mi_insts = insts
118 , mi_fam_insts = fams
119 , mi_exports = exports
120 , mi_decls = decls
121 , mi_deps = deps }
122
123 -- | Rename just the exports of a 'ModIface'. Useful when we're doing
124 -- shaping prior to signature merging.
125 rnModExports :: HscEnv -> [(ModuleName, Module)] -> ModIface -> IO (Either (Messages TcRnMessage) [AvailInfo])
126 rnModExports hsc_env insts iface
127 = initRnIface hsc_env iface insts Nothing
128 $ mapM rnAvailInfo (mi_exports iface)
129
130 rnDependencies :: Rename Dependencies
131 rnDependencies deps0 = do
132 deps1 <- dep_orphs_update deps0 (rnDepModules dep_orphs)
133 dep_finsts_update deps1 (rnDepModules dep_finsts)
134
135 rnDepModules :: (Dependencies -> [Module]) -> [Module] -> ShIfM [Module]
136 rnDepModules sel mods = do
137 hsc_env <- getTopEnv
138 hmap <- getHoleSubst
139 -- NB: It's not necessary to test if we're doing signature renaming,
140 -- because ModIface will never contain module reference for itself
141 -- in these dependencies.
142 fmap (nubSort . concat) . T.forM mods $ \mod -> do
143 -- For holes, its necessary to "see through" the instantiation
144 -- of the hole to get accurate family instance dependencies.
145 -- For example, if B imports <A>, and <A> is instantiated with
146 -- F, we must grab and include all of the dep_finsts from
147 -- F to have an accurate transitive dep_finsts list.
148 --
149 -- However, we MUST NOT do this for regular modules.
150 -- First, for efficiency reasons, doing this
151 -- bloats the dep_finsts list, because we *already* had
152 -- those modules in the list (it wasn't a hole module, after
153 -- all). But there's a second, more important correctness
154 -- consideration: we perform module renaming when running
155 -- --abi-hash. In this case, GHC's contract to the user is that
156 -- it will NOT go and read out interfaces of any dependencies
157 -- (https://github.com/haskell/cabal/issues/3633); the point of
158 -- --abi-hash is just to get a hash of the on-disk interfaces
159 -- for this *specific* package. If we go off and tug on the
160 -- interface for /everything/ in dep_finsts, we're gonna have a
161 -- bad time. (It's safe to do this for hole modules, though,
162 -- because the hmap for --abi-hash is always trivial, so the
163 -- interface we request is local. Though, maybe we ought
164 -- not to do it in this case either...)
165 --
166 -- This mistake was bug #15594.
167 let mod' = renameHoleModule (hsc_units hsc_env) hmap mod
168 if isHoleModule mod
169 then do iface <- liftIO . initIfaceCheck (text "rnDepModule") hsc_env
170 $ loadSysInterface (text "rnDepModule") mod'
171 return (mod' : sel (mi_deps iface))
172 else return [mod']
173
174 {-
175 ************************************************************************
176 * *
177 ModIface substitution
178 * *
179 ************************************************************************
180 -}
181
182 -- | Run a computation in the 'ShIfM' monad.
183 initRnIface :: HscEnv -> ModIface -> [(ModuleName, Module)] -> Maybe NameShape
184 -> ShIfM a -> IO (Either (Messages TcRnMessage) a)
185 initRnIface hsc_env iface insts nsubst do_this = do
186 errs_var <- newIORef emptyMessages
187 let hsubst = listToUFM insts
188 rn_mod = renameHoleModule (hsc_units hsc_env) hsubst
189 env = ShIfEnv {
190 sh_if_module = rn_mod (mi_module iface),
191 sh_if_semantic_module = rn_mod (mi_semantic_module iface),
192 sh_if_hole_subst = listToUFM insts,
193 sh_if_shape = nsubst,
194 sh_if_errs = errs_var
195 }
196 -- Modeled off of 'initTc'
197 res <- initTcRnIf 'c' hsc_env env () $ tryM do_this
198 msgs <- readIORef errs_var
199 case res of
200 Left _ -> return (Left msgs)
201 Right r | not (isEmptyMessages msgs) -> return (Left msgs)
202 | otherwise -> return (Right r)
203
204 -- | Environment for 'ShIfM' monads.
205 data ShIfEnv = ShIfEnv {
206 -- What we are renaming the ModIface to. It assumed that
207 -- the original mi_module of the ModIface is
208 -- @generalizeModule (mi_module iface)@.
209 sh_if_module :: Module,
210 -- The semantic module that we are renaming to
211 sh_if_semantic_module :: Module,
212 -- Cached hole substitution, e.g.
213 -- @sh_if_hole_subst == listToUFM . unitIdInsts . moduleUnit . sh_if_module@
214 sh_if_hole_subst :: ShHoleSubst,
215 -- An optional name substitution to be applied when renaming
216 -- the names in the interface. If this is 'Nothing', then
217 -- we just load the target interface and look at the export
218 -- list to determine the renaming.
219 sh_if_shape :: Maybe NameShape,
220 -- Mutable reference to keep track of diagnostics (similar to 'tcl_errs')
221 sh_if_errs :: IORef (Messages TcRnMessage)
222 }
223
224 getHoleSubst :: ShIfM ShHoleSubst
225 getHoleSubst = fmap sh_if_hole_subst getGblEnv
226
227 type ShIfM = TcRnIf ShIfEnv ()
228 type Rename a = a -> ShIfM a
229
230
231 rnModule :: Rename Module
232 rnModule mod = do
233 hmap <- getHoleSubst
234 unit_state <- hsc_units <$> getTopEnv
235 return (renameHoleModule unit_state hmap mod)
236
237 rnAvailInfo :: Rename AvailInfo
238 rnAvailInfo (Avail c) = Avail <$> rnGreName c
239 rnAvailInfo (AvailTC n ns) = do
240 -- Why don't we rnIfaceGlobal the availName itself? It may not
241 -- actually be exported by the module it putatively is from, in
242 -- which case we won't be able to tell what the name actually
243 -- is. But for the availNames they MUST be exported, so they
244 -- will rename fine.
245 ns' <- mapM rnGreName ns
246 case ns' of
247 [] -> panic "rnAvailInfoEmpty AvailInfo"
248 (rep:rest) -> assertPpr (all ((== childModule rep) . childModule) rest)
249 (ppr rep $$ hcat (map ppr rest)) $ do
250 n' <- setNameModule (Just (childModule rep)) n
251 return (AvailTC n' ns')
252 where
253 childModule = nameModule . greNameMangledName
254
255 rnGreName :: Rename GreName
256 rnGreName (NormalGreName n) = NormalGreName <$> rnIfaceGlobal n
257 rnGreName (FieldGreName fl) = FieldGreName <$> rnFieldLabel fl
258
259 rnFieldLabel :: Rename FieldLabel
260 rnFieldLabel fl = do
261 sel' <- rnIfaceGlobal (flSelector fl)
262 return (fl { flSelector = sel' })
263
264
265
266
267 -- | The key function. This gets called on every Name embedded
268 -- inside a ModIface. Our job is to take a Name from some
269 -- generalized unit ID p[A=\<A>, B=\<B>], and change
270 -- it to the correct name for a (partially) instantiated unit
271 -- ID, e.g. p[A=q[]:A, B=\<B>].
272 --
273 -- There are two important things to do:
274 --
275 -- If a hole is substituted with a real module implementation,
276 -- we need to look at that actual implementation to determine what
277 -- the true identity of this name should be. We'll do this by
278 -- loading that module's interface and looking at the mi_exports.
279 --
280 -- However, there is one special exception: when we are loading
281 -- the interface of a requirement. In this case, we may not have
282 -- the "implementing" interface, because we are reading this
283 -- interface precisely to "merge it in".
284 --
285 -- External case:
286 -- p[A=\<B>]:A (and thisUnitId is something else)
287 -- We are loading this in order to determine B.hi! So
288 -- don't load B.hi to find the exports.
289 --
290 -- Local case:
291 -- p[A=\<A>]:A (and thisUnitId is p[A=\<A>])
292 -- This should not happen, because the rename is not necessary
293 -- in this case, but if it does we shouldn't load A.hi!
294 --
295 -- Compare me with 'tcIfaceGlobal'!
296
297 -- In effect, this function needs compute the name substitution on the
298 -- fly. What it has is the name that we would like to substitute.
299 -- If the name is not a hole name {M.x} (e.g. isHoleModule) then
300 -- no renaming can take place (although the inner hole structure must
301 -- be updated to account for the hole module renaming.)
302 rnIfaceGlobal :: Name -> ShIfM Name
303 rnIfaceGlobal n = do
304 hsc_env <- getTopEnv
305 let unit_state = hsc_units hsc_env
306 home_unit = hsc_home_unit hsc_env
307 iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
308 mb_nsubst <- fmap sh_if_shape getGblEnv
309 hmap <- getHoleSubst
310 let m = nameModule n
311 m' = renameHoleModule unit_state hmap m
312 case () of
313 -- Did we encounter {A.T} while renaming p[A=<B>]:A? If so,
314 -- do NOT assume B.hi is available.
315 -- In this case, rename {A.T} to {B.T} but don't look up exports.
316 _ | m' == iface_semantic_mod
317 , isHoleModule m'
318 -- NB: this could be Nothing for computeExports, we have
319 -- nothing to say.
320 -> do n' <- setNameModule (Just m') n
321 case mb_nsubst of
322 Nothing -> return n'
323 Just nsubst ->
324 case maybeSubstNameShape nsubst n' of
325 -- TODO: would love to have context
326 -- TODO: This will give an unpleasant message if n'
327 -- is a constructor; then we'll suggest adding T
328 -- but it won't work.
329 Nothing ->
330 failWithRn $ TcRnIdNotExportedFromLocalSig n'
331 Just n'' -> return n''
332 -- Fastpath: we are renaming p[H=<H>]:A.T, in which case the
333 -- export list is irrelevant.
334 | not (isHoleModule m)
335 -> setNameModule (Just m') n
336 -- The substitution was from <A> to p[]:A.
337 -- But this does not mean {A.T} goes to p[]:A.T:
338 -- p[]:A may reexport T from somewhere else. Do the name
339 -- substitution. Furthermore, we need
340 -- to make sure we pick the accurate name NOW,
341 -- or we might accidentally reject a merge.
342 | otherwise
343 -> do -- Make sure we look up the local interface if substitution
344 -- went from <A> to <B>.
345 let m'' = if isHoleModule m'
346 -- Pull out the local guy!!
347 then mkHomeModule home_unit (moduleName m')
348 else m'
349 iface <- liftIO . initIfaceCheck (text "rnIfaceGlobal") hsc_env
350 $ loadSysInterface (text "rnIfaceGlobal") m''
351 let nsubst = mkNameShape (moduleName m) (mi_exports iface)
352 case maybeSubstNameShape nsubst n of
353 -- NB: report m' because it's more user-friendly
354 Nothing -> failWithRn $ TcRnIdNotExportedFromModuleSig n m'
355 Just n' -> return n'
356
357 -- | Rename an implicit name, e.g., a DFun or coercion axiom.
358 -- Here is where we ensure that DFuns have the correct module as described in
359 -- Note [rnIfaceNeverExported].
360 rnIfaceNeverExported :: Name -> ShIfM Name
361 rnIfaceNeverExported name = do
362 hmap <- getHoleSubst
363 unit_state <- hsc_units <$> getTopEnv
364 iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
365 let m = renameHoleModule unit_state hmap $ nameModule name
366 -- Doublecheck that this DFun/coercion axiom was, indeed, locally defined.
367 massertPpr (iface_semantic_mod == m) (ppr iface_semantic_mod <+> ppr m)
368 setNameModule (Just m) name
369
370 -- Note [rnIfaceNeverExported]
371 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
372 -- For the high-level overview, see
373 -- Note [Handling never-exported TyThings under Backpack]
374 --
375 -- When we see a reference to an entity that was defined in a signature,
376 -- 'rnIfaceGlobal' relies on the identifier in question being part of the
377 -- exports of the implementing 'ModIface', so that we can use the exports to
378 -- decide how to rename the identifier. Unfortunately, references to 'DFun's
379 -- and 'CoAxiom's will run into trouble under this strategy, because they are
380 -- never exported.
381 --
382 -- Let us consider first what should happen in the absence of promotion. In
383 -- this setting, a reference to a 'DFun' or a 'CoAxiom' can only occur inside
384 -- the signature *that is defining it* (as there are no Core terms in
385 -- typechecked-only interface files, there's no way for a reference to occur
386 -- besides from the defining 'ClsInst' or closed type family). Thus,
387 -- it doesn't really matter what names we give the DFun/CoAxiom, as long
388 -- as it's consistent between the declaration site and the use site.
389 --
390 -- We have to make sure that these bogus names don't get propagated,
391 -- but it is fine: see Note [Signature merging DFuns] for the fixups
392 -- to the names we do before writing out the merged interface.
393 -- (It's even easier for instantiation, since the DFuns all get
394 -- dropped entirely; the instances are reexported implicitly.)
395 --
396 -- Unfortunately, this strategy is not enough in the presence of promotion
397 -- (see bug #13149), where modules which import the signature may make
398 -- reference to their coercions. It's not altogether clear how to
399 -- fix this case, but it is definitely a bug!
400
401 -- PILES AND PILES OF BOILERPLATE
402
403 -- | Rename an 'IfaceClsInst', with special handling for an associated
404 -- dictionary function.
405 rnIfaceClsInst :: Rename IfaceClsInst
406 rnIfaceClsInst cls_inst = do
407 n <- rnIfaceGlobal (ifInstCls cls_inst)
408 tys <- mapM rnRoughMatchTyCon (ifInstTys cls_inst)
409
410 dfun <- rnIfaceNeverExported (ifDFun cls_inst)
411 return cls_inst { ifInstCls = n
412 , ifInstTys = tys
413 , ifDFun = dfun
414 }
415
416 rnRoughMatchTyCon :: Rename (Maybe IfaceTyCon)
417 rnRoughMatchTyCon Nothing = return Nothing
418 rnRoughMatchTyCon (Just tc) = Just <$> rnIfaceTyCon tc
419
420 rnIfaceFamInst :: Rename IfaceFamInst
421 rnIfaceFamInst d = do
422 fam <- rnIfaceGlobal (ifFamInstFam d)
423 tys <- mapM rnRoughMatchTyCon (ifFamInstTys d)
424 axiom <- rnIfaceGlobal (ifFamInstAxiom d)
425 return d { ifFamInstFam = fam, ifFamInstTys = tys, ifFamInstAxiom = axiom }
426
427 rnIfaceDecl' :: Rename (Fingerprint, IfaceDecl)
428 rnIfaceDecl' (fp, decl) = (,) fp <$> rnIfaceDecl decl
429
430 rnIfaceDecl :: Rename IfaceDecl
431 rnIfaceDecl d@IfaceId{} = do
432 name <- case ifIdDetails d of
433 IfDFunId -> rnIfaceNeverExported (ifName d)
434 _ | isDefaultMethodOcc (occName (ifName d))
435 -> rnIfaceNeverExported (ifName d)
436 -- Typeable bindings. See Note [Grand plan for Typeable].
437 _ | isTypeableBindOcc (occName (ifName d))
438 -> rnIfaceNeverExported (ifName d)
439 | otherwise -> rnIfaceGlobal (ifName d)
440 ty <- rnIfaceType (ifType d)
441 details <- rnIfaceIdDetails (ifIdDetails d)
442 info <- rnIfaceIdInfo (ifIdInfo d)
443 return d { ifName = name
444 , ifType = ty
445 , ifIdDetails = details
446 , ifIdInfo = info
447 }
448 rnIfaceDecl d@IfaceData{} = do
449 name <- rnIfaceGlobal (ifName d)
450 binders <- mapM rnIfaceTyConBinder (ifBinders d)
451 ctxt <- mapM rnIfaceType (ifCtxt d)
452 cons <- rnIfaceConDecls (ifCons d)
453 res_kind <- rnIfaceType (ifResKind d)
454 parent <- rnIfaceTyConParent (ifParent d)
455 return d { ifName = name
456 , ifBinders = binders
457 , ifCtxt = ctxt
458 , ifCons = cons
459 , ifResKind = res_kind
460 , ifParent = parent
461 }
462 rnIfaceDecl d@IfaceSynonym{} = do
463 name <- rnIfaceGlobal (ifName d)
464 binders <- mapM rnIfaceTyConBinder (ifBinders d)
465 syn_kind <- rnIfaceType (ifResKind d)
466 syn_rhs <- rnIfaceType (ifSynRhs d)
467 return d { ifName = name
468 , ifBinders = binders
469 , ifResKind = syn_kind
470 , ifSynRhs = syn_rhs
471 }
472 rnIfaceDecl d@IfaceFamily{} = do
473 name <- rnIfaceGlobal (ifName d)
474 binders <- mapM rnIfaceTyConBinder (ifBinders d)
475 fam_kind <- rnIfaceType (ifResKind d)
476 fam_flav <- rnIfaceFamTyConFlav (ifFamFlav d)
477 return d { ifName = name
478 , ifBinders = binders
479 , ifResKind = fam_kind
480 , ifFamFlav = fam_flav
481 }
482 rnIfaceDecl d@IfaceClass{} = do
483 name <- rnIfaceGlobal (ifName d)
484 binders <- mapM rnIfaceTyConBinder (ifBinders d)
485 body <- rnIfaceClassBody (ifBody d)
486 return d { ifName = name
487 , ifBinders = binders
488 , ifBody = body
489 }
490 rnIfaceDecl d@IfaceAxiom{} = do
491 name <- rnIfaceNeverExported (ifName d)
492 tycon <- rnIfaceTyCon (ifTyCon d)
493 ax_branches <- mapM rnIfaceAxBranch (ifAxBranches d)
494 return d { ifName = name
495 , ifTyCon = tycon
496 , ifAxBranches = ax_branches
497 }
498 rnIfaceDecl d@IfacePatSyn{} = do
499 name <- rnIfaceGlobal (ifName d)
500 let rnPat (n, b) = (,) <$> rnIfaceGlobal n <*> pure b
501 pat_matcher <- rnPat (ifPatMatcher d)
502 pat_builder <- T.traverse rnPat (ifPatBuilder d)
503 pat_univ_bndrs <- mapM rnIfaceForAllBndr (ifPatUnivBndrs d)
504 pat_ex_bndrs <- mapM rnIfaceForAllBndr (ifPatExBndrs d)
505 pat_prov_ctxt <- mapM rnIfaceType (ifPatProvCtxt d)
506 pat_req_ctxt <- mapM rnIfaceType (ifPatReqCtxt d)
507 pat_args <- mapM rnIfaceType (ifPatArgs d)
508 pat_ty <- rnIfaceType (ifPatTy d)
509 return d { ifName = name
510 , ifPatMatcher = pat_matcher
511 , ifPatBuilder = pat_builder
512 , ifPatUnivBndrs = pat_univ_bndrs
513 , ifPatExBndrs = pat_ex_bndrs
514 , ifPatProvCtxt = pat_prov_ctxt
515 , ifPatReqCtxt = pat_req_ctxt
516 , ifPatArgs = pat_args
517 , ifPatTy = pat_ty
518 }
519
520 rnIfaceClassBody :: Rename IfaceClassBody
521 rnIfaceClassBody IfAbstractClass = return IfAbstractClass
522 rnIfaceClassBody d@IfConcreteClass{} = do
523 ctxt <- mapM rnIfaceType (ifClassCtxt d)
524 ats <- mapM rnIfaceAT (ifATs d)
525 sigs <- mapM rnIfaceClassOp (ifSigs d)
526 return d { ifClassCtxt = ctxt, ifATs = ats, ifSigs = sigs }
527
528 rnIfaceFamTyConFlav :: Rename IfaceFamTyConFlav
529 rnIfaceFamTyConFlav (IfaceClosedSynFamilyTyCon (Just (n, axs)))
530 = IfaceClosedSynFamilyTyCon . Just <$> ((,) <$> rnIfaceNeverExported n
531 <*> mapM rnIfaceAxBranch axs)
532 rnIfaceFamTyConFlav flav = pure flav
533
534 rnIfaceAT :: Rename IfaceAT
535 rnIfaceAT (IfaceAT decl mb_ty)
536 = IfaceAT <$> rnIfaceDecl decl <*> T.traverse rnIfaceType mb_ty
537
538 rnIfaceTyConParent :: Rename IfaceTyConParent
539 rnIfaceTyConParent (IfDataInstance n tc args)
540 = IfDataInstance <$> rnIfaceGlobal n
541 <*> rnIfaceTyCon tc
542 <*> rnIfaceAppArgs args
543 rnIfaceTyConParent IfNoParent = pure IfNoParent
544
545 rnIfaceConDecls :: Rename IfaceConDecls
546 rnIfaceConDecls (IfDataTyCon ds)
547 = IfDataTyCon <$> mapM rnIfaceConDecl ds
548 rnIfaceConDecls (IfNewTyCon d) = IfNewTyCon <$> rnIfaceConDecl d
549 rnIfaceConDecls IfAbstractTyCon = pure IfAbstractTyCon
550
551 rnIfaceConDecl :: Rename IfaceConDecl
552 rnIfaceConDecl d = do
553 con_name <- rnIfaceGlobal (ifConName d)
554 con_ex_tvs <- mapM rnIfaceBndr (ifConExTCvs d)
555 con_user_tvbs <- mapM rnIfaceForAllBndr (ifConUserTvBinders d)
556 let rnIfConEqSpec (n,t) = (,) n <$> rnIfaceType t
557 con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d)
558 con_ctxt <- mapM rnIfaceType (ifConCtxt d)
559 con_arg_tys <- mapM rnIfaceScaledType (ifConArgTys d)
560 con_fields <- mapM rnFieldLabel (ifConFields d)
561 let rnIfaceBang (IfUnpackCo co) = IfUnpackCo <$> rnIfaceCo co
562 rnIfaceBang bang = pure bang
563 con_stricts <- mapM rnIfaceBang (ifConStricts d)
564 return d { ifConName = con_name
565 , ifConExTCvs = con_ex_tvs
566 , ifConUserTvBinders = con_user_tvbs
567 , ifConEqSpec = con_eq_spec
568 , ifConCtxt = con_ctxt
569 , ifConArgTys = con_arg_tys
570 , ifConFields = con_fields
571 , ifConStricts = con_stricts
572 }
573
574 rnIfaceClassOp :: Rename IfaceClassOp
575 rnIfaceClassOp (IfaceClassOp n ty dm) =
576 IfaceClassOp <$> rnIfaceGlobal n
577 <*> rnIfaceType ty
578 <*> rnMaybeDefMethSpec dm
579
580 rnMaybeDefMethSpec :: Rename (Maybe (DefMethSpec IfaceType))
581 rnMaybeDefMethSpec (Just (GenericDM ty)) = Just . GenericDM <$> rnIfaceType ty
582 rnMaybeDefMethSpec mb = return mb
583
584 rnIfaceAxBranch :: Rename IfaceAxBranch
585 rnIfaceAxBranch d = do
586 ty_vars <- mapM rnIfaceTvBndr (ifaxbTyVars d)
587 lhs <- rnIfaceAppArgs (ifaxbLHS d)
588 rhs <- rnIfaceType (ifaxbRHS d)
589 return d { ifaxbTyVars = ty_vars
590 , ifaxbLHS = lhs
591 , ifaxbRHS = rhs }
592
593 rnIfaceIdInfo :: Rename IfaceIdInfo
594 rnIfaceIdInfo = mapM rnIfaceInfoItem
595
596 rnIfaceInfoItem :: Rename IfaceInfoItem
597 rnIfaceInfoItem (HsUnfold lb if_unf)
598 = HsUnfold lb <$> rnIfaceUnfolding if_unf
599 rnIfaceInfoItem i
600 = pure i
601
602 rnIfaceUnfolding :: Rename IfaceUnfolding
603 rnIfaceUnfolding (IfCoreUnfold stable if_expr)
604 = IfCoreUnfold stable <$> rnIfaceExpr if_expr
605 rnIfaceUnfolding (IfCompulsory if_expr)
606 = IfCompulsory <$> rnIfaceExpr if_expr
607 rnIfaceUnfolding (IfInlineRule arity unsat_ok boring_ok if_expr)
608 = IfInlineRule arity unsat_ok boring_ok <$> rnIfaceExpr if_expr
609 rnIfaceUnfolding (IfDFunUnfold bs ops)
610 = IfDFunUnfold <$> rnIfaceBndrs bs <*> mapM rnIfaceExpr ops
611
612 rnIfaceExpr :: Rename IfaceExpr
613 rnIfaceExpr (IfaceLcl name) = pure (IfaceLcl name)
614 rnIfaceExpr (IfaceExt gbl) = IfaceExt <$> rnIfaceGlobal gbl
615 rnIfaceExpr (IfaceType ty) = IfaceType <$> rnIfaceType ty
616 rnIfaceExpr (IfaceCo co) = IfaceCo <$> rnIfaceCo co
617 rnIfaceExpr (IfaceTuple sort args) = IfaceTuple sort <$> rnIfaceExprs args
618 rnIfaceExpr (IfaceLam lam_bndr expr)
619 = IfaceLam <$> rnIfaceLamBndr lam_bndr <*> rnIfaceExpr expr
620 rnIfaceExpr (IfaceApp fun arg)
621 = IfaceApp <$> rnIfaceExpr fun <*> rnIfaceExpr arg
622 rnIfaceExpr (IfaceCase scrut case_bndr alts)
623 = IfaceCase <$> rnIfaceExpr scrut
624 <*> pure case_bndr
625 <*> mapM rnIfaceAlt alts
626 rnIfaceExpr (IfaceECase scrut ty)
627 = IfaceECase <$> rnIfaceExpr scrut <*> rnIfaceType ty
628 rnIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
629 = IfaceLet <$> (IfaceNonRec <$> rnIfaceLetBndr bndr <*> rnIfaceExpr rhs)
630 <*> rnIfaceExpr body
631 rnIfaceExpr (IfaceLet (IfaceRec pairs) body)
632 = IfaceLet <$> (IfaceRec <$> mapM (\(bndr, rhs) ->
633 (,) <$> rnIfaceLetBndr bndr
634 <*> rnIfaceExpr rhs) pairs)
635 <*> rnIfaceExpr body
636 rnIfaceExpr (IfaceCast expr co)
637 = IfaceCast <$> rnIfaceExpr expr <*> rnIfaceCo co
638 rnIfaceExpr (IfaceLit lit) = pure (IfaceLit lit)
639 rnIfaceExpr (IfaceLitRubbish rep) = IfaceLitRubbish <$> rnIfaceType rep
640 rnIfaceExpr (IfaceFCall cc ty) = IfaceFCall cc <$> rnIfaceType ty
641 rnIfaceExpr (IfaceTick tickish expr) = IfaceTick tickish <$> rnIfaceExpr expr
642
643 rnIfaceBndrs :: Rename [IfaceBndr]
644 rnIfaceBndrs = mapM rnIfaceBndr
645
646 rnIfaceBndr :: Rename IfaceBndr
647 rnIfaceBndr (IfaceIdBndr (w, fs, ty)) = IfaceIdBndr <$> ((,,) w fs <$> rnIfaceType ty)
648 rnIfaceBndr (IfaceTvBndr tv_bndr) = IfaceTvBndr <$> rnIfaceTvBndr tv_bndr
649
650 rnIfaceTvBndr :: Rename IfaceTvBndr
651 rnIfaceTvBndr (fs, kind) = (,) fs <$> rnIfaceType kind
652
653 rnIfaceTyConBinder :: Rename IfaceTyConBinder
654 rnIfaceTyConBinder (Bndr tv vis) = Bndr <$> rnIfaceBndr tv <*> pure vis
655
656 rnIfaceAlt :: Rename IfaceAlt
657 rnIfaceAlt (IfaceAlt conalt names rhs)
658 = IfaceAlt <$> rnIfaceConAlt conalt <*> pure names <*> rnIfaceExpr rhs
659
660 rnIfaceConAlt :: Rename IfaceConAlt
661 rnIfaceConAlt (IfaceDataAlt data_occ) = IfaceDataAlt <$> rnIfaceGlobal data_occ
662 rnIfaceConAlt alt = pure alt
663
664 rnIfaceLetBndr :: Rename IfaceLetBndr
665 rnIfaceLetBndr (IfLetBndr fs ty info jpi)
666 = IfLetBndr fs <$> rnIfaceType ty <*> rnIfaceIdInfo info <*> pure jpi
667
668 rnIfaceLamBndr :: Rename IfaceLamBndr
669 rnIfaceLamBndr (bndr, oneshot) = (,) <$> rnIfaceBndr bndr <*> pure oneshot
670
671 rnIfaceMCo :: Rename IfaceMCoercion
672 rnIfaceMCo IfaceMRefl = pure IfaceMRefl
673 rnIfaceMCo (IfaceMCo co) = IfaceMCo <$> rnIfaceCo co
674
675 rnIfaceCo :: Rename IfaceCoercion
676 rnIfaceCo (IfaceReflCo ty) = IfaceReflCo <$> rnIfaceType ty
677 rnIfaceCo (IfaceGReflCo role ty mco)
678 = IfaceGReflCo role <$> rnIfaceType ty <*> rnIfaceMCo mco
679 rnIfaceCo (IfaceFunCo role w co1 co2)
680 = IfaceFunCo role <$> rnIfaceCo w <*> rnIfaceCo co1 <*> rnIfaceCo co2
681 rnIfaceCo (IfaceTyConAppCo role tc cos)
682 = IfaceTyConAppCo role <$> rnIfaceTyCon tc <*> mapM rnIfaceCo cos
683 rnIfaceCo (IfaceAppCo co1 co2)
684 = IfaceAppCo <$> rnIfaceCo co1 <*> rnIfaceCo co2
685 rnIfaceCo (IfaceForAllCo bndr co1 co2)
686 = IfaceForAllCo <$> rnIfaceBndr bndr <*> rnIfaceCo co1 <*> rnIfaceCo co2
687 rnIfaceCo (IfaceFreeCoVar c) = pure (IfaceFreeCoVar c)
688 rnIfaceCo (IfaceCoVarCo lcl) = IfaceCoVarCo <$> pure lcl
689 rnIfaceCo (IfaceHoleCo lcl) = IfaceHoleCo <$> pure lcl
690 rnIfaceCo (IfaceAxiomInstCo n i cs)
691 = IfaceAxiomInstCo <$> rnIfaceGlobal n <*> pure i <*> mapM rnIfaceCo cs
692 rnIfaceCo (IfaceUnivCo s r t1 t2)
693 = IfaceUnivCo s r <$> rnIfaceType t1 <*> rnIfaceType t2
694 rnIfaceCo (IfaceSymCo c)
695 = IfaceSymCo <$> rnIfaceCo c
696 rnIfaceCo (IfaceTransCo c1 c2)
697 = IfaceTransCo <$> rnIfaceCo c1 <*> rnIfaceCo c2
698 rnIfaceCo (IfaceInstCo c1 c2)
699 = IfaceInstCo <$> rnIfaceCo c1 <*> rnIfaceCo c2
700 rnIfaceCo (IfaceNthCo d c) = IfaceNthCo d <$> rnIfaceCo c
701 rnIfaceCo (IfaceLRCo lr c) = IfaceLRCo lr <$> rnIfaceCo c
702 rnIfaceCo (IfaceSubCo c) = IfaceSubCo <$> rnIfaceCo c
703 rnIfaceCo (IfaceAxiomRuleCo ax cos)
704 = IfaceAxiomRuleCo ax <$> mapM rnIfaceCo cos
705 rnIfaceCo (IfaceKindCo c) = IfaceKindCo <$> rnIfaceCo c
706
707 rnIfaceTyCon :: Rename IfaceTyCon
708 rnIfaceTyCon (IfaceTyCon n info)
709 = IfaceTyCon <$> rnIfaceGlobal n <*> pure info
710
711 rnIfaceExprs :: Rename [IfaceExpr]
712 rnIfaceExprs = mapM rnIfaceExpr
713
714 rnIfaceIdDetails :: Rename IfaceIdDetails
715 rnIfaceIdDetails (IfRecSelId (Left tc) b) = IfRecSelId <$> fmap Left (rnIfaceTyCon tc) <*> pure b
716 rnIfaceIdDetails (IfRecSelId (Right decl) b) = IfRecSelId <$> fmap Right (rnIfaceDecl decl) <*> pure b
717 rnIfaceIdDetails details = pure details
718
719 rnIfaceType :: Rename IfaceType
720 rnIfaceType (IfaceFreeTyVar n) = pure (IfaceFreeTyVar n)
721 rnIfaceType (IfaceTyVar n) = pure (IfaceTyVar n)
722 rnIfaceType (IfaceAppTy t1 t2)
723 = IfaceAppTy <$> rnIfaceType t1 <*> rnIfaceAppArgs t2
724 rnIfaceType (IfaceLitTy l) = return (IfaceLitTy l)
725 rnIfaceType (IfaceFunTy af w t1 t2)
726 = IfaceFunTy af <$> rnIfaceType w <*> rnIfaceType t1 <*> rnIfaceType t2
727 rnIfaceType (IfaceTupleTy s i tks)
728 = IfaceTupleTy s i <$> rnIfaceAppArgs tks
729 rnIfaceType (IfaceTyConApp tc tks)
730 = IfaceTyConApp <$> rnIfaceTyCon tc <*> rnIfaceAppArgs tks
731 rnIfaceType (IfaceForAllTy tv t)
732 = IfaceForAllTy <$> rnIfaceForAllBndr tv <*> rnIfaceType t
733 rnIfaceType (IfaceCoercionTy co)
734 = IfaceCoercionTy <$> rnIfaceCo co
735 rnIfaceType (IfaceCastTy ty co)
736 = IfaceCastTy <$> rnIfaceType ty <*> rnIfaceCo co
737
738 rnIfaceScaledType :: Rename (IfaceMult, IfaceType)
739 rnIfaceScaledType (m, t) = (,) <$> rnIfaceType m <*> rnIfaceType t
740
741 rnIfaceForAllBndr :: Rename (VarBndr IfaceBndr flag)
742 rnIfaceForAllBndr (Bndr tv vis) = Bndr <$> rnIfaceBndr tv <*> pure vis
743
744 rnIfaceAppArgs :: Rename IfaceAppArgs
745 rnIfaceAppArgs (IA_Arg t a ts) = IA_Arg <$> rnIfaceType t <*> pure a
746 <*> rnIfaceAppArgs ts
747 rnIfaceAppArgs IA_Nil = pure IA_Nil