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