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