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