Fix nasty bug in w/w for absence analysis
[ghc.git] / compiler / basicTypes / MkId.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The AQUA Project, Glasgow University, 1998
4
5
6 This module contains definitions for the IdInfo for things that
7 have a standard form, namely:
8
9 - data constructors
10 - record selectors
11 - method and superclass selectors
12 - primitive operations
13 -}
14
15 {-# LANGUAGE CPP #-}
16
17 module MkId (
18 mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,
19
20 mkPrimOpId, mkFCallId,
21
22 wrapNewTypeBody, unwrapNewTypeBody,
23 wrapFamInstBody, unwrapFamInstScrut,
24 wrapTypeUnbranchedFamInstBody, unwrapTypeUnbranchedFamInstScrut,
25
26 DataConBoxer(..), mkDataConRep, mkDataConWorkId,
27
28 -- And some particular Ids; see below for why they are wired in
29 wiredInIds, ghcPrimIds,
30 unsafeCoerceName, unsafeCoerceId, realWorldPrimId,
31 voidPrimId, voidArgId,
32 nullAddrId, seqId, lazyId, lazyIdKey, runRWId,
33 coercionTokenId, magicDictId, coerceId,
34 proxyHashId, noinlineId, noinlineIdName,
35
36 -- Re-export error Ids
37 module PrelRules
38 ) where
39
40 #include "HsVersions.h"
41
42 import GhcPrelude
43
44 import Rules
45 import TysPrim
46 import TysWiredIn
47 import PrelRules
48 import Type
49 import FamInstEnv
50 import Coercion
51 import TcType
52 import MkCore
53 import CoreUtils ( exprType, mkCast )
54 import CoreUnfold
55 import Literal
56 import TyCon
57 import CoAxiom
58 import Class
59 import NameSet
60 import Name
61 import PrimOp
62 import ForeignCall
63 import DataCon
64 import Id
65 import IdInfo
66 import Demand
67 import CoreSyn
68 import Unique
69 import UniqSupply
70 import PrelNames
71 import BasicTypes hiding ( SuccessFlag(..) )
72 import Util
73 import Pair
74 import DynFlags
75 import Outputable
76 import FastString
77 import ListSetOps
78 import qualified GHC.LanguageExtensions as LangExt
79
80 import Data.Maybe ( maybeToList )
81
82 {-
83 ************************************************************************
84 * *
85 \subsection{Wired in Ids}
86 * *
87 ************************************************************************
88
89 Note [Wired-in Ids]
90 ~~~~~~~~~~~~~~~~~~~
91 There are several reasons why an Id might appear in the wiredInIds:
92
93 (1) The ghcPrimIds are wired in because they can't be defined in
94 Haskell at all, although the can be defined in Core. They have
95 compulsory unfoldings, so they are always inlined and they have
96 no definition site. Their home module is GHC.Prim, so they
97 also have a description in primops.txt.pp, where they are called
98 'pseudoops'.
99
100 (2) The 'error' function, eRROR_ID, is wired in because we don't yet have
101 a way to express in an interface file that the result type variable
102 is 'open'; that is can be unified with an unboxed type
103
104 [The interface file format now carry such information, but there's
105 no way yet of expressing at the definition site for these
106 error-reporting functions that they have an 'open'
107 result type. -- sof 1/99]
108
109 (3) Other error functions (rUNTIME_ERROR_ID) are wired in (a) because
110 the desugarer generates code that mentions them directly, and
111 (b) for the same reason as eRROR_ID
112
113 (4) lazyId is wired in because the wired-in version overrides the
114 strictness of the version defined in GHC.Base
115
116 (5) noinlineId is wired in because when we serialize to interfaces
117 we may insert noinline statements.
118
119 In cases (2-4), the function has a definition in a library module, and
120 can be called; but the wired-in version means that the details are
121 never read from that module's interface file; instead, the full definition
122 is right here.
123 -}
124
125 wiredInIds :: [Id]
126 wiredInIds
127 = [lazyId, dollarId, oneShotId, runRWId, noinlineId]
128 ++ errorIds -- Defined in MkCore
129 ++ ghcPrimIds
130
131 -- These Ids are exported from GHC.Prim
132 ghcPrimIds :: [Id]
133 ghcPrimIds
134 = [ -- These can't be defined in Haskell, but they have
135 -- perfectly reasonable unfoldings in Core
136 realWorldPrimId,
137 voidPrimId,
138 unsafeCoerceId,
139 nullAddrId,
140 seqId,
141 magicDictId,
142 coerceId,
143 proxyHashId
144 ]
145
146 {-
147 ************************************************************************
148 * *
149 \subsection{Data constructors}
150 * *
151 ************************************************************************
152
153 The wrapper for a constructor is an ordinary top-level binding that evaluates
154 any strict args, unboxes any args that are going to be flattened, and calls
155 the worker.
156
157 We're going to build a constructor that looks like:
158
159 data (Data a, C b) => T a b = T1 !a !Int b
160
161 T1 = /\ a b ->
162 \d1::Data a, d2::C b ->
163 \p q r -> case p of { p ->
164 case q of { q ->
165 Con T1 [a,b] [p,q,r]}}
166
167 Notice that
168
169 * d2 is thrown away --- a context in a data decl is used to make sure
170 one *could* construct dictionaries at the site the constructor
171 is used, but the dictionary isn't actually used.
172
173 * We have to check that we can construct Data dictionaries for
174 the types a and Int. Once we've done that we can throw d1 away too.
175
176 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
177 all that matters is that the arguments are evaluated. "seq" is
178 very careful to preserve evaluation order, which we don't need
179 to be here.
180
181 You might think that we could simply give constructors some strictness
182 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
183 But we don't do that because in the case of primops and functions strictness
184 is a *property* not a *requirement*. In the case of constructors we need to
185 do something active to evaluate the argument.
186
187 Making an explicit case expression allows the simplifier to eliminate
188 it in the (common) case where the constructor arg is already evaluated.
189
190 Note [Wrappers for data instance tycons]
191 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
192 In the case of data instances, the wrapper also applies the coercion turning
193 the representation type into the family instance type to cast the result of
194 the wrapper. For example, consider the declarations
195
196 data family Map k :: * -> *
197 data instance Map (a, b) v = MapPair (Map a (Pair b v))
198
199 The tycon to which the datacon MapPair belongs gets a unique internal
200 name of the form :R123Map, and we call it the representation tycon.
201 In contrast, Map is the family tycon (accessible via
202 tyConFamInst_maybe). A coercion allows you to move between
203 representation and family type. It is accessible from :R123Map via
204 tyConFamilyCoercion_maybe and has kind
205
206 Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
207
208 The wrapper and worker of MapPair get the types
209
210 -- Wrapper
211 $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v
212 $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)
213
214 -- Worker
215 MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v
216
217 This coercion is conditionally applied by wrapFamInstBody.
218
219 It's a bit more complicated if the data instance is a GADT as well!
220
221 data instance T [a] where
222 T1 :: forall b. b -> T [Maybe b]
223
224 Hence we translate to
225
226 -- Wrapper
227 $WT1 :: forall b. b -> T [Maybe b]
228 $WT1 b v = T1 (Maybe b) b (Maybe b) v
229 `cast` sym (Co7T (Maybe b))
230
231 -- Worker
232 T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
233
234 -- Coercion from family type to representation type
235 Co7T a :: T [a] ~ :R7T a
236
237 Note [Newtype datacons]
238 ~~~~~~~~~~~~~~~~~~~~~~~
239 The "data constructor" for a newtype should always be vanilla. At one
240 point this wasn't true, because the newtype arising from
241 class C a => D a
242 looked like
243 newtype T:D a = D:D (C a)
244 so the data constructor for T:C had a single argument, namely the
245 predicate (C a). But now we treat that as an ordinary argument, not
246 part of the theta-type, so all is well.
247
248
249 ************************************************************************
250 * *
251 \subsection{Dictionary selectors}
252 * *
253 ************************************************************************
254
255 Selecting a field for a dictionary. If there is just one field, then
256 there's nothing to do.
257
258 Dictionary selectors may get nested forall-types. Thus:
259
260 class Foo a where
261 op :: forall b. Ord b => a -> b -> b
262
263 Then the top-level type for op is
264
265 op :: forall a. Foo a =>
266 forall b. Ord b =>
267 a -> b -> b
268
269 -}
270
271 mkDictSelId :: Name -- Name of one of the *value* selectors
272 -- (dictionary superclass or method)
273 -> Class -> Id
274 mkDictSelId name clas
275 = mkGlobalId (ClassOpId clas) name sel_ty info
276 where
277 tycon = classTyCon clas
278 sel_names = map idName (classAllSelIds clas)
279 new_tycon = isNewTyCon tycon
280 [data_con] = tyConDataCons tycon
281 tyvars = dataConUnivTyVarBinders data_con
282 n_ty_args = length tyvars
283 arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses
284 val_index = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
285
286 sel_ty = mkForAllTys tyvars $
287 mkFunTy (mkClassPred clas (mkTyVarTys (binderVars tyvars))) $
288 getNth arg_tys val_index
289
290 base_info = noCafIdInfo
291 `setArityInfo` 1
292 `setStrictnessInfo` strict_sig
293 `setLevityInfoWithType` sel_ty
294
295 info | new_tycon
296 = base_info `setInlinePragInfo` alwaysInlinePragma
297 `setUnfoldingInfo` mkInlineUnfoldingWithArity 1
298 (mkDictSelRhs clas val_index)
299 -- See Note [Single-method classes] in TcInstDcls
300 -- for why alwaysInlinePragma
301
302 | otherwise
303 = base_info `setRuleInfo` mkRuleInfo [rule]
304 -- Add a magic BuiltinRule, but no unfolding
305 -- so that the rule is always available to fire.
306 -- See Note [ClassOp/DFun selection] in TcInstDcls
307
308 -- This is the built-in rule that goes
309 -- op (dfT d1 d2) ---> opT d1 d2
310 rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
311 occNameFS (getOccName name)
312 , ru_fn = name
313 , ru_nargs = n_ty_args + 1
314 , ru_try = dictSelRule val_index n_ty_args }
315
316 -- The strictness signature is of the form U(AAAVAAAA) -> T
317 -- where the V depends on which item we are selecting
318 -- It's worth giving one, so that absence info etc is generated
319 -- even if the selector isn't inlined
320
321 strict_sig = mkClosedStrictSig [arg_dmd] topRes
322 arg_dmd | new_tycon = evalDmd
323 | otherwise = mkManyUsedDmd $
324 mkProdDmd [ if name == sel_name then evalDmd else absDmd
325 | sel_name <- sel_names ]
326
327 mkDictSelRhs :: Class
328 -> Int -- 0-indexed selector among (superclasses ++ methods)
329 -> CoreExpr
330 mkDictSelRhs clas val_index
331 = mkLams tyvars (Lam dict_id rhs_body)
332 where
333 tycon = classTyCon clas
334 new_tycon = isNewTyCon tycon
335 [data_con] = tyConDataCons tycon
336 tyvars = dataConUnivTyVars data_con
337 arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses
338
339 the_arg_id = getNth arg_ids val_index
340 pred = mkClassPred clas (mkTyVarTys tyvars)
341 dict_id = mkTemplateLocal 1 pred
342 arg_ids = mkTemplateLocalsNum 2 arg_tys
343
344 rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars) (Var dict_id)
345 | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
346 [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
347 -- varToCoreExpr needed for equality superclass selectors
348 -- sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
349
350 dictSelRule :: Int -> Arity -> RuleFun
351 -- Tries to persuade the argument to look like a constructor
352 -- application, using exprIsConApp_maybe, and then selects
353 -- from it
354 -- sel_i t1..tk (D t1..tk op1 ... opm) = opi
355 --
356 dictSelRule val_index n_ty_args _ id_unf _ args
357 | (dict_arg : _) <- drop n_ty_args args
358 , Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
359 = Just (getNth con_args val_index)
360 | otherwise
361 = Nothing
362
363 {-
364 ************************************************************************
365 * *
366 Data constructors
367 * *
368 ************************************************************************
369 -}
370
371 mkDataConWorkId :: Name -> DataCon -> Id
372 mkDataConWorkId wkr_name data_con
373 | isNewTyCon tycon
374 = mkGlobalId (DataConWrapId data_con) wkr_name nt_wrap_ty nt_work_info
375 | otherwise
376 = mkGlobalId (DataConWorkId data_con) wkr_name alg_wkr_ty wkr_info
377
378 where
379 tycon = dataConTyCon data_con
380
381 ----------- Workers for data types --------------
382 alg_wkr_ty = dataConRepType data_con
383 wkr_arity = dataConRepArity data_con
384 wkr_info = noCafIdInfo
385 `setArityInfo` wkr_arity
386 `setStrictnessInfo` wkr_sig
387 `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
388 -- even if arity = 0
389 `setLevityInfoWithType` alg_wkr_ty
390 -- NB: unboxed tuples have workers, so we can't use
391 -- setNeverLevPoly
392
393 wkr_sig = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con)
394 -- Note [Data-con worker strictness]
395 -- Notice that we do *not* say the worker Id is strict
396 -- even if the data constructor is declared strict
397 -- e.g. data T = MkT !(Int,Int)
398 -- Why? Because the *wrapper* $WMkT is strict (and its unfolding has
399 -- case expressions that do the evals) but the *worker* MkT itself is
400 -- not. If we pretend it is strict then when we see
401 -- case x of y -> MkT y
402 -- the simplifier thinks that y is "sure to be evaluated" (because
403 -- the worker MkT is strict) and drops the case. No, the workerId
404 -- MkT is not strict.
405 --
406 -- However, the worker does have StrictnessMarks. When the simplifier
407 -- sees a pattern
408 -- case e of MkT x -> ...
409 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
410 -- but that's fine... dataConRepStrictness comes from the data con
411 -- not from the worker Id.
412
413 ----------- Workers for newtypes --------------
414 (nt_tvs, _, nt_arg_tys, _) = dataConSig data_con
415 res_ty_args = mkTyVarTys nt_tvs
416 nt_wrap_ty = dataConUserType data_con
417 nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
418 `setArityInfo` 1 -- Arity 1
419 `setInlinePragInfo` alwaysInlinePragma
420 `setUnfoldingInfo` newtype_unf
421 `setLevityInfoWithType` nt_wrap_ty
422 id_arg1 = mkTemplateLocal 1 (head nt_arg_tys)
423 newtype_unf = ASSERT2( isVanillaDataCon data_con &&
424 isSingleton nt_arg_tys, ppr data_con )
425 -- Note [Newtype datacons]
426 mkCompulsoryUnfolding $
427 mkLams nt_tvs $ Lam id_arg1 $
428 wrapNewTypeBody tycon res_ty_args (Var id_arg1)
429
430 dataConCPR :: DataCon -> DmdResult
431 dataConCPR con
432 | isDataTyCon tycon -- Real data types only; that is,
433 -- not unboxed tuples or newtypes
434 , null (dataConExTyVars con) -- No existentials
435 , wkr_arity > 0
436 , wkr_arity <= mAX_CPR_SIZE
437 = if is_prod then vanillaCprProdRes (dataConRepArity con)
438 else cprSumRes (dataConTag con)
439 | otherwise
440 = topRes
441 where
442 is_prod = isProductTyCon tycon
443 tycon = dataConTyCon con
444 wkr_arity = dataConRepArity con
445
446 mAX_CPR_SIZE :: Arity
447 mAX_CPR_SIZE = 10
448 -- We do not treat very big tuples as CPR-ish:
449 -- a) for a start we get into trouble because there aren't
450 -- "enough" unboxed tuple types (a tiresome restriction,
451 -- but hard to fix),
452 -- b) more importantly, big unboxed tuples get returned mainly
453 -- on the stack, and are often then allocated in the heap
454 -- by the caller. So doing CPR for them may in fact make
455 -- things worse.
456
457 {-
458 -------------------------------------------------
459 -- Data constructor representation
460 --
461 -- This is where we decide how to wrap/unwrap the
462 -- constructor fields
463 --
464 --------------------------------------------------
465 -}
466
467 type Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)
468 -- Unbox: bind rep vars by decomposing src var
469
470 data Boxer = UnitBox | Boxer (TCvSubst -> UniqSM ([Var], CoreExpr))
471 -- Box: build src arg using these rep vars
472
473 -- | Data Constructor Boxer
474 newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))
475 -- Bind these src-level vars, returning the
476 -- rep-level vars to bind in the pattern
477
478 {-
479 Note [Inline partially-applied constructor wrappers]
480 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
481
482 We allow the wrapper to inline when partially applied to avoid
483 boxing values unnecessarily. For example, consider
484
485 data Foo a = Foo !Int a
486
487 instance Traversable Foo where
488 traverse f (Foo i a) = Foo i <$> f a
489
490 This desugars to
491
492 traverse f foo = case foo of
493 Foo i# a -> let i = I# i#
494 in map ($WFoo i) (f a)
495
496 If the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`.
497 But if we inline the wrapper, we get
498
499 map (\a. case i of I# i# a -> Foo i# a) (f a)
500
501 and now case-of-known-constructor eliminates the redundant allocation.
502 -}
503
504 mkDataConRep :: DynFlags
505 -> FamInstEnvs
506 -> Name
507 -> Maybe [HsImplBang]
508 -- See Note [Bangs on imported data constructors]
509 -> DataCon
510 -> UniqSM DataConRep
511 mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
512 | not wrapper_reqd
513 = return NoDataConRep
514
515 | otherwise
516 = do { wrap_args <- mapM newLocal wrap_arg_tys
517 ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers)
518 initial_wrap_app
519
520 ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info
521 wrap_info = noCafIdInfo
522 `setArityInfo` wrap_arity
523 -- It's important to specify the arity, so that partial
524 -- applications are treated as values
525 `setInlinePragInfo` wrap_prag
526 `setUnfoldingInfo` wrap_unf
527 `setStrictnessInfo` wrap_sig
528 -- We need to get the CAF info right here because TidyPgm
529 -- does not tidy the IdInfo of implicit bindings (like the wrapper)
530 -- so it not make sure that the CAF info is sane
531 `setNeverLevPoly` wrap_ty
532
533 wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR data_con)
534
535 wrap_arg_dmds =
536 replicate (length theta) topDmd ++ map mk_dmd arg_ibangs
537 -- Don't forget the dictionary arguments when building
538 -- the strictness signature (#14290).
539
540 mk_dmd str | isBanged str = evalDmd
541 | otherwise = topDmd
542
543 wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`
544 ActiveAfter NoSourceText 2
545 -- See Note [Activation for data constructor wrappers]
546
547 -- The wrapper will usually be inlined (see wrap_unf), so its
548 -- strictness and CPR info is usually irrelevant. But this is
549 -- not always the case; GHC may choose not to inline it. In
550 -- particular, the wrapper constructor is not inlined inside
551 -- an INLINE rhs or when it is not applied to any arguments.
552 -- See Note [Inline partially-applied constructor wrappers]
553 -- Passing Nothing here allows the wrapper to inline when
554 -- unsaturated.
555 wrap_unf = mkInlineUnfolding wrap_rhs
556 wrap_tvs = (univ_tvs `minusList` map eqSpecTyVar eq_spec) ++ ex_tvs
557 wrap_rhs = mkLams wrap_tvs $
558 mkLams wrap_args $
559 wrapFamInstBody tycon res_ty_args $
560 wrap_body
561
562 ; return (DCR { dcr_wrap_id = wrap_id
563 , dcr_boxer = mk_boxer boxers
564 , dcr_arg_tys = rep_tys
565 , dcr_stricts = rep_strs
566 , dcr_bangs = arg_ibangs }) }
567
568 where
569 (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty)
570 = dataConFullSig data_con
571 res_ty_args = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs
572
573 tycon = dataConTyCon data_con -- The representation TyCon (not family)
574 wrap_ty = dataConUserType data_con
575 ev_tys = eqSpecPreds eq_spec ++ theta
576 all_arg_tys = ev_tys ++ orig_arg_tys
577 ev_ibangs = map (const HsLazy) ev_tys
578 orig_bangs = dataConSrcBangs data_con
579
580 wrap_arg_tys = theta ++ orig_arg_tys
581 wrap_arity = length wrap_arg_tys
582 -- The wrap_args are the arguments *other than* the eq_spec
583 -- Because we are going to apply the eq_spec args manually in the
584 -- wrapper
585
586 arg_ibangs =
587 case mb_bangs of
588 Nothing -> zipWith (dataConSrcToImplBang dflags fam_envs)
589 orig_arg_tys orig_bangs
590 Just bangs -> bangs
591
592 (rep_tys_w_strs, wrappers)
593 = unzip (zipWith dataConArgRep all_arg_tys (ev_ibangs ++ arg_ibangs))
594
595 (unboxers, boxers) = unzip wrappers
596 (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
597
598 wrapper_reqd = not (isNewTyCon tycon) -- Newtypes have only a worker
599 && (any isBanged (ev_ibangs ++ arg_ibangs)
600 -- Some forcing/unboxing (includes eq_spec)
601 || isFamInstTyCon tycon -- Cast result
602 || (not $ null eq_spec)) -- GADT
603
604 initial_wrap_app = Var (dataConWorkId data_con)
605 `mkTyApps` res_ty_args
606 `mkVarApps` ex_tvs
607 `mkCoApps` map (mkReflCo Nominal . eqSpecType) eq_spec
608
609 mk_boxer :: [Boxer] -> DataConBoxer
610 mk_boxer boxers = DCB (\ ty_args src_vars ->
611 do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars
612 subst1 = zipTvSubst univ_tvs ty_args
613 subst2 = extendTvSubstList subst1 ex_tvs
614 (mkTyVarTys ex_vars)
615 ; (rep_ids, binds) <- go subst2 boxers term_vars
616 ; return (ex_vars ++ rep_ids, binds) } )
617
618 go _ [] src_vars = ASSERT2( null src_vars, ppr data_con ) return ([], [])
619 go subst (UnitBox : boxers) (src_var : src_vars)
620 = do { (rep_ids2, binds) <- go subst boxers src_vars
621 ; return (src_var : rep_ids2, binds) }
622 go subst (Boxer boxer : boxers) (src_var : src_vars)
623 = do { (rep_ids1, arg) <- boxer subst
624 ; (rep_ids2, binds) <- go subst boxers src_vars
625 ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }
626 go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con)
627
628 mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr
629 mk_rep_app [] con_app
630 = return con_app
631 mk_rep_app ((wrap_arg, unboxer) : prs) con_app
632 = do { (rep_ids, unbox_fn) <- unboxer wrap_arg
633 ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
634 ; return (unbox_fn expr) }
635
636 {- Note [Activation for data constructor wrappers]
637 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
638 The Activation on a data constructor wrapper allows it to inline in
639 Phase 2 and later (1, 0). But not in the InitialPhase. That gives
640 rewrite rules a chance to fire (in the InitialPhase) if they mention
641 a data constructor on the left
642 RULE "foo" f (K a b) = ...
643 Since the LHS of rules are simplified with InitialPhase, we won't
644 inline the wrapper on the LHS either.
645
646 People have asked for this before, but now that even the InitialPhase
647 does some inlining, it has become important.
648
649
650 Note [Bangs on imported data constructors]
651 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
652
653 We pass Maybe [HsImplBang] to mkDataConRep to make use of HsImplBangs
654 from imported modules.
655
656 - Nothing <=> use HsSrcBangs
657 - Just bangs <=> use HsImplBangs
658
659 For imported types we can't work it all out from the HsSrcBangs,
660 because we want to be very sure to follow what the original module
661 (where the data type was declared) decided, and that depends on what
662 flags were enabled when it was compiled. So we record the decisions in
663 the interface file.
664
665 The HsImplBangs passed are in 1-1 correspondence with the
666 dataConOrigArgTys of the DataCon.
667
668 Note [Data con wrappers and unlifted types]
669 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
670 Consider
671 data T = MkT !Int#
672
673 We certainly do not want to make a wrapper
674 $WMkT x = case x of y { DEFAULT -> MkT y }
675
676 For a start, it's still to generate a no-op. But worse, since wrappers
677 are currently injected at TidyCore, we don't even optimise it away!
678 So the stupid case expression stays there. This actually happened for
679 the Integer data type (see Trac #1600 comment:66)!
680 -}
681
682 -------------------------
683 newLocal :: Type -> UniqSM Var
684 newLocal ty = do { uniq <- getUniqueM
685 ; return (mkSysLocalOrCoVar (fsLit "dt") uniq ty) }
686
687 -- | Unpack/Strictness decisions from source module
688 dataConSrcToImplBang
689 :: DynFlags
690 -> FamInstEnvs
691 -> Type
692 -> HsSrcBang
693 -> HsImplBang
694
695 dataConSrcToImplBang dflags fam_envs arg_ty
696 (HsSrcBang ann unpk NoSrcStrict)
697 | xopt LangExt.StrictData dflags -- StrictData => strict field
698 = dataConSrcToImplBang dflags fam_envs arg_ty
699 (HsSrcBang ann unpk SrcStrict)
700 | otherwise -- no StrictData => lazy field
701 = HsLazy
702
703 dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)
704 = HsLazy
705
706 dataConSrcToImplBang dflags fam_envs arg_ty
707 (HsSrcBang _ unpk_prag SrcStrict)
708 | isUnliftedType arg_ty
709 = HsLazy -- For !Int#, say, use HsLazy
710 -- See Note [Data con wrappers and unlifted types]
711
712 | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
713 -- Don't unpack if we aren't optimising; rather arbitrarily,
714 -- we use -fomit-iface-pragmas as the indication
715 , let mb_co = topNormaliseType_maybe fam_envs arg_ty
716 -- Unwrap type families and newtypes
717 arg_ty' = case mb_co of { Just (_,ty) -> ty; Nothing -> arg_ty }
718 , isUnpackableType dflags fam_envs arg_ty'
719 , (rep_tys, _) <- dataConArgUnpack arg_ty'
720 , case unpk_prag of
721 NoSrcUnpack ->
722 gopt Opt_UnboxStrictFields dflags
723 || (gopt Opt_UnboxSmallStrictFields dflags
724 && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]
725 srcUnpack -> isSrcUnpacked srcUnpack
726 = case mb_co of
727 Nothing -> HsUnpack Nothing
728 Just (co,_) -> HsUnpack (Just co)
729
730 | otherwise -- Record the strict-but-no-unpack decision
731 = HsStrict
732
733
734 -- | Wrappers/Workers and representation following Unpack/Strictness
735 -- decisions
736 dataConArgRep
737 :: Type
738 -> HsImplBang
739 -> ([(Type,StrictnessMark)] -- Rep types
740 ,(Unboxer,Boxer))
741
742 dataConArgRep arg_ty HsLazy
743 = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
744
745 dataConArgRep arg_ty HsStrict
746 = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))
747
748 dataConArgRep arg_ty (HsUnpack Nothing)
749 | (rep_tys, wrappers) <- dataConArgUnpack arg_ty
750 = (rep_tys, wrappers)
751
752 dataConArgRep _ (HsUnpack (Just co))
753 | let co_rep_ty = pSnd (coercionKind co)
754 , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty
755 = (rep_tys, wrapCo co co_rep_ty wrappers)
756
757
758 -------------------------
759 wrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer)
760 wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty
761 = (unboxer, boxer)
762 where
763 unboxer arg_id = do { rep_id <- newLocal rep_ty
764 ; (rep_ids, rep_fn) <- unbox_rep rep_id
765 ; let co_bind = NonRec rep_id (Var arg_id `Cast` co)
766 ; return (rep_ids, Let co_bind . rep_fn) }
767 boxer = Boxer $ \ subst ->
768 do { (rep_ids, rep_expr)
769 <- case box_rep of
770 UnitBox -> do { rep_id <- newLocal (TcType.substTy subst rep_ty)
771 ; return ([rep_id], Var rep_id) }
772 Boxer boxer -> boxer subst
773 ; let sco = substCoUnchecked subst co
774 ; return (rep_ids, rep_expr `Cast` mkSymCo sco) }
775
776 ------------------------
777 seqUnboxer :: Unboxer
778 seqUnboxer v = return ([v], \e -> Case (Var v) v (exprType e) [(DEFAULT, [], e)])
779
780 unitUnboxer :: Unboxer
781 unitUnboxer v = return ([v], \e -> e)
782
783 unitBoxer :: Boxer
784 unitBoxer = UnitBox
785
786 -------------------------
787 dataConArgUnpack
788 :: Type
789 -> ( [(Type, StrictnessMark)] -- Rep types
790 , (Unboxer, Boxer) )
791
792 dataConArgUnpack arg_ty
793 | Just (tc, tc_args) <- splitTyConApp_maybe arg_ty
794 , Just con <- tyConSingleAlgDataCon_maybe tc
795 -- NB: check for an *algebraic* data type
796 -- A recursive newtype might mean that
797 -- 'arg_ty' is a newtype
798 , let rep_tys = dataConInstArgTys con tc_args
799 = ASSERT( isVanillaDataCon con )
800 ( rep_tys `zip` dataConRepStrictness con
801 ,( \ arg_id ->
802 do { rep_ids <- mapM newLocal rep_tys
803 ; let unbox_fn body
804 = Case (Var arg_id) arg_id (exprType body)
805 [(DataAlt con, rep_ids, body)]
806 ; return (rep_ids, unbox_fn) }
807 , Boxer $ \ subst ->
808 do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys
809 ; return (rep_ids, Var (dataConWorkId con)
810 `mkTyApps` (substTysUnchecked subst tc_args)
811 `mkVarApps` rep_ids ) } ) )
812 | otherwise
813 = pprPanic "dataConArgUnpack" (ppr arg_ty)
814 -- An interface file specified Unpacked, but we couldn't unpack it
815
816 isUnpackableType :: DynFlags -> FamInstEnvs -> Type -> Bool
817 -- True if we can unpack the UNPACK the argument type
818 -- See Note [Recursive unboxing]
819 -- We look "deeply" inside rather than relying on the DataCons
820 -- we encounter on the way, because otherwise we might well
821 -- end up relying on ourselves!
822 isUnpackableType dflags fam_envs ty
823 | Just (tc, _) <- splitTyConApp_maybe ty
824 , Just con <- tyConSingleAlgDataCon_maybe tc
825 , isVanillaDataCon con
826 = ok_con_args (unitNameSet (getName tc)) con
827 | otherwise
828 = False
829 where
830 ok_arg tcs (ty, bang) = not (attempt_unpack bang) || ok_ty tcs norm_ty
831 where
832 norm_ty = topNormaliseType fam_envs ty
833 ok_ty tcs ty
834 | Just (tc, _) <- splitTyConApp_maybe ty
835 , let tc_name = getName tc
836 = not (tc_name `elemNameSet` tcs)
837 && case tyConSingleAlgDataCon_maybe tc of
838 Just con | isVanillaDataCon con
839 -> ok_con_args (tcs `extendNameSet` getName tc) con
840 _ -> True
841 | otherwise
842 = True
843
844 ok_con_args tcs con
845 = all (ok_arg tcs) (dataConOrigArgTys con `zip` dataConSrcBangs con)
846 -- NB: dataConSrcBangs gives the *user* request;
847 -- We'd get a black hole if we used dataConImplBangs
848
849 attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict)
850 = xopt LangExt.StrictData dflags
851 attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict)
852 = True
853 attempt_unpack (HsSrcBang _ NoSrcUnpack SrcStrict)
854 = True -- Be conservative
855 attempt_unpack (HsSrcBang _ NoSrcUnpack NoSrcStrict)
856 = xopt LangExt.StrictData dflags -- Be conservative
857 attempt_unpack _ = False
858
859 {-
860 Note [Unpack one-wide fields]
861 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
862 The flag UnboxSmallStrictFields ensures that any field that can
863 (safely) be unboxed to a word-sized unboxed field, should be so unboxed.
864 For example:
865
866 data A = A Int#
867 newtype B = B A
868 data C = C !B
869 data D = D !C
870 data E = E !()
871 data F = F !D
872 data G = G !F !F
873
874 All of these should have an Int# as their representation, except
875 G which should have two Int#s.
876
877 However
878
879 data T = T !(S Int)
880 data S = S !a
881
882 Here we can represent T with an Int#.
883
884 Note [Recursive unboxing]
885 ~~~~~~~~~~~~~~~~~~~~~~~~~
886 Consider
887 data R = MkR {-# UNPACK #-} !S Int
888 data S = MkS {-# UNPACK #-} !Int
889 The representation arguments of MkR are the *representation* arguments
890 of S (plus Int); the rep args of MkS are Int#. This is all fine.
891
892 But be careful not to try to unbox this!
893 data T = MkT {-# UNPACK #-} !T Int
894 Because then we'd get an infinite number of arguments.
895
896 Here is a more complicated case:
897 data S = MkS {-# UNPACK #-} !T Int
898 data T = MkT {-# UNPACK #-} !S Int
899 Each of S and T must decide independently whether to unpack
900 and they had better not both say yes. So they must both say no.
901
902 Also behave conservatively when there is no UNPACK pragma
903 data T = MkS !T Int
904 with -funbox-strict-fields or -funbox-small-strict-fields
905 we need to behave as if there was an UNPACK pragma there.
906
907 But it's the *argument* type that matters. This is fine:
908 data S = MkS S !Int
909 because Int is non-recursive.
910
911 ************************************************************************
912 * *
913 Wrapping and unwrapping newtypes and type families
914 * *
915 ************************************************************************
916 -}
917
918 wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
919 -- The wrapper for the data constructor for a newtype looks like this:
920 -- newtype T a = MkT (a,Int)
921 -- MkT :: forall a. (a,Int) -> T a
922 -- MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)
923 -- where CoT is the coercion TyCon associated with the newtype
924 --
925 -- The call (wrapNewTypeBody T [a] e) returns the
926 -- body of the wrapper, namely
927 -- e `cast` (CoT [a])
928 --
929 -- If a coercion constructor is provided in the newtype, then we use
930 -- it, otherwise the wrap/unwrap are both no-ops
931 --
932 -- If the we are dealing with a newtype *instance*, we have a second coercion
933 -- identifying the family instance with the constructor of the newtype
934 -- instance. This coercion is applied in any case (ie, composed with the
935 -- coercion constructor of the newtype or applied by itself).
936
937 wrapNewTypeBody tycon args result_expr
938 = ASSERT( isNewTyCon tycon )
939 wrapFamInstBody tycon args $
940 mkCast result_expr (mkSymCo co)
941 where
942 co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args []
943
944 -- When unwrapping, we do *not* apply any family coercion, because this will
945 -- be done via a CoPat by the type checker. We have to do it this way as
946 -- computing the right type arguments for the coercion requires more than just
947 -- a spliting operation (cf, TcPat.tcConPat).
948
949 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
950 unwrapNewTypeBody tycon args result_expr
951 = ASSERT( isNewTyCon tycon )
952 mkCast result_expr (mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [])
953
954 -- If the type constructor is a representation type of a data instance, wrap
955 -- the expression into a cast adjusting the expression type, which is an
956 -- instance of the representation type, to the corresponding instance of the
957 -- family instance type.
958 -- See Note [Wrappers for data instance tycons]
959 wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
960 wrapFamInstBody tycon args body
961 | Just co_con <- tyConFamilyCoercion_maybe tycon
962 = mkCast body (mkSymCo (mkUnbranchedAxInstCo Representational co_con args []))
963 | otherwise
964 = body
965
966 -- Same as `wrapFamInstBody`, but for type family instances, which are
967 -- represented by a `CoAxiom`, and not a `TyCon`
968 wrapTypeFamInstBody :: CoAxiom br -> Int -> [Type] -> [Coercion]
969 -> CoreExpr -> CoreExpr
970 wrapTypeFamInstBody axiom ind args cos body
971 = mkCast body (mkSymCo (mkAxInstCo Representational axiom ind args cos))
972
973 wrapTypeUnbranchedFamInstBody :: CoAxiom Unbranched -> [Type] -> [Coercion]
974 -> CoreExpr -> CoreExpr
975 wrapTypeUnbranchedFamInstBody axiom
976 = wrapTypeFamInstBody axiom 0
977
978 unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
979 unwrapFamInstScrut tycon args scrut
980 | Just co_con <- tyConFamilyCoercion_maybe tycon
981 = mkCast scrut (mkUnbranchedAxInstCo Representational co_con args []) -- data instances only
982 | otherwise
983 = scrut
984
985 unwrapTypeFamInstScrut :: CoAxiom br -> Int -> [Type] -> [Coercion]
986 -> CoreExpr -> CoreExpr
987 unwrapTypeFamInstScrut axiom ind args cos scrut
988 = mkCast scrut (mkAxInstCo Representational axiom ind args cos)
989
990 unwrapTypeUnbranchedFamInstScrut :: CoAxiom Unbranched -> [Type] -> [Coercion]
991 -> CoreExpr -> CoreExpr
992 unwrapTypeUnbranchedFamInstScrut axiom
993 = unwrapTypeFamInstScrut axiom 0
994
995 {-
996 ************************************************************************
997 * *
998 \subsection{Primitive operations}
999 * *
1000 ************************************************************************
1001 -}
1002
1003 mkPrimOpId :: PrimOp -> Id
1004 mkPrimOpId prim_op
1005 = id
1006 where
1007 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
1008 ty = mkSpecForAllTys tyvars (mkFunTys arg_tys res_ty)
1009 name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
1010 (mkPrimOpIdUnique (primOpTag prim_op))
1011 (AnId id) UserSyntax
1012 id = mkGlobalId (PrimOpId prim_op) name ty info
1013
1014 info = noCafIdInfo
1015 `setRuleInfo` mkRuleInfo (maybeToList $ primOpRules name prim_op)
1016 `setArityInfo` arity
1017 `setStrictnessInfo` strict_sig
1018 `setInlinePragInfo` neverInlinePragma
1019 `setLevityInfoWithType` res_ty
1020 -- We give PrimOps a NOINLINE pragma so that we don't
1021 -- get silly warnings from Desugar.dsRule (the inline_shadows_rule
1022 -- test) about a RULE conflicting with a possible inlining
1023 -- cf Trac #7287
1024
1025 -- For each ccall we manufacture a separate CCallOpId, giving it
1026 -- a fresh unique, a type that is correct for this particular ccall,
1027 -- and a CCall structure that gives the correct details about calling
1028 -- convention etc.
1029 --
1030 -- The *name* of this Id is a local name whose OccName gives the full
1031 -- details of the ccall, type and all. This means that the interface
1032 -- file reader can reconstruct a suitable Id
1033
1034 mkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id
1035 mkFCallId dflags uniq fcall ty
1036 = ASSERT( noFreeVarsOfType ty )
1037 -- A CCallOpId should have no free type variables;
1038 -- when doing substitutions won't substitute over it
1039 mkGlobalId (FCallId fcall) name ty info
1040 where
1041 occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))
1042 -- The "occurrence name" of a ccall is the full info about the
1043 -- ccall; it is encoded, but may have embedded spaces etc!
1044
1045 name = mkFCallName uniq occ_str
1046
1047 info = noCafIdInfo
1048 `setArityInfo` arity
1049 `setStrictnessInfo` strict_sig
1050 `setLevityInfoWithType` ty
1051
1052 (bndrs, _) = tcSplitPiTys ty
1053 arity = count isAnonTyBinder bndrs
1054 strict_sig = mkClosedStrictSig (replicate arity topDmd) topRes
1055 -- the call does not claim to be strict in its arguments, since they
1056 -- may be lifted (foreign import prim) and the called code doesn't
1057 -- necessarily force them. See Trac #11076.
1058 {-
1059 ************************************************************************
1060 * *
1061 \subsection{DictFuns and default methods}
1062 * *
1063 ************************************************************************
1064
1065 Note [Dict funs and default methods]
1066 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1067 Dict funs and default methods are *not* ImplicitIds. Their definition
1068 involves user-written code, so we can't figure out their strictness etc
1069 based on fixed info, as we can for constructors and record selectors (say).
1070
1071 NB: See also Note [Exported LocalIds] in Id
1072 -}
1073
1074 mkDictFunId :: Name -- Name to use for the dict fun;
1075 -> [TyVar]
1076 -> ThetaType
1077 -> Class
1078 -> [Type]
1079 -> Id
1080 -- Implements the DFun Superclass Invariant (see TcInstDcls)
1081 -- See Note [Dict funs and default methods]
1082
1083 mkDictFunId dfun_name tvs theta clas tys
1084 = mkExportedLocalId (DFunId is_nt)
1085 dfun_name
1086 dfun_ty
1087 where
1088 is_nt = isNewTyCon (classTyCon clas)
1089 dfun_ty = mkDictFunTy tvs theta clas tys
1090
1091 mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type
1092 mkDictFunTy tvs theta clas tys
1093 = mkSpecSigmaTy tvs theta (mkClassPred clas tys)
1094
1095 {-
1096 ************************************************************************
1097 * *
1098 \subsection{Un-definable}
1099 * *
1100 ************************************************************************
1101
1102 These Ids can't be defined in Haskell. They could be defined in
1103 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
1104 ensure that they were definitely, definitely inlined, because there is
1105 no curried identifier for them. That's what mkCompulsoryUnfolding
1106 does. If we had a way to get a compulsory unfolding from an interface
1107 file, we could do that, but we don't right now.
1108
1109 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
1110 just gets expanded into a type coercion wherever it occurs. Hence we
1111 add it as a built-in Id with an unfolding here.
1112
1113 The type variables we use here are "open" type variables: this means
1114 they can unify with both unlifted and lifted types. Hence we provide
1115 another gun with which to shoot yourself in the foot.
1116 -}
1117
1118 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
1119 realWorldName, voidPrimIdName, coercionTokenName,
1120 magicDictName, coerceName, proxyName, dollarName, oneShotName,
1121 runRWName, noinlineIdName :: Name
1122 unsafeCoerceName = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey unsafeCoerceId
1123 nullAddrName = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#") nullAddrIdKey nullAddrId
1124 seqName = mkWiredInIdName gHC_PRIM (fsLit "seq") seqIdKey seqId
1125 realWorldName = mkWiredInIdName gHC_PRIM (fsLit "realWorld#") realWorldPrimIdKey realWorldPrimId
1126 voidPrimIdName = mkWiredInIdName gHC_PRIM (fsLit "void#") voidPrimIdKey voidPrimId
1127 lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey lazyId
1128 coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
1129 magicDictName = mkWiredInIdName gHC_PRIM (fsLit "magicDict") magicDictKey magicDictId
1130 coerceName = mkWiredInIdName gHC_PRIM (fsLit "coerce") coerceKey coerceId
1131 proxyName = mkWiredInIdName gHC_PRIM (fsLit "proxy#") proxyHashKey proxyHashId
1132 dollarName = mkWiredInIdName gHC_BASE (fsLit "$") dollarIdKey dollarId
1133 oneShotName = mkWiredInIdName gHC_MAGIC (fsLit "oneShot") oneShotKey oneShotId
1134 runRWName = mkWiredInIdName gHC_MAGIC (fsLit "runRW#") runRWKey runRWId
1135 noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId
1136
1137 dollarId :: Id -- Note [dollarId magic]
1138 dollarId = pcMiscPrelId dollarName ty
1139 (noCafIdInfo `setUnfoldingInfo` unf)
1140 where
1141 fun_ty = mkFunTy alphaTy openBetaTy
1142 ty = mkSpecForAllTys [runtimeRep2TyVar, alphaTyVar, openBetaTyVar] $
1143 mkFunTy fun_ty fun_ty
1144 unf = mkInlineUnfoldingWithArity 2 rhs
1145 [f,x] = mkTemplateLocals [fun_ty, alphaTy]
1146 rhs = mkLams [runtimeRep2TyVar, alphaTyVar, openBetaTyVar, f, x] $
1147 App (Var f) (Var x)
1148
1149 ------------------------------------------------
1150 proxyHashId :: Id
1151 proxyHashId
1152 = pcMiscPrelId proxyName ty
1153 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1154 `setNeverLevPoly` ty )
1155 where
1156 -- proxy# :: forall k (a:k). Proxy# k a
1157 bndrs = mkTemplateKiTyVars [liftedTypeKind] (\ks -> ks)
1158 [k,t] = mkTyVarTys bndrs
1159 ty = mkSpecForAllTys bndrs (mkProxyPrimTy k t)
1160
1161 ------------------------------------------------
1162 unsafeCoerceId :: Id
1163 unsafeCoerceId
1164 = pcMiscPrelId unsafeCoerceName ty info
1165 where
1166 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1167 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1168
1169 -- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
1170 -- (a :: TYPE r1) (b :: TYPE r2).
1171 -- a -> b
1172 bndrs = mkTemplateKiTyVars [runtimeRepTy, runtimeRepTy]
1173 (\ks -> map tYPE ks)
1174
1175 [_, _, a, b] = mkTyVarTys bndrs
1176
1177 ty = mkSpecForAllTys bndrs (mkFunTy a b)
1178
1179 [x] = mkTemplateLocals [a]
1180 rhs = mkLams (bndrs ++ [x]) $
1181 Cast (Var x) (mkUnsafeCo Representational a b)
1182
1183 ------------------------------------------------
1184 nullAddrId :: Id
1185 -- nullAddr# :: Addr#
1186 -- The reason it is here is because we don't provide
1187 -- a way to write this literal in Haskell.
1188 nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
1189 where
1190 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1191 `setUnfoldingInfo` mkCompulsoryUnfolding (Lit nullAddrLit)
1192 `setNeverLevPoly` addrPrimTy
1193
1194 ------------------------------------------------
1195 seqId :: Id -- See Note [seqId magic]
1196 seqId = pcMiscPrelId seqName ty info
1197 where
1198 info = noCafIdInfo `setInlinePragInfo` inline_prag
1199 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1200 `setNeverLevPoly` ty
1201
1202 inline_prag
1203 = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
1204 NoSourceText 0
1205 -- Make 'seq' not inline-always, so that simpleOptExpr
1206 -- (see CoreSubst.simple_app) won't inline 'seq' on the
1207 -- LHS of rules. That way we can have rules for 'seq';
1208 -- see Note [seqId magic]
1209
1210 ty = mkSpecForAllTys [alphaTyVar,betaTyVar]
1211 (mkFunTy alphaTy (mkFunTy betaTy betaTy))
1212
1213 [x,y] = mkTemplateLocals [alphaTy, betaTy]
1214 rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
1215
1216 ------------------------------------------------
1217 lazyId :: Id -- See Note [lazyId magic]
1218 lazyId = pcMiscPrelId lazyIdName ty info
1219 where
1220 info = noCafIdInfo `setNeverLevPoly` ty
1221 ty = mkSpecForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
1222
1223 noinlineId :: Id -- See Note [noinlineId magic]
1224 noinlineId = pcMiscPrelId noinlineIdName ty info
1225 where
1226 info = noCafIdInfo `setNeverLevPoly` ty
1227 ty = mkSpecForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
1228
1229 oneShotId :: Id -- See Note [The oneShot function]
1230 oneShotId = pcMiscPrelId oneShotName ty info
1231 where
1232 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1233 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1234 ty = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar
1235 , openAlphaTyVar, openBetaTyVar ]
1236 (mkFunTy fun_ty fun_ty)
1237 fun_ty = mkFunTy openAlphaTy openBetaTy
1238 [body, x] = mkTemplateLocals [fun_ty, openAlphaTy]
1239 x' = setOneShotLambda x
1240 rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar
1241 , openAlphaTyVar, openBetaTyVar
1242 , body, x'] $
1243 Var body `App` Var x
1244
1245 runRWId :: Id -- See Note [runRW magic] in this module
1246 runRWId = pcMiscPrelId runRWName ty info
1247 where
1248 info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
1249 `setStrictnessInfo` strict_sig
1250 `setArityInfo` 1
1251 strict_sig = mkClosedStrictSig [strictApply1Dmd] topRes
1252 -- Important to express its strictness,
1253 -- since it is not inlined until CorePrep
1254 -- Also see Note [runRW arg] in CorePrep
1255
1256 -- State# RealWorld
1257 stateRW = mkTyConApp statePrimTyCon [realWorldTy]
1258 -- o
1259 ret_ty = openAlphaTy
1260 -- State# RealWorld -> o
1261 arg_ty = stateRW `mkFunTy` ret_ty
1262 -- (State# RealWorld -> o) -> o
1263 ty = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar] $
1264 arg_ty `mkFunTy` ret_ty
1265
1266 --------------------------------------------------------------------------------
1267 magicDictId :: Id -- See Note [magicDictId magic]
1268 magicDictId = pcMiscPrelId magicDictName ty info
1269 where
1270 info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
1271 `setNeverLevPoly` ty
1272 ty = mkSpecForAllTys [alphaTyVar] alphaTy
1273
1274 --------------------------------------------------------------------------------
1275
1276 coerceId :: Id
1277 coerceId = pcMiscPrelId coerceName ty info
1278 where
1279 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1280 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1281 `setNeverLevPoly` ty
1282 eqRTy = mkTyConApp coercibleTyCon [ liftedTypeKind
1283 , alphaTy, betaTy ]
1284 eqRPrimTy = mkTyConApp eqReprPrimTyCon [ liftedTypeKind
1285 , liftedTypeKind
1286 , alphaTy, betaTy ]
1287 ty = mkSpecForAllTys [alphaTyVar, betaTyVar] $
1288 mkFunTys [eqRTy, alphaTy] betaTy
1289
1290 [eqR,x,eq] = mkTemplateLocals [eqRTy, alphaTy, eqRPrimTy]
1291 rhs = mkLams [alphaTyVar, betaTyVar, eqR, x] $
1292 mkWildCase (Var eqR) eqRTy betaTy $
1293 [(DataAlt coercibleDataCon, [eq], Cast (Var x) (mkCoVarCo eq))]
1294
1295 {-
1296 Note [dollarId magic]
1297 ~~~~~~~~~~~~~~~~~~~~~
1298 The only reason that ($) is wired in is so that its type can be
1299 forall (a:*, b:Open). (a->b) -> a -> b
1300 That is, the return type can be unboxed. E.g. this is OK
1301 foo $ True where foo :: Bool -> Int#
1302 because ($) doesn't inspect or move the result of the call to foo.
1303 See Trac #8739.
1304
1305 There is a special typing rule for ($) in TcExpr, so the type of ($)
1306 isn't looked at there, BUT Lint subsequently (and rightly) complains
1307 if sees ($) applied to Int# (say), unless we give it a wired-in type
1308 as we do here.
1309
1310 Note [Unsafe coerce magic]
1311 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1312 We define a *primitive*
1313 GHC.Prim.unsafeCoerce#
1314 and then in the base library we define the ordinary function
1315 Unsafe.Coerce.unsafeCoerce :: forall (a:*) (b:*). a -> b
1316 unsafeCoerce x = unsafeCoerce# x
1317
1318 Notice that unsafeCoerce has a civilized (albeit still dangerous)
1319 polymorphic type, whose type args have kind *. So you can't use it on
1320 unboxed values (unsafeCoerce 3#).
1321
1322 In contrast unsafeCoerce# is even more dangerous because you *can* use
1323 it on unboxed things, (unsafeCoerce# 3#) :: Int. Its type is
1324 forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a: TYPE r1) (b: TYPE r2). a -> b
1325
1326 Note [seqId magic]
1327 ~~~~~~~~~~~~~~~~~~
1328 'GHC.Prim.seq' is special in several ways.
1329
1330 a) In source Haskell its second arg can have an unboxed type
1331 x `seq` (v +# w)
1332 But see Note [Typing rule for seq] in TcExpr, which
1333 explains why we give seq itself an ordinary type
1334 seq :: forall a b. a -> b -> b
1335 and treat it as a language construct from a typing point of view.
1336
1337 b) Its fixity is set in LoadIface.ghcPrimIface
1338
1339 c) It has quite a bit of desugaring magic.
1340 See DsUtils.hs Note [Desugaring seq (1)] and (2) and (3)
1341
1342 d) There is some special rule handing: Note [User-defined RULES for seq]
1343
1344 Note [User-defined RULES for seq]
1345 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1346 Roman found situations where he had
1347 case (f n) of _ -> e
1348 where he knew that f (which was strict in n) would terminate if n did.
1349 Notice that the result of (f n) is discarded. So it makes sense to
1350 transform to
1351 case n of _ -> e
1352
1353 Rather than attempt some general analysis to support this, I've added
1354 enough support that you can do this using a rewrite rule:
1355
1356 RULE "f/seq" forall n. seq (f n) = seq n
1357
1358 You write that rule. When GHC sees a case expression that discards
1359 its result, it mentally transforms it to a call to 'seq' and looks for
1360 a RULE. (This is done in Simplify.trySeqRules.) As usual, the
1361 correctness of the rule is up to you.
1362
1363 VERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2.
1364 If we wrote
1365 RULE "f/seq" forall n e. seq (f n) e = seq n e
1366 with rule arity 2, then two bad things would happen:
1367
1368 - The magical desugaring done in Note [seqId magic] item (c)
1369 for saturated application of 'seq' would turn the LHS into
1370 a case expression!
1371
1372 - The code in Simplify.rebuildCase would need to actually supply
1373 the value argument, which turns out to be awkward.
1374
1375 Note [lazyId magic]
1376 ~~~~~~~~~~~~~~~~~~~
1377 lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
1378
1379 'lazy' is used to make sure that a sub-expression, and its free variables,
1380 are truly used call-by-need, with no code motion. Key examples:
1381
1382 * pseq: pseq a b = a `seq` lazy b
1383 We want to make sure that the free vars of 'b' are not evaluated
1384 before 'a', even though the expression is plainly strict in 'b'.
1385
1386 * catch: catch a b = catch# (lazy a) b
1387 Again, it's clear that 'a' will be evaluated strictly (and indeed
1388 applied to a state token) but we want to make sure that any exceptions
1389 arising from the evaluation of 'a' are caught by the catch (see
1390 Trac #11555).
1391
1392 Implementing 'lazy' is a bit tricky:
1393
1394 * It must not have a strictness signature: by being a built-in Id,
1395 all the info about lazyId comes from here, not from GHC.Base.hi.
1396 This is important, because the strictness analyser will spot it as
1397 strict!
1398
1399 * It must not have an unfolding: it gets "inlined" by a HACK in
1400 CorePrep. It's very important to do this inlining *after* unfoldings
1401 are exposed in the interface file. Otherwise, the unfolding for
1402 (say) pseq in the interface file will not mention 'lazy', so if we
1403 inline 'pseq' we'll totally miss the very thing that 'lazy' was
1404 there for in the first place. See Trac #3259 for a real world
1405 example.
1406
1407 * Suppose CorePrep sees (catch# (lazy e) b). At all costs we must
1408 avoid using call by value here:
1409 case e of r -> catch# r b
1410 Avoiding that is the whole point of 'lazy'. So in CorePrep (which
1411 generate the 'case' expression for a call-by-value call) we must
1412 spot the 'lazy' on the arg (in CorePrep.cpeApp), and build a 'let'
1413 instead.
1414
1415 * lazyId is defined in GHC.Base, so we don't *have* to inline it. If it
1416 appears un-applied, we'll end up just calling it.
1417
1418 Note [noinlineId magic]
1419 ~~~~~~~~~~~~~~~~~~~~~~~
1420 noinline :: forall a. a -> a
1421
1422 'noinline' is used to make sure that a function f is never inlined,
1423 e.g., as in 'noinline f x'. Ordinarily, the identity function with NOINLINE
1424 could be used to achieve this effect; however, this has the unfortunate
1425 result of leaving a (useless) call to noinline at runtime. So we have
1426 a little bit of magic to optimize away 'noinline' after we are done
1427 running the simplifier.
1428
1429 'noinline' needs to be wired-in because it gets inserted automatically
1430 when we serialize an expression to the interface format, and we DON'T
1431 want use its fingerprints.
1432
1433
1434 Note [runRW magic]
1435 ~~~~~~~~~~~~~~~~~~
1436 Some definitions, for instance @runST@, must have careful control over float out
1437 of the bindings in their body. Consider this use of @runST@,
1438
1439 f x = runST ( \ s -> let (a, s') = newArray# 100 [] s
1440 (_, s'') = fill_in_array_or_something a x s'
1441 in freezeArray# a s'' )
1442
1443 If we inline @runST@, we'll get:
1444
1445 f x = let (a, s') = newArray# 100 [] realWorld#{-NB-}
1446 (_, s'') = fill_in_array_or_something a x s'
1447 in freezeArray# a s''
1448
1449 And now if we allow the @newArray#@ binding to float out to become a CAF,
1450 we end up with a result that is totally and utterly wrong:
1451
1452 f = let (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
1453 in \ x ->
1454 let (_, s'') = fill_in_array_or_something a x s'
1455 in freezeArray# a s''
1456
1457 All calls to @f@ will share a {\em single} array! Clearly this is nonsense and
1458 must be prevented.
1459
1460 This is what @runRW#@ gives us: by being inlined extremely late in the
1461 optimization (right before lowering to STG, in CorePrep), we can ensure that
1462 no further floating will occur. This allows us to safely inline things like
1463 @runST@, which are otherwise needlessly expensive (see #10678 and #5916).
1464
1465 While the definition of @GHC.Magic.runRW#@, we override its type in @MkId@
1466 to be open-kinded,
1467
1468 runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r)
1469 => (State# RealWorld -> (# State# RealWorld, o #))
1470 -> (# State# RealWorld, o #)
1471
1472
1473 Note [The oneShot function]
1474 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1475 In the context of making left-folds fuse somewhat okish (see ticket #7994
1476 and Note [Left folds via right fold]) it was determined that it would be useful
1477 if library authors could explicitly tell the compiler that a certain lambda is
1478 called at most once. The oneShot function allows that.
1479
1480 'oneShot' is open kinded, i.e. the type variables can refer to unlifted
1481 types as well (Trac #10744); e.g.
1482 oneShot (\x:Int# -> x +# 1#)
1483
1484 Like most magic functions it has a compulsary unfolding, so there is no need
1485 for a real definition somewhere. We have one in GHC.Magic for the convenience
1486 of putting the documentation there.
1487
1488 It uses `setOneShotLambda` on the lambda's binder. That is the whole magic:
1489
1490 A typical call looks like
1491 oneShot (\y. e)
1492 after unfolding the definition `oneShot = \f \x[oneshot]. f x` we get
1493 (\f \x[oneshot]. f x) (\y. e)
1494 --> \x[oneshot]. ((\y.e) x)
1495 --> \x[oneshot] e[x/y]
1496 which is what we want.
1497
1498 It is only effective if the one-shot info survives as long as possible; in
1499 particular it must make it into the interface in unfoldings. See Note [Preserve
1500 OneShotInfo] in CoreTidy.
1501
1502 Also see https://ghc.haskell.org/trac/ghc/wiki/OneShot.
1503
1504
1505 Note [magicDictId magic]
1506 ~~~~~~~~~~~~~~~~~~~~~~~~~
1507 The identifier `magicDict` is just a place-holder, which is used to
1508 implement a primitive that we cannot define in Haskell but we can write
1509 in Core. It is declared with a place-holder type:
1510
1511 magicDict :: forall a. a
1512
1513 The intention is that the identifier will be used in a very specific way,
1514 to create dictionaries for classes with a single method. Consider a class
1515 like this:
1516
1517 class C a where
1518 f :: T a
1519
1520 We are going to use `magicDict`, in conjunction with a built-in Prelude
1521 rule, to cast values of type `T a` into dictionaries for `C a`. To do
1522 this, we define a function like this in the library:
1523
1524 data WrapC a b = WrapC (C a => Proxy a -> b)
1525
1526 withT :: (C a => Proxy a -> b)
1527 -> T a -> Proxy a -> b
1528 withT f x y = magicDict (WrapC f) x y
1529
1530 The purpose of `WrapC` is to avoid having `f` instantiated.
1531 Also, it avoids impredicativity, because `magicDict`'s type
1532 cannot be instantiated with a forall. The field of `WrapC` contains
1533 a `Proxy` parameter which is used to link the type of the constraint,
1534 `C a`, with the type of the `Wrap` value being made.
1535
1536 Next, we add a built-in Prelude rule (see prelude/PrelRules.hs),
1537 which will replace the RHS of this definition with the appropriate
1538 definition in Core. The rewrite rule works as follows:
1539
1540 magicDict @t (wrap @a @b f) x y
1541 ---->
1542 f (x `cast` co a) y
1543
1544 The `co` coercion is the newtype-coercion extracted from the type-class.
1545 The type class is obtain by looking at the type of wrap.
1546
1547
1548 -------------------------------------------------------------
1549 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
1550 nasty as-is, change it back to a literal (@Literal@).
1551
1552 voidArgId is a Local Id used simply as an argument in functions
1553 where we just want an arg to avoid having a thunk of unlifted type.
1554 E.g.
1555 x = \ void :: Void# -> (# p, q #)
1556
1557 This comes up in strictness analysis
1558
1559 Note [evaldUnfoldings]
1560 ~~~~~~~~~~~~~~~~~~~~~~
1561 The evaldUnfolding makes it look that some primitive value is
1562 evaluated, which in turn makes Simplify.interestingArg return True,
1563 which in turn makes INLINE things applied to said value likely to be
1564 inlined.
1565 -}
1566
1567 realWorldPrimId :: Id -- :: State# RealWorld
1568 realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy
1569 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1570 `setOneShotInfo` stateHackOneShot
1571 `setNeverLevPoly` realWorldStatePrimTy)
1572
1573 voidPrimId :: Id -- Global constant :: Void#
1574 voidPrimId = pcMiscPrelId voidPrimIdName voidPrimTy
1575 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1576 `setNeverLevPoly` voidPrimTy)
1577
1578 voidArgId :: Id -- Local lambda-bound :: Void#
1579 voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy
1580
1581 coercionTokenId :: Id -- :: () ~ ()
1582 coercionTokenId -- Used to replace Coercion terms when we go to STG
1583 = pcMiscPrelId coercionTokenName
1584 (mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy])
1585 noCafIdInfo
1586
1587 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
1588 pcMiscPrelId name ty info
1589 = mkVanillaGlobalWithInfo name ty info
1590 -- We lie and say the thing is imported; otherwise, we get into
1591 -- a mess with dependency analysis; e.g., core2stg may heave in
1592 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
1593 -- being compiled, then it's just a matter of luck if the definition
1594 -- will be in "the right place" to be in scope.