Make equality constraints in kinds invisible
[ghc.git] / compiler / iface / ToIface.hs
1 {-# LANGUAGE CPP #-}
2
3 -- | Functions for converting Core things to interface file things.
4 module ToIface
5 ( -- * Binders
6 toIfaceTvBndr
7 , toIfaceTvBndrs
8 , toIfaceIdBndr
9 , toIfaceBndr
10 , toIfaceForAllBndr
11 , toIfaceTyCoVarBinders
12 , toIfaceTyVar
13 -- * Types
14 , toIfaceType, toIfaceTypeX
15 , toIfaceKind
16 , toIfaceTcArgs
17 , toIfaceTyCon
18 , toIfaceTyCon_name
19 , toIfaceTyLit
20 -- * Tidying types
21 , tidyToIfaceType
22 , tidyToIfaceContext
23 , tidyToIfaceTcArgs
24 -- * Coercions
25 , toIfaceCoercion, toIfaceCoercionX
26 -- * Pattern synonyms
27 , patSynToIfaceDecl
28 -- * Expressions
29 , toIfaceExpr
30 , toIfaceBang
31 , toIfaceSrcBang
32 , toIfaceLetBndr
33 , toIfaceIdDetails
34 , toIfaceIdInfo
35 , toIfUnfolding
36 , toIfaceOneShot
37 , toIfaceTickish
38 , toIfaceBind
39 , toIfaceAlt
40 , toIfaceCon
41 , toIfaceApp
42 , toIfaceVar
43 ) where
44
45 #include "HsVersions.h"
46
47 import GhcPrelude
48
49 import IfaceSyn
50 import DataCon
51 import Id
52 import IdInfo
53 import CoreSyn
54 import TyCon hiding ( pprPromotionQuote )
55 import CoAxiom
56 import TysPrim ( eqPrimTyCon, eqReprPrimTyCon )
57 import TysWiredIn ( heqTyCon )
58 import MkId ( noinlineIdName )
59 import PrelNames
60 import Name
61 import BasicTypes
62 import Type
63 import PatSyn
64 import Outputable
65 import FastString
66 import Util
67 import Var
68 import VarEnv
69 import VarSet
70 import TyCoRep
71 import Demand ( isTopSig )
72
73 import Data.Maybe ( catMaybes )
74
75 ----------------
76 toIfaceTvBndr :: TyVar -> IfaceTvBndr
77 toIfaceTvBndr = toIfaceTvBndrX emptyVarSet
78
79 toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr
80 toIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar)
81 , toIfaceTypeX fr (tyVarKind tyvar)
82 )
83
84 toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
85 toIfaceTvBndrs = map toIfaceTvBndr
86
87 toIfaceIdBndr :: Id -> IfaceIdBndr
88 toIfaceIdBndr = toIfaceIdBndrX emptyVarSet
89
90 toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr
91 toIfaceIdBndrX fr covar = ( occNameFS (getOccName covar)
92 , toIfaceTypeX fr (varType covar)
93 )
94
95 toIfaceBndr :: Var -> IfaceBndr
96 toIfaceBndr var
97 | isId var = IfaceIdBndr (toIfaceIdBndr var)
98 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
99
100 toIfaceBndrX :: VarSet -> Var -> IfaceBndr
101 toIfaceBndrX fr var
102 | isId var = IfaceIdBndr (toIfaceIdBndrX fr var)
103 | otherwise = IfaceTvBndr (toIfaceTvBndrX fr var)
104
105 toIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis
106 toIfaceTyCoVarBinder (Bndr tv vis) = Bndr (toIfaceBndr tv) vis
107
108 toIfaceTyCoVarBinders :: [VarBndr Var vis] -> [VarBndr IfaceBndr vis]
109 toIfaceTyCoVarBinders = map toIfaceTyCoVarBinder
110
111 {-
112 ************************************************************************
113 * *
114 Conversion from Type to IfaceType
115 * *
116 ************************************************************************
117 -}
118
119 toIfaceKind :: Type -> IfaceType
120 toIfaceKind = toIfaceType
121
122 ---------------------
123 toIfaceType :: Type -> IfaceType
124 toIfaceType = toIfaceTypeX emptyVarSet
125
126 toIfaceTypeX :: VarSet -> Type -> IfaceType
127 -- (toIfaceTypeX free ty)
128 -- translates the tyvars in 'free' as IfaceFreeTyVars
129 --
130 -- Synonyms are retained in the interface type
131 toIfaceTypeX fr (TyVarTy tv) -- See Note [TcTyVars in IfaceType] in IfaceType
132 | tv `elemVarSet` fr = IfaceFreeTyVar tv
133 | otherwise = IfaceTyVar (toIfaceTyVar tv)
134 toIfaceTypeX fr ty@(AppTy {}) =
135 -- Flatten as many argument AppTys as possible, then turn them into an
136 -- IfaceAppArgs list.
137 -- See Note [Suppressing invisible arguments] in IfaceType.
138 let (head, args) = splitAppTys ty
139 in IfaceAppTy (toIfaceTypeX fr head) (toIfaceAppTyArgsX fr head args)
140 toIfaceTypeX _ (LitTy n) = IfaceLitTy (toIfaceTyLit n)
141 toIfaceTypeX fr (ForAllTy b t) = IfaceForAllTy (toIfaceForAllBndrX fr b)
142 (toIfaceTypeX (fr `delVarSet` binderVar b) t)
143 toIfaceTypeX fr (FunTy { ft_arg = t1, ft_res = t2, ft_af = af })
144 = IfaceFunTy af (toIfaceTypeX fr t1) (toIfaceTypeX fr t2)
145 toIfaceTypeX fr (CastTy ty co) = IfaceCastTy (toIfaceTypeX fr ty) (toIfaceCoercionX fr co)
146 toIfaceTypeX fr (CoercionTy co) = IfaceCoercionTy (toIfaceCoercionX fr co)
147
148 toIfaceTypeX fr (TyConApp tc tys)
149 -- tuples
150 | Just sort <- tyConTuple_maybe tc
151 , n_tys == arity
152 = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys)
153
154 | Just dc <- isPromotedDataCon_maybe tc
155 , isTupleDataCon dc
156 , n_tys == 2*arity
157 = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys))
158
159 | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ]
160 , (k1:k2:_) <- tys
161 = let info = IfaceTyConInfo NotPromoted sort
162 sort | k1 `eqType` k2 = IfaceEqualityTyCon
163 | otherwise = IfaceNormalTyCon
164 in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys)
165
166 -- other applications
167 | otherwise
168 = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgsX fr tc tys)
169 where
170 arity = tyConArity tc
171 n_tys = length tys
172
173 toIfaceTyVar :: TyVar -> FastString
174 toIfaceTyVar = occNameFS . getOccName
175
176 toIfaceCoVar :: CoVar -> FastString
177 toIfaceCoVar = occNameFS . getOccName
178
179 toIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr
180 toIfaceForAllBndr = toIfaceForAllBndrX emptyVarSet
181
182 toIfaceForAllBndrX :: VarSet -> TyCoVarBinder -> IfaceForAllBndr
183 toIfaceForAllBndrX fr (Bndr v vis) = Bndr (toIfaceBndrX fr v) vis
184
185 ----------------
186 toIfaceTyCon :: TyCon -> IfaceTyCon
187 toIfaceTyCon tc
188 = IfaceTyCon tc_name info
189 where
190 tc_name = tyConName tc
191 info = IfaceTyConInfo promoted sort
192 promoted | isPromotedDataCon tc = IsPromoted
193 | otherwise = NotPromoted
194
195 tupleSort :: TyCon -> Maybe IfaceTyConSort
196 tupleSort tc' =
197 case tyConTuple_maybe tc' of
198 Just UnboxedTuple -> let arity = tyConArity tc' `div` 2
199 in Just $ IfaceTupleTyCon arity UnboxedTuple
200 Just sort -> let arity = tyConArity tc'
201 in Just $ IfaceTupleTyCon arity sort
202 Nothing -> Nothing
203
204 sort
205 | Just tsort <- tupleSort tc = tsort
206
207 | Just dcon <- isPromotedDataCon_maybe tc
208 , let tc' = dataConTyCon dcon
209 , Just tsort <- tupleSort tc' = tsort
210
211 | isUnboxedSumTyCon tc
212 , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons)
213
214 | otherwise = IfaceNormalTyCon
215
216
217 toIfaceTyCon_name :: Name -> IfaceTyCon
218 toIfaceTyCon_name n = IfaceTyCon n info
219 where info = IfaceTyConInfo NotPromoted IfaceNormalTyCon
220 -- Used for the "rough-match" tycon stuff,
221 -- where pretty-printing is not an issue
222
223 toIfaceTyLit :: TyLit -> IfaceTyLit
224 toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x
225 toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x
226
227 ----------------
228 toIfaceCoercion :: Coercion -> IfaceCoercion
229 toIfaceCoercion = toIfaceCoercionX emptyVarSet
230
231 toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
232 -- (toIfaceCoercionX free ty)
233 -- translates the tyvars in 'free' as IfaceFreeTyVars
234 toIfaceCoercionX fr co
235 = go co
236 where
237 go_mco MRefl = IfaceMRefl
238 go_mco (MCo co) = IfaceMCo $ go co
239
240 go (Refl ty) = IfaceReflCo (toIfaceTypeX fr ty)
241 go (GRefl r ty mco) = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco)
242 go (CoVarCo cv)
243 -- See [TcTyVars in IfaceType] in IfaceType
244 | cv `elemVarSet` fr = IfaceFreeCoVar cv
245 | otherwise = IfaceCoVarCo (toIfaceCoVar cv)
246 go (HoleCo h) = IfaceHoleCo (coHoleCoVar h)
247
248 go (AppCo co1 co2) = IfaceAppCo (go co1) (go co2)
249 go (SymCo co) = IfaceSymCo (go co)
250 go (TransCo co1 co2) = IfaceTransCo (go co1) (go co2)
251 go (NthCo _r d co) = IfaceNthCo d (go co)
252 go (LRCo lr co) = IfaceLRCo lr (go co)
253 go (InstCo co arg) = IfaceInstCo (go co) (go arg)
254 go (KindCo c) = IfaceKindCo (go c)
255 go (SubCo co) = IfaceSubCo (go co)
256 go (AxiomRuleCo co cs) = IfaceAxiomRuleCo (coaxrName co) (map go cs)
257 go (AxiomInstCo c i cs) = IfaceAxiomInstCo (coAxiomName c) i (map go cs)
258 go (UnivCo p r t1 t2) = IfaceUnivCo (go_prov p) r
259 (toIfaceTypeX fr t1)
260 (toIfaceTypeX fr t2)
261 go (TyConAppCo r tc cos)
262 | tc `hasKey` funTyConKey
263 , [_,_,_,_] <- cos = pprPanic "toIfaceCoercion" (ppr co)
264 | otherwise = IfaceTyConAppCo r (toIfaceTyCon tc) (map go cos)
265 go (FunCo r co1 co2) = IfaceFunCo r (go co1) (go co2)
266
267 go (ForAllCo tv k co) = IfaceForAllCo (toIfaceBndr tv)
268 (toIfaceCoercionX fr' k)
269 (toIfaceCoercionX fr' co)
270 where
271 fr' = fr `delVarSet` tv
272
273 go_prov :: UnivCoProvenance -> IfaceUnivCoProv
274 go_prov UnsafeCoerceProv = IfaceUnsafeCoerceProv
275 go_prov (PhantomProv co) = IfacePhantomProv (go co)
276 go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co)
277 go_prov (PluginProv str) = IfacePluginProv str
278
279 toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
280 toIfaceTcArgs = toIfaceTcArgsX emptyVarSet
281
282 toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs
283 toIfaceTcArgsX fr tc ty_args = toIfaceAppArgsX fr (tyConKind tc) ty_args
284
285 toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
286 toIfaceAppTyArgsX fr ty ty_args = toIfaceAppArgsX fr (typeKind ty) ty_args
287
288 toIfaceAppArgsX :: VarSet -> Kind -> [Type] -> IfaceAppArgs
289 -- See Note [Suppressing invisible arguments] in IfaceType
290 -- We produce a result list of args describing visibility
291 -- The awkward case is
292 -- T :: forall k. * -> k
293 -- And consider
294 -- T (forall j. blah) * blib
295 -- Is 'blib' visible? It depends on the visibility flag on j,
296 -- so we have to substitute for k. Annoying!
297 toIfaceAppArgsX fr kind ty_args
298 = go (mkEmptyTCvSubst in_scope) kind ty_args
299 where
300 in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)
301
302 go _ _ [] = IA_Nil
303 go env ty ts
304 | Just ty' <- coreView ty
305 = go env ty' ts
306 go env (ForAllTy (Bndr tv vis) res) (t:ts)
307 = IA_Arg t' vis ts'
308 where
309 t' = toIfaceTypeX fr t
310 ts' = go (extendTCvSubst env tv t) res ts
311
312 go env (FunTy { ft_af = af, ft_res = res }) (t:ts)
313 = IA_Arg (toIfaceTypeX fr t) argf (go env res ts)
314 where
315 argf = case af of
316 VisArg -> Required
317 InvisArg -> Inferred
318 -- It's rare for a kind to have a constraint argument, but
319 -- it can happen. See Note [AnonTCB InvisArg] in TyCon.
320
321 go env ty ts@(t1:ts1)
322 | not (isEmptyTCvSubst env)
323 = go (zapTCvSubst env) (substTy env ty) ts
324 -- See Note [Care with kind instantiation] in Type.hs
325
326 | otherwise
327 = -- There's a kind error in the type we are trying to print
328 -- e.g. kind = k, ty_args = [Int]
329 -- This is probably a compiler bug, so we print a trace and
330 -- carry on as if it were FunTy. Without the test for
331 -- isEmptyTCvSubst we'd get an infinite loop (#15473)
332 WARN( True, ppr kind $$ ppr ty_args )
333 IA_Arg (toIfaceTypeX fr t1) Required (go env ty ts1)
334
335 tidyToIfaceType :: TidyEnv -> Type -> IfaceType
336 tidyToIfaceType env ty = toIfaceType (tidyType env ty)
337
338 tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
339 tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
340
341 tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
342 tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
343
344 {-
345 ************************************************************************
346 * *
347 Conversion of pattern synonyms
348 * *
349 ************************************************************************
350 -}
351
352 patSynToIfaceDecl :: PatSyn -> IfaceDecl
353 patSynToIfaceDecl ps
354 = IfacePatSyn { ifName = getName $ ps
355 , ifPatMatcher = to_if_pr (patSynMatcher ps)
356 , ifPatBuilder = fmap to_if_pr (patSynBuilder ps)
357 , ifPatIsInfix = patSynIsInfix ps
358 , ifPatUnivBndrs = map toIfaceForAllBndr univ_bndrs'
359 , ifPatExBndrs = map toIfaceForAllBndr ex_bndrs'
360 , ifPatProvCtxt = tidyToIfaceContext env2 prov_theta
361 , ifPatReqCtxt = tidyToIfaceContext env2 req_theta
362 , ifPatArgs = map (tidyToIfaceType env2) args
363 , ifPatTy = tidyToIfaceType env2 rhs_ty
364 , ifFieldLabels = (patSynFieldLabels ps)
365 }
366 where
367 (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
368 univ_bndrs = patSynUnivTyVarBinders ps
369 ex_bndrs = patSynExTyVarBinders ps
370 (env1, univ_bndrs') = tidyTyCoVarBinders emptyTidyEnv univ_bndrs
371 (env2, ex_bndrs') = tidyTyCoVarBinders env1 ex_bndrs
372 to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
373
374 {-
375 ************************************************************************
376 * *
377 Conversion of other things
378 * *
379 ************************************************************************
380 -}
381
382 toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
383 toIfaceBang _ HsLazy = IfNoBang
384 toIfaceBang _ (HsUnpack Nothing) = IfUnpack
385 toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))
386 toIfaceBang _ HsStrict = IfStrict
387
388 toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
389 toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang
390
391 toIfaceLetBndr :: Id -> IfaceLetBndr
392 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
393 (toIfaceType (idType id))
394 (toIfaceIdInfo (idInfo id))
395 (toIfaceJoinInfo (isJoinId_maybe id))
396 -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr
397 -- has left on the Id. See Note [IdInfo on nested let-bindings] in IfaceSyn
398
399 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
400 toIfaceIdDetails VanillaId = IfVanillaId
401 toIfaceIdDetails (DFunId {}) = IfDFunId
402 toIfaceIdDetails (RecSelId { sel_naughty = n
403 , sel_tycon = tc }) =
404 let iface = case tc of
405 RecSelData ty_con -> Left (toIfaceTyCon ty_con)
406 RecSelPatSyn pat_syn -> Right (patSynToIfaceDecl pat_syn)
407 in IfRecSelId iface n
408
409 -- The remaining cases are all "implicit Ids" which don't
410 -- appear in interface files at all
411 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
412 IfVanillaId -- Unexpected; the other
413
414 toIfaceIdInfo :: IdInfo -> IfaceIdInfo
415 toIfaceIdInfo id_info
416 = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
417 inline_hsinfo, unfold_hsinfo, levity_hsinfo] of
418 [] -> NoInfo
419 infos -> HasInfo infos
420 -- NB: strictness and arity must appear in the list before unfolding
421 -- See TcIface.tcUnfolding
422 where
423 ------------ Arity --------------
424 arity_info = arityInfo id_info
425 arity_hsinfo | arity_info == 0 = Nothing
426 | otherwise = Just (HsArity arity_info)
427
428 ------------ Caf Info --------------
429 caf_info = cafInfo id_info
430 caf_hsinfo = case caf_info of
431 NoCafRefs -> Just HsNoCafRefs
432 _other -> Nothing
433
434 ------------ Strictness --------------
435 -- No point in explicitly exporting TopSig
436 sig_info = strictnessInfo id_info
437 strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
438 | otherwise = Nothing
439
440 ------------ Unfolding --------------
441 unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
442 loop_breaker = isStrongLoopBreaker (occInfo id_info)
443
444 ------------ Inline prag --------------
445 inline_prag = inlinePragInfo id_info
446 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
447 | otherwise = Just (HsInline inline_prag)
448
449 ------------ Levity polymorphism ----------
450 levity_hsinfo | isNeverLevPolyIdInfo id_info = Just HsLevity
451 | otherwise = Nothing
452
453 toIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo
454 toIfaceJoinInfo (Just ar) = IfaceJoinPoint ar
455 toIfaceJoinInfo Nothing = IfaceNotJoinPoint
456
457 --------------------------
458 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
459 toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
460 , uf_src = src
461 , uf_guidance = guidance })
462 = Just $ HsUnfold lb $
463 case src of
464 InlineStable
465 -> case guidance of
466 UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }
467 -> IfInlineRule arity unsat_ok boring_ok if_rhs
468 _other -> IfCoreUnfold True if_rhs
469 InlineCompulsory -> IfCompulsory if_rhs
470 InlineRhs -> IfCoreUnfold False if_rhs
471 -- Yes, even if guidance is UnfNever, expose the unfolding
472 -- If we didn't want to expose the unfolding, TidyPgm would
473 -- have stuck in NoUnfolding. For supercompilation we want
474 -- to see that unfolding!
475 where
476 if_rhs = toIfaceExpr rhs
477
478 toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
479 = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
480 -- No need to serialise the data constructor;
481 -- we can recover it from the type of the dfun
482
483 toIfUnfolding _ (OtherCon {}) = Nothing
484 -- The binding site of an Id doesn't have OtherCon, except perhaps
485 -- where we have called zapUnfolding; and that evald'ness info is
486 -- not needed by importing modules
487
488 toIfUnfolding _ BootUnfolding = Nothing
489 -- Can't happen; we only have BootUnfolding for imported binders
490
491 toIfUnfolding _ NoUnfolding = Nothing
492
493 {-
494 ************************************************************************
495 * *
496 Conversion of expressions
497 * *
498 ************************************************************************
499 -}
500
501 toIfaceExpr :: CoreExpr -> IfaceExpr
502 toIfaceExpr (Var v) = toIfaceVar v
503 toIfaceExpr (Lit l) = IfaceLit l
504 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
505 toIfaceExpr (Coercion co) = IfaceCo (toIfaceCoercion co)
506 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b)
507 toIfaceExpr (App f a) = toIfaceApp f [a]
508 toIfaceExpr (Case s x ty as)
509 | null as = IfaceECase (toIfaceExpr s) (toIfaceType ty)
510 | otherwise = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)
511 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
512 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)
513 toIfaceExpr (Tick t e)
514 | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e)
515 | otherwise = toIfaceExpr e
516
517 toIfaceOneShot :: Id -> IfaceOneShot
518 toIfaceOneShot id | isId id
519 , OneShotLam <- oneShotInfo (idInfo id)
520 = IfaceOneShot
521 | otherwise
522 = IfaceNoOneShot
523
524 ---------------------
525 toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
526 toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
527 toIfaceTickish (HpcTick modl ix) = Just (IfaceHpcTick modl ix)
528 toIfaceTickish (SourceNote src names) = Just (IfaceSource src names)
529 toIfaceTickish (Breakpoint {}) = Nothing
530 -- Ignore breakpoints, since they are relevant only to GHCi, and
531 -- should not be serialised (#8333)
532
533 ---------------------
534 toIfaceBind :: Bind Id -> IfaceBinding
535 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
536 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
537
538 ---------------------
539 toIfaceAlt :: (AltCon, [Var], CoreExpr)
540 -> (IfaceConAlt, [FastString], IfaceExpr)
541 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getOccFS bs, toIfaceExpr r)
542
543 ---------------------
544 toIfaceCon :: AltCon -> IfaceConAlt
545 toIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)
546 toIfaceCon (LitAlt l) = IfaceLitAlt l
547 toIfaceCon DEFAULT = IfaceDefault
548
549 ---------------------
550 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
551 toIfaceApp (App f a) as = toIfaceApp f (a:as)
552 toIfaceApp (Var v) as
553 = case isDataConWorkId_maybe v of
554 -- We convert the *worker* for tuples into IfaceTuples
555 Just dc | saturated
556 , Just tup_sort <- tyConTuple_maybe tc
557 -> IfaceTuple tup_sort tup_args
558 where
559 val_args = dropWhile isTypeArg as
560 saturated = val_args `lengthIs` idArity v
561 tup_args = map toIfaceExpr val_args
562 tc = dataConTyCon dc
563
564 _ -> mkIfaceApps (toIfaceVar v) as
565
566 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
567
568 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
569 mkIfaceApps f as = foldl' (\f a -> IfaceApp f (toIfaceExpr a)) f as
570
571 ---------------------
572 toIfaceVar :: Id -> IfaceExpr
573 toIfaceVar v
574 | isBootUnfolding (idUnfolding v)
575 = -- See Note [Inlining and hs-boot files]
576 IfaceApp (IfaceApp (IfaceExt noinlineIdName)
577 (IfaceType (toIfaceType (idType v))))
578 (IfaceExt name) -- don't use mkIfaceApps, or infinite loop
579
580 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
581 -- Foreign calls have special syntax
582
583 | isExternalName name = IfaceExt name
584 | otherwise = IfaceLcl (getOccFS name)
585 where name = idName v
586
587
588 {- Note [Inlining and hs-boot files]
589 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
590 Consider this example (#10083, #12789):
591
592 ---------- RSR.hs-boot ------------
593 module RSR where
594 data RSR
595 eqRSR :: RSR -> RSR -> Bool
596
597 ---------- SR.hs ------------
598 module SR where
599 import {-# SOURCE #-} RSR
600 data SR = MkSR RSR
601 eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2
602
603 ---------- RSR.hs ------------
604 module RSR where
605 import SR
606 data RSR = MkRSR SR -- deriving( Eq )
607 eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)
608 foo x y = not (eqRSR x y)
609
610 When compiling RSR we get this code
611
612 RSR.eqRSR :: RSR -> RSR -> Bool
613 RSR.eqRSR = \ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->
614 case ds1 of _ { RSR.MkRSR s1 ->
615 case ds2 of _ { RSR.MkRSR s2 ->
616 SR.eqSR s1 s2 }}
617
618 RSR.foo :: RSR -> RSR -> Bool
619 RSR.foo = \ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)
620
621 Now, when optimising foo:
622 Inline eqRSR (small, non-rec)
623 Inline eqSR (small, non-rec)
624 but the result of inlining eqSR from SR is another call to eqRSR, so
625 everything repeats. Neither eqSR nor eqRSR are (apparently) loop
626 breakers.
627
628 Solution: in the unfolding of eqSR in SR.hi, replace `eqRSR` in SR
629 with `noinline eqRSR`, so that eqRSR doesn't get inlined. This means
630 that when GHC inlines `eqSR`, it will not also inline `eqRSR`, exactly
631 as would have been the case if `foo` had been defined in SR.hs (and
632 marked as a loop-breaker).
633
634 But how do we arrange for this to happen? There are two ingredients:
635
636 1. When we serialize out unfoldings to IfaceExprs (toIfaceVar),
637 for every variable reference we see if we are referring to an
638 'Id' that came from an hs-boot file. If so, we add a `noinline`
639 to the reference.
640
641 2. But how do we know if a reference came from an hs-boot file
642 or not? We could record this directly in the 'IdInfo', but
643 actually we deduce this by looking at the unfolding: 'Id's
644 that come from boot files are given a special unfolding
645 (upon typechecking) 'BootUnfolding' which say that there is
646 no unfolding, and the reason is because the 'Id' came from
647 a boot file.
648
649 Here is a solution that doesn't work: when compiling RSR,
650 add a NOINLINE pragma to every function exported by the boot-file
651 for RSR (if it exists). Doing so makes the bootstrapped GHC itself
652 slower by 8% overall (on #9872a-d, and T1969: the reason
653 is that these NOINLINE'd functions now can't be profitably inlined
654 outside of the hs-boot loop.
655
656 -}