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