never executed always true always false
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
16
17 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
18
19 module GHC.Types.Id.Make (
20 mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,
21
22 mkPrimOpId, mkFCallId,
23
24 unwrapNewTypeBody, wrapFamInstBody,
25 DataConBoxer(..), vanillaDataConBoxer,
26 mkDataConRep, mkDataConWorkId,
27
28 -- And some particular Ids; see below for why they are wired in
29 wiredInIds, ghcPrimIds,
30 realWorldPrimId,
31 voidPrimId, voidArgId,
32 nullAddrId, seqId, lazyId, lazyIdKey,
33 coercionTokenId, coerceId,
34 proxyHashId, noinlineId, noinlineIdName,
35 coerceName, leftSectionName, rightSectionName,
36
37 -- Re-export error Ids
38 module GHC.Core.Opt.ConstantFold
39 ) where
40
41 import GHC.Prelude
42
43 import GHC.Builtin.Types.Prim
44 import GHC.Builtin.Types
45 import GHC.Core.Opt.ConstantFold
46 import GHC.Core.Type
47 import GHC.Core.Multiplicity
48 import GHC.Core.TyCo.Rep
49 import GHC.Core.FamInstEnv
50 import GHC.Core.Coercion
51 import GHC.Core.Reduction
52 import GHC.Tc.Utils.TcType as TcType
53 import GHC.Core.Make
54 import GHC.Core.FVs ( mkRuleInfo )
55 import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase )
56 import GHC.Core.Unfold.Make
57 import GHC.Core.SimpleOpt
58 import GHC.Types.Literal
59 import GHC.Types.SourceText
60 import GHC.Core.TyCon
61 import GHC.Core.Class
62 import GHC.Types.Name.Set
63 import GHC.Types.Name
64 import GHC.Builtin.PrimOps
65 import GHC.Types.ForeignCall
66 import GHC.Core.DataCon
67 import GHC.Types.Id
68 import GHC.Types.Id.Info
69 import GHC.Types.Demand
70 import GHC.Types.Cpr
71 import GHC.Types.TyThing
72 import GHC.Core
73 import GHC.Types.Unique
74 import GHC.Builtin.Uniques
75 import GHC.Types.Unique.Supply
76 import GHC.Builtin.Names
77 import GHC.Types.Basic hiding ( SuccessFlag(..) )
78 import GHC.Utils.Misc
79 import GHC.Driver.Session
80 import GHC.Driver.Ppr
81 import GHC.Utils.Outputable
82 import GHC.Utils.Panic
83 import GHC.Utils.Panic.Plain
84 import GHC.Data.FastString
85 import GHC.Data.List.SetOps
86 import GHC.Types.Var (VarBndr(Bndr))
87 import qualified GHC.LanguageExtensions as LangExt
88
89 import Data.Maybe ( maybeToList )
90
91 {-
92 ************************************************************************
93 * *
94 \subsection{Wired in Ids}
95 * *
96 ************************************************************************
97
98 Note [Wired-in Ids]
99 ~~~~~~~~~~~~~~~~~~~
100 A "wired-in" Id can be referred to directly in GHC (e.g. 'voidPrimId')
101 rather than by looking it up its name in some environment or fetching
102 it from an interface file.
103
104 There are several reasons why an Id might appear in the wiredInIds:
105
106 * ghcPrimIds: see Note [ghcPrimIds (aka pseudoops)]
107
108 * magicIds: see Note [magicIds]
109
110 * errorIds, defined in GHC.Core.Make.
111 These error functions (e.g. rUNTIME_ERROR_ID) are wired in
112 because the desugarer generates code that mentions them directly
113
114 In all cases except ghcPrimIds, there is a definition site in a
115 library module, which may be called (e.g. in higher order situations);
116 but the wired-in version means that the details are never read from
117 that module's interface file; instead, the full definition is right
118 here.
119
120 Note [ghcPrimIds (aka pseudoops)]
121 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
122 The ghcPrimIds
123
124 * Are exported from GHC.Prim (see ghcPrimExports, used in ghcPrimInterface)
125 See Note [GHC.Prim] in primops.txt.pp for the remaining items in GHC.Prim.
126
127 * Can't be defined in Haskell, and hence no Haskell binding site,
128 but have perfectly reasonable unfoldings in Core
129
130 * Either have a CompulsoryUnfolding (hence always inlined), or
131 of an EvaldUnfolding and void representation (e.g. realWorldPrimId)
132
133 * Are (or should be) defined in primops.txt.pp as 'pseudoop'
134 Reason: that's how we generate documentation for them
135
136 Note [magicIds]
137 ~~~~~~~~~~~~~~~
138 The magicIds
139
140 * Are exported from GHC.Magic
141
142 * Can be defined in Haskell (and are, in ghc-prim:GHC/Magic.hs).
143 This definition at least generates Haddock documentation for them.
144
145 * May or may not have a CompulsoryUnfolding.
146
147 * But have some special behaviour that can't be done via an
148 unfolding from an interface file.
149
150 * May have IdInfo that differs from what would be imported from GHC.Magic.hi.
151 For example, 'lazy' gets a lazy strictness signature, per Note [lazyId magic].
152
153 The two remaining identifiers in GHC.Magic, runRW# and inline, are not listed
154 in magicIds: they have special behavior but they can be known-key and
155 not wired-in.
156 runRW#: see Note [Simplification of runRW#] in Prep, runRW# code in
157 Simplifier, Note [Linting of runRW#].
158 inline: see Note [inlineId magic]
159 -}
160
161 wiredInIds :: [Id]
162 wiredInIds
163 = magicIds
164 ++ ghcPrimIds
165 ++ errorIds -- Defined in GHC.Core.Make
166
167 magicIds :: [Id] -- See Note [magicIds]
168 magicIds = [lazyId, oneShotId, noinlineId]
169
170 ghcPrimIds :: [Id] -- See Note [ghcPrimIds (aka pseudoops)]
171 ghcPrimIds
172 = [ realWorldPrimId
173 , voidPrimId
174 , nullAddrId
175 , seqId
176 , coerceId
177 , proxyHashId
178 , leftSectionId
179 , rightSectionId
180 ]
181
182 {-
183 ************************************************************************
184 * *
185 \subsection{Data constructors}
186 * *
187 ************************************************************************
188
189 The wrapper for a constructor is an ordinary top-level binding that evaluates
190 any strict args, unboxes any args that are going to be flattened, and calls
191 the worker.
192
193 We're going to build a constructor that looks like:
194
195 data (Data a, C b) => T a b = T1 !a !Int b
196
197 T1 = /\ a b ->
198 \d1::Data a, d2::C b ->
199 \p q r -> case p of { p ->
200 case q of { q ->
201 Con T1 [a,b] [p,q,r]}}
202
203 Notice that
204
205 * d2 is thrown away --- a context in a data decl is used to make sure
206 one *could* construct dictionaries at the site the constructor
207 is used, but the dictionary isn't actually used.
208
209 * We have to check that we can construct Data dictionaries for
210 the types a and Int. Once we've done that we can throw d1 away too.
211
212 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
213 all that matters is that the arguments are evaluated. "seq" is
214 very careful to preserve evaluation order, which we don't need
215 to be here.
216
217 You might think that we could simply give constructors some strictness
218 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
219 But we don't do that because in the case of primops and functions strictness
220 is a *property* not a *requirement*. In the case of constructors we need to
221 do something active to evaluate the argument.
222
223 Making an explicit case expression allows the simplifier to eliminate
224 it in the (common) case where the constructor arg is already evaluated.
225
226 Note [Wrappers for data instance tycons]
227 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
228 In the case of data instances, the wrapper also applies the coercion turning
229 the representation type into the family instance type to cast the result of
230 the wrapper. For example, consider the declarations
231
232 data family Map k :: * -> *
233 data instance Map (a, b) v = MapPair (Map a (Pair b v))
234
235 The tycon to which the datacon MapPair belongs gets a unique internal
236 name of the form :R123Map, and we call it the representation tycon.
237 In contrast, Map is the family tycon (accessible via
238 tyConFamInst_maybe). A coercion allows you to move between
239 representation and family type. It is accessible from :R123Map via
240 tyConFamilyCoercion_maybe and has kind
241
242 Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
243
244 The wrapper and worker of MapPair get the types
245
246 -- Wrapper
247 $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v
248 $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)
249
250 -- Worker
251 MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v
252
253 This coercion is conditionally applied by wrapFamInstBody.
254
255 It's a bit more complicated if the data instance is a GADT as well!
256
257 data instance T [a] where
258 T1 :: forall b. b -> T [Maybe b]
259
260 Hence we translate to
261
262 -- Wrapper
263 $WT1 :: forall b. b -> T [Maybe b]
264 $WT1 b v = T1 (Maybe b) b (Maybe b) v
265 `cast` sym (Co7T (Maybe b))
266
267 -- Worker
268 T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
269
270 -- Coercion from family type to representation type
271 Co7T a :: T [a] ~ :R7T a
272
273 Newtype instances through an additional wrinkle into the mix. Consider the
274 following example (adapted from #15318, comment:2):
275
276 data family T a
277 newtype instance T [a] = MkT [a]
278
279 Within the newtype instance, there are three distinct types at play:
280
281 1. The newtype's underlying type, [a].
282 2. The instance's representation type, TList a (where TList is the
283 representation tycon).
284 3. The family type, T [a].
285
286 We need two coercions in order to cast from (1) to (3):
287
288 (a) A newtype coercion axiom:
289
290 axiom coTList a :: TList a ~ [a]
291
292 (Where TList is the representation tycon of the newtype instance.)
293
294 (b) A data family instance coercion axiom:
295
296 axiom coT a :: T [a] ~ TList a
297
298 When we translate the newtype instance to Core, we obtain:
299
300 -- Wrapper
301 $WMkT :: forall a. [a] -> T [a]
302 $WMkT a x = MkT a x |> Sym (coT a)
303
304 -- Worker
305 MkT :: forall a. [a] -> TList [a]
306 MkT a x = x |> Sym (coTList a)
307
308 Unlike for data instances, the worker for a newtype instance is actually an
309 executable function which expands to a cast, but otherwise, the general
310 strategy is essentially the same as for data instances. Also note that we have
311 a wrapper, which is unusual for a newtype, but we make GHC produce one anyway
312 for symmetry with the way data instances are handled.
313
314 Note [Newtype datacons]
315 ~~~~~~~~~~~~~~~~~~~~~~~
316 The "data constructor" for a newtype should always be vanilla. At one
317 point this wasn't true, because the newtype arising from
318 class C a => D a
319 looked like
320 newtype T:D a = D:D (C a)
321 so the data constructor for T:C had a single argument, namely the
322 predicate (C a). But now we treat that as an ordinary argument, not
323 part of the theta-type, so all is well.
324
325 Note [Newtype workers]
326 ~~~~~~~~~~~~~~~~~~~~~~
327 A newtype does not really have a worker. Instead, newtype constructors
328 just unfold into a cast. But we need *something* for, say, MkAge to refer
329 to. So, we do this:
330
331 * The Id used as the newtype worker will have a compulsory unfolding to
332 a cast. See Note [Compulsory newtype unfolding]
333
334 * This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId,
335 as those have special treatment in the back end.
336
337 * There is no top-level binding, because the compulsory unfolding
338 means that it will be inlined (to a cast) at every call site.
339
340 We probably should have a NewtypeWorkId, but these Ids disappear as soon as
341 we desugar anyway, so it seems a step too far.
342
343 Note [Compulsory newtype unfolding]
344 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
345 Newtype wrappers, just like workers, have compulsory unfoldings.
346 This is needed so that two optimizations involving newtypes have the same
347 effect whether a wrapper is present or not:
348
349 (1) Case-of-known constructor.
350 See Note [beta-reduction in exprIsConApp_maybe].
351
352 (2) Matching against the map/coerce RULE. Suppose we have the RULE
353
354 {-# RULE "map/coerce" map coerce = ... #-}
355
356 As described in Note [Getting the map/coerce RULE to work],
357 the occurrence of 'coerce' is transformed into:
358
359 {-# RULE "map/coerce" forall (c :: T1 ~R# T2).
360 map ((\v -> v) `cast` c) = ... #-}
361
362 We'd like 'map Age' to match the LHS. For this to happen, Age
363 must be unfolded, otherwise we'll be stuck. This is tested in T16208.
364
365 It also allows for the posssibility of representation-polymorphic newtypes
366 with wrappers (with -XUnliftedNewtypes):
367
368 newtype N (a :: TYPE r) = MkN a
369
370 With -XUnliftedNewtypes, this is allowed -- even though MkN is representation-
371 polymorphic. It's OK because MkN evaporates in the compiled code, becoming
372 just a cast. That is, it has a compulsory unfolding. As long as its
373 argument is not representation-polymorphic (which it can't be, according to
374 Note [Representation polymorphism invariants] in GHC.Core), and it's saturated,
375 no representation-polymorphic code ends up in the code generator.
376 The saturation condition is effectively checked in
377 GHC.Tc.Gen.App.hasFixedRuntimeRep_remainingValArgs.
378
379 However, if we make a *wrapper* for a newtype, we get into trouble.
380 In that case, we generate a forbidden representation-polymorphic
381 binding, and we must then ensure that it is always instantiated
382 at a representation-monomorphic type.
383
384 The solution is simple, though: just make the newtype wrappers
385 as ephemeral as the newtype workers. In other words, give the wrappers
386 compulsory unfoldings and no bindings. The compulsory unfolding is given
387 in wrap_unf in mkDataConRep, and the lack of a binding happens in
388 GHC.Iface.Tidy.getTyConImplicitBinds, where we say that a newtype has no
389 implicit bindings.
390
391 Note [Records and linear types]
392 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
393 All the fields, in a record constructor, are linear, because there is no syntax
394 to specify the type of record field. There will be (see the proposal
395 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0111-linear-types.rst#records-and-projections
396 ), but it isn't implemented yet.
397
398 Projections of records can't be linear:
399
400 data Foo = MkFoo { a :: A, b :: B }
401
402 If we had
403
404 a :: Foo %1 -> A
405
406 We could write
407
408 bad :: A %1 -> B %1 -> A
409 bad x y = a (MkFoo { a=x, b=y })
410
411 There is an exception: if `b` (more generally all the fields besides `a`) is
412 unrestricted, then is perfectly possible to have a linear projection. Such a
413 linear projection has as simple definition.
414
415 data Bar = MkBar { c :: C, d # Many :: D }
416
417 c :: Bar %1 -> C
418 c MkBar{ c=x, d=_} = x
419
420 The `# Many` syntax, for records, does not exist yet. But there is one important
421 special case which already happens: when there is a single field (usually a
422 newtype).
423
424 newtype Baz = MkBaz { unbaz :: E }
425
426 unbaz could be linear. And, in fact, it is linear in the proposal design.
427
428 However, this hasn't been implemented yet.
429
430 ************************************************************************
431 * *
432 \subsection{Dictionary selectors}
433 * *
434 ************************************************************************
435
436 Selecting a field for a dictionary. If there is just one field, then
437 there's nothing to do.
438
439 Dictionary selectors may get nested forall-types. Thus:
440
441 class Foo a where
442 op :: forall b. Ord b => a -> b -> b
443
444 Then the top-level type for op is
445
446 op :: forall a. Foo a =>
447 forall b. Ord b =>
448 a -> b -> b
449
450 Note [Type classes and linear types]
451 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
452
453 Constraints, in particular type classes, don't have attached linearity
454 information. Implicitly, they are all unrestricted. See the linear types proposal,
455 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0111-linear-types.rst .
456
457 When translating to core `C => ...` is always translated to an unrestricted
458 arrow `C # Many -> ...`.
459
460 Therefore there is no loss of generality if we make all selectors unrestricted.
461
462 -}
463
464 mkDictSelId :: Name -- Name of one of the *value* selectors
465 -- (dictionary superclass or method)
466 -> Class -> Id
467 mkDictSelId name clas
468 = mkGlobalId (ClassOpId clas) name sel_ty info
469 where
470 tycon = classTyCon clas
471 sel_names = map idName (classAllSelIds clas)
472 new_tycon = isNewTyCon tycon
473 [data_con] = tyConDataCons tycon
474 tyvars = dataConUserTyVarBinders data_con
475 n_ty_args = length tyvars
476 arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses
477 val_index = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
478
479 sel_ty = mkInvisForAllTys tyvars $
480 mkInvisFunTyMany (mkClassPred clas (mkTyVarTys (binderVars tyvars))) $
481 scaledThing (getNth arg_tys val_index)
482 -- See Note [Type classes and linear types]
483
484 base_info = noCafIdInfo
485 `setArityInfo` 1
486 `setDmdSigInfo` strict_sig
487 `setCprSigInfo` topCprSig
488 `setLevityInfoWithType` sel_ty
489
490 info | new_tycon
491 = base_info `setInlinePragInfo` alwaysInlinePragma
492 `setUnfoldingInfo` mkInlineUnfoldingWithArity 1
493 defaultSimpleOpts
494 (mkDictSelRhs clas val_index)
495 -- See Note [Single-method classes] in GHC.Tc.TyCl.Instance
496 -- for why alwaysInlinePragma
497
498 | otherwise
499 = base_info `setRuleInfo` mkRuleInfo [rule]
500 -- Add a magic BuiltinRule, but no unfolding
501 -- so that the rule is always available to fire.
502 -- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance
503
504 -- This is the built-in rule that goes
505 -- op (dfT d1 d2) ---> opT d1 d2
506 rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
507 occNameFS (getOccName name)
508 , ru_fn = name
509 , ru_nargs = n_ty_args + 1
510 , ru_try = dictSelRule val_index n_ty_args }
511
512 -- The strictness signature is of the form U(AAAVAAAA) -> T
513 -- where the V depends on which item we are selecting
514 -- It's worth giving one, so that absence info etc is generated
515 -- even if the selector isn't inlined
516
517 strict_sig = mkClosedDmdSig [arg_dmd] topDiv
518 arg_dmd | new_tycon = evalDmd
519 | otherwise = C_1N :* mkProd Unboxed dict_field_dmds
520 where
521 -- The evalDmd below is just a placeholder and will be replaced in
522 -- GHC.Types.Demand.dmdTransformDictSel
523 dict_field_dmds = [ if name == sel_name then evalDmd else absDmd
524 | sel_name <- sel_names ]
525
526 mkDictSelRhs :: Class
527 -> Int -- 0-indexed selector among (superclasses ++ methods)
528 -> CoreExpr
529 mkDictSelRhs clas val_index
530 = mkLams tyvars (Lam dict_id rhs_body)
531 where
532 tycon = classTyCon clas
533 new_tycon = isNewTyCon tycon
534 [data_con] = tyConDataCons tycon
535 tyvars = dataConUnivTyVars data_con
536 arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses
537
538 the_arg_id = getNth arg_ids val_index
539 pred = mkClassPred clas (mkTyVarTys tyvars)
540 dict_id = mkTemplateLocal 1 pred
541 arg_ids = mkTemplateLocalsNum 2 (map scaledThing arg_tys)
542
543 rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars)
544 (Var dict_id)
545 | otherwise = mkSingleAltCase (Var dict_id) dict_id (DataAlt data_con)
546 arg_ids (varToCoreExpr the_arg_id)
547 -- varToCoreExpr needed for equality superclass selectors
548 -- sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
549
550 dictSelRule :: Int -> Arity -> RuleFun
551 -- Tries to persuade the argument to look like a constructor
552 -- application, using exprIsConApp_maybe, and then selects
553 -- from it
554 -- sel_i t1..tk (D t1..tk op1 ... opm) = opi
555 --
556 dictSelRule val_index n_ty_args _ id_unf _ args
557 | (dict_arg : _) <- drop n_ty_args args
558 , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
559 = Just (wrapFloats floats $ getNth con_args val_index)
560 | otherwise
561 = Nothing
562
563 {-
564 ************************************************************************
565 * *
566 Data constructors
567 * *
568 ************************************************************************
569 -}
570
571 mkDataConWorkId :: Name -> DataCon -> Id
572 mkDataConWorkId wkr_name data_con
573 | isNewTyCon tycon
574 = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info
575 -- See Note [Newtype workers]
576
577 | otherwise
578 = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info
579
580 where
581 tycon = dataConTyCon data_con -- The representation TyCon
582 wkr_ty = dataConRepType data_con
583
584 ----------- Workers for data types --------------
585 alg_wkr_info = noCafIdInfo
586 `setArityInfo` wkr_arity
587 `setInlinePragInfo` wkr_inline_prag
588 `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
589 -- even if arity = 0
590 `setLevityInfoWithType` wkr_ty
591 -- NB: unboxed tuples have workers, so we can't use
592 -- setNeverRepPoly
593
594 wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike }
595 wkr_arity = dataConRepArity data_con
596 ----------- Workers for newtypes --------------
597 univ_tvs = dataConUnivTyVars data_con
598 arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys
599 nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
600 `setArityInfo` 1 -- Arity 1
601 `setInlinePragInfo` dataConWrapperInlinePragma
602 `setUnfoldingInfo` newtype_unf
603 `setLevityInfoWithType` wkr_ty
604 id_arg1 = mkScaledTemplateLocal 1 (head arg_tys)
605 res_ty_args = mkTyCoVarTys univ_tvs
606 newtype_unf = assertPpr (isVanillaDataCon data_con && isSingleton arg_tys)
607 (ppr data_con) $
608 -- Note [Newtype datacons]
609 mkCompulsoryUnfolding defaultSimpleOpts $
610 mkLams univ_tvs $ Lam id_arg1 $
611 wrapNewTypeBody tycon res_ty_args (Var id_arg1)
612
613 {-
614 -------------------------------------------------
615 -- Data constructor representation
616 --
617 -- This is where we decide how to wrap/unwrap the
618 -- constructor fields
619 --
620 --------------------------------------------------
621 -}
622
623 type Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)
624 -- Unbox: bind rep vars by decomposing src var
625
626 data Boxer = UnitBox | Boxer (TCvSubst -> UniqSM ([Var], CoreExpr))
627 -- Box: build src arg using these rep vars
628
629 -- | Data Constructor Boxer
630 newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))
631 -- Bind these src-level vars, returning the
632 -- rep-level vars to bind in the pattern
633
634 vanillaDataConBoxer :: DataConBoxer
635 -- No transformation on arguments needed
636 vanillaDataConBoxer = DCB (\_tys args -> return (args, []))
637
638 {-
639 Note [Inline partially-applied constructor wrappers]
640 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
641
642 We allow the wrapper to inline when partially applied to avoid
643 boxing values unnecessarily. For example, consider
644
645 data Foo a = Foo !Int a
646
647 instance Traversable Foo where
648 traverse f (Foo i a) = Foo i <$> f a
649
650 This desugars to
651
652 traverse f foo = case foo of
653 Foo i# a -> let i = I# i#
654 in map ($WFoo i) (f a)
655
656 If the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`.
657 But if we inline the wrapper, we get
658
659 map (\a. case i of I# i# a -> Foo i# a) (f a)
660
661 and now case-of-known-constructor eliminates the redundant allocation.
662
663 -}
664
665 mkDataConRep :: DynFlags
666 -> FamInstEnvs
667 -> Name
668 -> Maybe [HsImplBang]
669 -- See Note [Bangs on imported data constructors]
670 -> DataCon
671 -> UniqSM DataConRep
672 mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
673 | not wrapper_reqd
674 = return NoDataConRep
675
676 | otherwise
677 = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys
678 ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers)
679 initial_wrap_app
680
681 ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info
682 wrap_info = noCafIdInfo
683 `setArityInfo` wrap_arity
684 -- It's important to specify the arity, so that partial
685 -- applications are treated as values
686 `setInlinePragInfo` wrap_prag
687 `setUnfoldingInfo` wrap_unf
688 `setDmdSigInfo` wrap_sig
689 -- We need to get the CAF info right here because GHC.Iface.Tidy
690 -- does not tidy the IdInfo of implicit bindings (like the wrapper)
691 -- so it not make sure that the CAF info is sane
692 `setLevityInfoWithType` wrap_ty
693
694 wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv
695
696 wrap_arg_dmds =
697 replicate (length theta) topDmd ++ map mk_dmd arg_ibangs
698 -- Don't forget the dictionary arguments when building
699 -- the strictness signature (#14290).
700
701 mk_dmd str | isBanged str = evalDmd
702 | otherwise = topDmd
703
704 wrap_prag = dataConWrapperInlinePragma
705 `setInlinePragmaActivation` activateDuringFinal
706 -- See Note [Activation for data constructor wrappers]
707
708 -- The wrapper will usually be inlined (see wrap_unf), so its
709 -- strictness and CPR info is usually irrelevant. But this is
710 -- not always the case; GHC may choose not to inline it. In
711 -- particular, the wrapper constructor is not inlined inside
712 -- an INLINE rhs or when it is not applied to any arguments.
713 -- See Note [Inline partially-applied constructor wrappers]
714 -- Passing Nothing here allows the wrapper to inline when
715 -- unsaturated.
716 wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding defaultSimpleOpts wrap_rhs
717 -- See Note [Compulsory newtype unfolding]
718 | otherwise = mkInlineUnfolding defaultSimpleOpts wrap_rhs
719 wrap_rhs = mkLams wrap_tvs $
720 mkLams wrap_args $
721 wrapFamInstBody tycon res_ty_args $
722 wrap_body
723
724 ; return (DCR { dcr_wrap_id = wrap_id
725 , dcr_boxer = mk_boxer boxers
726 , dcr_arg_tys = rep_tys
727 , dcr_stricts = rep_strs
728 -- For newtypes, dcr_bangs is always [HsLazy].
729 -- See Note [HsImplBangs for newtypes].
730 , dcr_bangs = arg_ibangs }) }
731
732 where
733 (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty)
734 = dataConFullSig data_con
735 wrap_tvs = dataConUserTyVars data_con
736 res_ty_args = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs
737
738 tycon = dataConTyCon data_con -- The representation TyCon (not family)
739 wrap_ty = dataConWrapperType data_con
740 ev_tys = eqSpecPreds eq_spec ++ theta
741 all_arg_tys = map unrestricted ev_tys ++ orig_arg_tys
742 ev_ibangs = map (const HsLazy) ev_tys
743 orig_bangs = dataConSrcBangs data_con
744
745 wrap_arg_tys = (map unrestricted theta) ++ orig_arg_tys
746 wrap_arity = count isCoVar ex_tvs + length wrap_arg_tys
747 -- The wrap_args are the arguments *other than* the eq_spec
748 -- Because we are going to apply the eq_spec args manually in the
749 -- wrapper
750
751 new_tycon = isNewTyCon tycon
752 arg_ibangs
753 | new_tycon
754 = map (const HsLazy) orig_arg_tys -- See Note [HsImplBangs for newtypes]
755 -- orig_arg_tys should be a singleton, but
756 -- if a user declared a wrong newtype we
757 -- detect this later (see test T2334A)
758 | otherwise
759 = case mb_bangs of
760 Nothing -> zipWith (dataConSrcToImplBang dflags fam_envs)
761 orig_arg_tys orig_bangs
762 Just bangs -> bangs
763
764 (rep_tys_w_strs, wrappers)
765 = unzip (zipWith dataConArgRep all_arg_tys (ev_ibangs ++ arg_ibangs))
766
767 (unboxers, boxers) = unzip wrappers
768 (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
769
770 wrapper_reqd =
771 (not new_tycon
772 -- (Most) newtypes have only a worker, with the exception
773 -- of some newtypes written with GADT syntax. See below.
774 && (any isBanged (ev_ibangs ++ arg_ibangs)
775 -- Some forcing/unboxing (includes eq_spec)
776 || (not $ null eq_spec))) -- GADT
777 || isFamInstTyCon tycon -- Cast result
778 || dataConUserTyVarsArePermuted data_con
779 -- If the data type was written with GADT syntax and
780 -- orders the type variables differently from what the
781 -- worker expects, it needs a data con wrapper to reorder
782 -- the type variables.
783 -- See Note [Data con wrappers and GADT syntax].
784
785 initial_wrap_app = Var (dataConWorkId data_con)
786 `mkTyApps` res_ty_args
787 `mkVarApps` ex_tvs
788 `mkCoApps` map (mkReflCo Nominal . eqSpecType) eq_spec
789
790 mk_boxer :: [Boxer] -> DataConBoxer
791 mk_boxer boxers = DCB (\ ty_args src_vars ->
792 do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars
793 subst1 = zipTvSubst univ_tvs ty_args
794 subst2 = extendTCvSubstList subst1 ex_tvs
795 (mkTyCoVarTys ex_vars)
796 ; (rep_ids, binds) <- go subst2 boxers term_vars
797 ; return (ex_vars ++ rep_ids, binds) } )
798
799 go _ [] src_vars = assertPpr (null src_vars) (ppr data_con) $ return ([], [])
800 go subst (UnitBox : boxers) (src_var : src_vars)
801 = do { (rep_ids2, binds) <- go subst boxers src_vars
802 ; return (src_var : rep_ids2, binds) }
803 go subst (Boxer boxer : boxers) (src_var : src_vars)
804 = do { (rep_ids1, arg) <- boxer subst
805 ; (rep_ids2, binds) <- go subst boxers src_vars
806 ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }
807 go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con)
808
809 mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr
810 mk_rep_app [] con_app
811 = return con_app
812 mk_rep_app ((wrap_arg, unboxer) : prs) con_app
813 = do { (rep_ids, unbox_fn) <- unboxer wrap_arg
814 ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
815 ; return (unbox_fn expr) }
816
817
818 dataConWrapperInlinePragma :: InlinePragma
819 -- See Note [DataCon wrappers are conlike]
820 dataConWrapperInlinePragma = alwaysInlineConLikePragma
821
822 {- Note [Activation for data constructor wrappers]
823 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
824 The Activation on a data constructor wrapper allows it to inline only in FinalPhase.
825 This way rules have a chance to fire if they mention a data constructor on
826 the left
827 RULE "foo" f (K a b) = ...
828 Since the LHS of rules are simplified with InitialPhase, we won't
829 inline the wrapper on the LHS either.
830
831 On the other hand, this means that exprIsConApp_maybe must be able to deal
832 with wrappers so that case-of-constructor is not delayed; see
833 Note [exprIsConApp_maybe on data constructors with wrappers] for details.
834
835 It used to activate in phases 2 (afterInitial) and later, but it makes it
836 awkward to write a RULE[1] with a constructor on the left: it would work if a
837 constructor has no wrapper, but whether a constructor has a wrapper depends, for
838 instance, on the order of type argument of that constructors. Therefore changing
839 the order of type argument could make previously working RULEs fail.
840
841 See also https://gitlab.haskell.org/ghc/ghc/issues/15840 .
842
843 Note [DataCon wrappers are conlike]
844 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
845 DataCon workers are clearly ConLike --- they are the “Con” in
846 “ConLike”, after all --- but what about DataCon wrappers? Should they
847 be marked ConLike, too?
848
849 Yes, absolutely! As described in Note [CONLIKE pragma] in
850 GHC.Types.Basic, isConLike influences GHC.Core.Utils.exprIsExpandable,
851 which is used by both RULE matching and the case-of-known-constructor
852 optimization. It’s crucial that both of those things can see
853 applications of DataCon wrappers:
854
855 * User-defined RULEs match on wrappers, not workers, so we might
856 need to look through an unfolding built from a DataCon wrapper to
857 determine if a RULE matches.
858
859 * Likewise, if we have something like
860 let x = $WC a b in ... case x of { C y z -> e } ...
861 we still want to apply case-of-known-constructor.
862
863 Therefore, it’s important that we consider DataCon wrappers conlike.
864 This is especially true now that we don’t inline DataCon wrappers
865 until the final simplifier phase; see Note [Activation for data
866 constructor wrappers].
867
868 For further reading, see:
869 * Note [Conlike is interesting] in GHC.Core.Op.Simplify.Utils
870 * Note [Lone variables] in GHC.Core.Unfold
871 * Note [exprIsConApp_maybe on data constructors with wrappers]
872 in GHC.Core.SimpleOpt
873 * #18012
874
875 Note [Bangs on imported data constructors]
876 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
877
878 We pass Maybe [HsImplBang] to mkDataConRep to make use of HsImplBangs
879 from imported modules.
880
881 - Nothing <=> use HsSrcBangs
882 - Just bangs <=> use HsImplBangs
883
884 For imported types we can't work it all out from the HsSrcBangs,
885 because we want to be very sure to follow what the original module
886 (where the data type was declared) decided, and that depends on what
887 flags were enabled when it was compiled. So we record the decisions in
888 the interface file.
889
890 The HsImplBangs passed are in 1-1 correspondence with the
891 dataConOrigArgTys of the DataCon.
892
893 Note [Data con wrappers and unlifted types]
894 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
895 Consider
896 data T = MkT !Int#
897
898 We certainly do not want to make a wrapper
899 $WMkT x = case x of y { DEFAULT -> MkT y }
900
901 For a start, it's still to generate a no-op. But worse, since wrappers
902 are currently injected at TidyCore, we don't even optimise it away!
903 So the stupid case expression stays there. This actually happened for
904 the Integer data type (see #1600 comment:66)!
905
906 Note [Data con wrappers and GADT syntax]
907 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
908 Consider these two very similar data types:
909
910 data T1 a b = MkT1 b
911
912 data T2 a b where
913 MkT2 :: forall b a. b -> T2 a b
914
915 Despite their similar appearance, T2 will have a data con wrapper but T1 will
916 not. What sets them apart? The types of their constructors, which are:
917
918 MkT1 :: forall a b. b -> T1 a b
919 MkT2 :: forall b a. b -> T2 a b
920
921 MkT2's use of GADT syntax allows it to permute the order in which `a` and `b`
922 would normally appear. See Note [DataCon user type variable binders] in GHC.Core.DataCon
923 for further discussion on this topic.
924
925 The worker data cons for T1 and T2, however, both have types such that `a` is
926 expected to come before `b` as arguments. Because MkT2 permutes this order, it
927 needs a data con wrapper to swizzle around the type variables to be in the
928 order the worker expects.
929
930 A somewhat surprising consequence of this is that *newtypes* can have data con
931 wrappers! After all, a newtype can also be written with GADT syntax:
932
933 newtype T3 a b where
934 MkT3 :: forall b a. b -> T3 a b
935
936 Again, this needs a wrapper data con to reorder the type variables. It does
937 mean that this newtype constructor requires another level of indirection when
938 being called, but the inliner should make swift work of that.
939
940 Note [HsImplBangs for newtypes]
941 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
942 Most of the time, we use the dataConSrctoImplBang function to decide what
943 strictness/unpackedness to use for the fields of a data type constructor. But
944 there is an exception to this rule: newtype constructors. You might not think
945 that newtypes would pose a challenge, since newtypes are seemingly forbidden
946 from having strictness annotations in the first place. But consider this
947 (from #16141):
948
949 {-# LANGUAGE StrictData #-}
950 {-# OPTIONS_GHC -O #-}
951 newtype T a b where
952 MkT :: forall b a. Int -> T a b
953
954 Because StrictData (plus optimization) is enabled, invoking
955 dataConSrcToImplBang would sneak in and unpack the field of type Int to Int#!
956 This would be disastrous, since the wrapper for `MkT` uses a coercion involving
957 Int, not Int#.
958
959 Bottom line: dataConSrcToImplBang should never be invoked for newtypes. In the
960 case of a newtype constructor, we simply hardcode its dcr_bangs field to
961 [HsLazy].
962 -}
963
964 -------------------------
965
966 -- | Conjure a fresh local binder.
967 newLocal :: FastString -- ^ a string which will form part of the 'Var'\'s name
968 -> Scaled Type -- ^ the type of the 'Var'
969 -> UniqSM Var
970 newLocal name_stem (Scaled w ty) =
971 do { uniq <- getUniqueM
972 ; return (mkSysLocalOrCoVar name_stem uniq w ty) }
973 -- We should not have "OrCoVar" here, this is a bug (#17545)
974
975
976 -- | Unpack/Strictness decisions from source module.
977 --
978 -- This function should only ever be invoked for data constructor fields, and
979 -- never on the field of a newtype constructor.
980 -- See @Note [HsImplBangs for newtypes]@.
981 dataConSrcToImplBang
982 :: DynFlags
983 -> FamInstEnvs
984 -> Scaled Type
985 -> HsSrcBang
986 -> HsImplBang
987
988 dataConSrcToImplBang dflags fam_envs arg_ty
989 (HsSrcBang ann unpk NoSrcStrict)
990 | xopt LangExt.StrictData dflags -- StrictData => strict field
991 = dataConSrcToImplBang dflags fam_envs arg_ty
992 (HsSrcBang ann unpk SrcStrict)
993 | otherwise -- no StrictData => lazy field
994 = HsLazy
995
996 dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)
997 = HsLazy
998
999 dataConSrcToImplBang dflags fam_envs arg_ty
1000 (HsSrcBang _ unpk_prag SrcStrict)
1001 | isUnliftedType (scaledThing arg_ty)
1002 = HsLazy -- For !Int#, say, use HsLazy
1003 -- See Note [Data con wrappers and unlifted types]
1004
1005 | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
1006 -- Don't unpack if we aren't optimising; rather arbitrarily,
1007 -- we use -fomit-iface-pragmas as the indication
1008 , let mb_co = topNormaliseType_maybe fam_envs (scaledThing arg_ty)
1009 -- Unwrap type families and newtypes
1010 arg_ty' = case mb_co of
1011 { Just redn -> scaledSet arg_ty (reductionReducedType redn)
1012 ; Nothing -> arg_ty }
1013 , isUnpackableType dflags fam_envs (scaledThing arg_ty')
1014 , (rep_tys, _) <- dataConArgUnpack arg_ty'
1015 , case unpk_prag of
1016 NoSrcUnpack ->
1017 gopt Opt_UnboxStrictFields dflags
1018 || (gopt Opt_UnboxSmallStrictFields dflags
1019 && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]
1020 srcUnpack -> isSrcUnpacked srcUnpack
1021 = case mb_co of
1022 Nothing -> HsUnpack Nothing
1023 Just redn -> HsUnpack (Just $ reductionCoercion redn)
1024
1025 | otherwise -- Record the strict-but-no-unpack decision
1026 = HsStrict
1027
1028
1029 -- | Wrappers/Workers and representation following Unpack/Strictness
1030 -- decisions
1031 dataConArgRep
1032 :: Scaled Type
1033 -> HsImplBang
1034 -> ([(Scaled Type,StrictnessMark)] -- Rep types
1035 ,(Unboxer,Boxer))
1036
1037 dataConArgRep arg_ty HsLazy
1038 = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
1039
1040 dataConArgRep arg_ty HsStrict
1041 = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))
1042
1043 dataConArgRep arg_ty (HsUnpack Nothing)
1044 | (rep_tys, wrappers) <- dataConArgUnpack arg_ty
1045 = (rep_tys, wrappers)
1046
1047 dataConArgRep (Scaled w _) (HsUnpack (Just co))
1048 | let co_rep_ty = coercionRKind co
1049 , (rep_tys, wrappers) <- dataConArgUnpack (Scaled w co_rep_ty)
1050 = (rep_tys, wrapCo co co_rep_ty wrappers)
1051
1052
1053 -------------------------
1054 wrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer)
1055 wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty
1056 = (unboxer, boxer)
1057 where
1058 unboxer arg_id = do { rep_id <- newLocal (fsLit "cowrap_unbx") (Scaled (idMult arg_id) rep_ty)
1059 ; (rep_ids, rep_fn) <- unbox_rep rep_id
1060 ; let co_bind = NonRec rep_id (Var arg_id `Cast` co)
1061 ; return (rep_ids, Let co_bind . rep_fn) }
1062 boxer = Boxer $ \ subst ->
1063 do { (rep_ids, rep_expr)
1064 <- case box_rep of
1065 UnitBox -> do { rep_id <- newLocal (fsLit "cowrap_bx") (linear $ TcType.substTy subst rep_ty)
1066 ; return ([rep_id], Var rep_id) }
1067 Boxer boxer -> boxer subst
1068 ; let sco = substCoUnchecked subst co
1069 ; return (rep_ids, rep_expr `Cast` mkSymCo sco) }
1070
1071 ------------------------
1072 seqUnboxer :: Unboxer
1073 seqUnboxer v = return ([v], mkDefaultCase (Var v) v)
1074
1075 unitUnboxer :: Unboxer
1076 unitUnboxer v = return ([v], \e -> e)
1077
1078 unitBoxer :: Boxer
1079 unitBoxer = UnitBox
1080
1081 -------------------------
1082 dataConArgUnpack
1083 :: Scaled Type
1084 -> ( [(Scaled Type, StrictnessMark)] -- Rep types
1085 , (Unboxer, Boxer) )
1086
1087 dataConArgUnpack (Scaled arg_mult arg_ty)
1088 | Just (tc, tc_args) <- splitTyConApp_maybe arg_ty
1089 , Just con <- tyConSingleAlgDataCon_maybe tc
1090 -- NB: check for an *algebraic* data type
1091 -- A recursive newtype might mean that
1092 -- 'arg_ty' is a newtype
1093 , let rep_tys = map (scaleScaled arg_mult) $ dataConInstArgTys con tc_args
1094 = assert (null (dataConExTyCoVars con))
1095 -- Note [Unpacking GADTs and existentials]
1096 ( rep_tys `zip` dataConRepStrictness con
1097 ,( \ arg_id ->
1098 do { rep_ids <- mapM (newLocal (fsLit "unbx")) rep_tys
1099 ; let r_mult = idMult arg_id
1100 ; let rep_ids' = map (scaleIdBy r_mult) rep_ids
1101 ; let unbox_fn body
1102 = mkSingleAltCase (Var arg_id) arg_id
1103 (DataAlt con) rep_ids' body
1104 ; return (rep_ids, unbox_fn) }
1105 , Boxer $ \ subst ->
1106 do { rep_ids <- mapM (newLocal (fsLit "bx") . TcType.substScaledTyUnchecked subst) rep_tys
1107 ; return (rep_ids, Var (dataConWorkId con)
1108 `mkTyApps` (substTysUnchecked subst tc_args)
1109 `mkVarApps` rep_ids ) } ) )
1110 | otherwise
1111 = pprPanic "dataConArgUnpack" (ppr arg_ty)
1112 -- An interface file specified Unpacked, but we couldn't unpack it
1113
1114 isUnpackableType :: DynFlags -> FamInstEnvs -> Type -> Bool
1115 -- True if we can unpack the UNPACK the argument type
1116 -- See Note [Recursive unboxing]
1117 -- We look "deeply" inside rather than relying on the DataCons
1118 -- we encounter on the way, because otherwise we might well
1119 -- end up relying on ourselves!
1120 isUnpackableType dflags fam_envs ty
1121 | Just data_con <- unpackable_type ty
1122 = ok_con_args emptyNameSet data_con
1123 | otherwise
1124 = False
1125 where
1126 ok_con_args dcs con
1127 | dc_name `elemNameSet` dcs
1128 = False
1129 | otherwise
1130 = all (ok_arg dcs')
1131 (dataConOrigArgTys con `zip` dataConSrcBangs con)
1132 -- NB: dataConSrcBangs gives the *user* request;
1133 -- We'd get a black hole if we used dataConImplBangs
1134 where
1135 dc_name = getName con
1136 dcs' = dcs `extendNameSet` dc_name
1137
1138 ok_arg dcs (Scaled _ ty, bang)
1139 = not (attempt_unpack bang) || ok_ty dcs norm_ty
1140 where
1141 norm_ty = topNormaliseType fam_envs ty
1142
1143 ok_ty dcs ty
1144 | Just data_con <- unpackable_type ty
1145 = ok_con_args dcs data_con
1146 | otherwise
1147 = True -- NB True here, in contrast to False at top level
1148
1149 attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict)
1150 = xopt LangExt.StrictData dflags
1151 attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict)
1152 = True
1153 attempt_unpack (HsSrcBang _ NoSrcUnpack SrcStrict)
1154 = True -- Be conservative
1155 attempt_unpack (HsSrcBang _ NoSrcUnpack NoSrcStrict)
1156 = xopt LangExt.StrictData dflags -- Be conservative
1157 attempt_unpack _ = False
1158
1159 unpackable_type :: Type -> Maybe DataCon
1160 -- Works just on a single level
1161 unpackable_type ty
1162 | Just (tc, _) <- splitTyConApp_maybe ty
1163 , Just data_con <- tyConSingleAlgDataCon_maybe tc
1164 , null (dataConExTyCoVars data_con)
1165 -- See Note [Unpacking GADTs and existentials]
1166 = Just data_con
1167 | otherwise
1168 = Nothing
1169
1170 {-
1171 Note [Unpacking GADTs and existentials]
1172 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1173 There is nothing stopping us unpacking a data type with equality
1174 components, like
1175 data Equal a b where
1176 Equal :: Equal a a
1177
1178 And it'd be fine to unpack a product type with existential components
1179 too, but that would require a bit more plumbing, so currently we don't.
1180
1181 So for now we require: null (dataConExTyCoVars data_con)
1182 See #14978
1183
1184 Note [Unpack one-wide fields]
1185 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1186 The flag UnboxSmallStrictFields ensures that any field that can
1187 (safely) be unboxed to a word-sized unboxed field, should be so unboxed.
1188 For example:
1189
1190 data A = A Int#
1191 newtype B = B A
1192 data C = C !B
1193 data D = D !C
1194 data E = E !()
1195 data F = F !D
1196 data G = G !F !F
1197
1198 All of these should have an Int# as their representation, except
1199 G which should have two Int#s.
1200
1201 However
1202
1203 data T = T !(S Int)
1204 data S = S !a
1205
1206 Here we can represent T with an Int#.
1207
1208 Note [Recursive unboxing]
1209 ~~~~~~~~~~~~~~~~~~~~~~~~~
1210 Consider
1211 data R = MkR {-# UNPACK #-} !S Int
1212 data S = MkS {-# UNPACK #-} !Int
1213 The representation arguments of MkR are the *representation* arguments
1214 of S (plus Int); the rep args of MkS are Int#. This is all fine.
1215
1216 But be careful not to try to unbox this!
1217 data T = MkT {-# UNPACK #-} !T Int
1218 Because then we'd get an infinite number of arguments.
1219
1220 Here is a more complicated case:
1221 data S = MkS {-# UNPACK #-} !T Int
1222 data T = MkT {-# UNPACK #-} !S Int
1223 Each of S and T must decide independently whether to unpack
1224 and they had better not both say yes. So they must both say no.
1225
1226 Also behave conservatively when there is no UNPACK pragma
1227 data T = MkS !T Int
1228 with -funbox-strict-fields or -funbox-small-strict-fields
1229 we need to behave as if there was an UNPACK pragma there.
1230
1231 But it's the *argument* type that matters. This is fine:
1232 data S = MkS S !Int
1233 because Int is non-recursive.
1234
1235 ************************************************************************
1236 * *
1237 Wrapping and unwrapping newtypes and type families
1238 * *
1239 ************************************************************************
1240 -}
1241
1242 wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
1243 -- The wrapper for the data constructor for a newtype looks like this:
1244 -- newtype T a = MkT (a,Int)
1245 -- MkT :: forall a. (a,Int) -> T a
1246 -- MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)
1247 -- where CoT is the coercion TyCon associated with the newtype
1248 --
1249 -- The call (wrapNewTypeBody T [a] e) returns the
1250 -- body of the wrapper, namely
1251 -- e `cast` (CoT [a])
1252 --
1253 -- If a coercion constructor is provided in the newtype, then we use
1254 -- it, otherwise the wrap/unwrap are both no-ops
1255
1256 wrapNewTypeBody tycon args result_expr
1257 = assert (isNewTyCon tycon) $
1258 mkCast result_expr (mkSymCo co)
1259 where
1260 co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args []
1261
1262 -- When unwrapping, we do *not* apply any family coercion, because this will
1263 -- be done via a CoPat by the type checker. We have to do it this way as
1264 -- computing the right type arguments for the coercion requires more than just
1265 -- a splitting operation (cf, GHC.Tc.Gen.Pat.tcConPat).
1266
1267 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
1268 unwrapNewTypeBody tycon args result_expr
1269 = assert (isNewTyCon tycon) $
1270 mkCast result_expr (mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [])
1271
1272 -- If the type constructor is a representation type of a data instance, wrap
1273 -- the expression into a cast adjusting the expression type, which is an
1274 -- instance of the representation type, to the corresponding instance of the
1275 -- family instance type.
1276 -- See Note [Wrappers for data instance tycons]
1277 wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
1278 wrapFamInstBody tycon args body
1279 | Just co_con <- tyConFamilyCoercion_maybe tycon
1280 = mkCast body (mkSymCo (mkUnbranchedAxInstCo Representational co_con args []))
1281 | otherwise
1282 = body
1283
1284 {-
1285 ************************************************************************
1286 * *
1287 \subsection{Primitive operations}
1288 * *
1289 ************************************************************************
1290 -}
1291
1292 mkPrimOpId :: PrimOp -> Id
1293 mkPrimOpId prim_op
1294 = id
1295 where
1296 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
1297 ty = mkForAllTys tyvars (mkVisFunTysMany arg_tys res_ty)
1298 name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
1299 (mkPrimOpIdUnique (primOpTag prim_op))
1300 (AnId id) UserSyntax
1301 id = mkGlobalId (PrimOpId prim_op) name ty info
1302
1303 -- PrimOps don't ever construct a product, but we want to preserve bottoms
1304 cpr
1305 | isDeadEndDiv (snd (splitDmdSig strict_sig)) = botCpr
1306 | otherwise = topCpr
1307
1308 info = noCafIdInfo
1309 `setRuleInfo` mkRuleInfo (maybeToList $ primOpRules name prim_op)
1310 `setArityInfo` arity
1311 `setDmdSigInfo` strict_sig
1312 `setCprSigInfo` mkCprSig arity cpr
1313 `setInlinePragInfo` neverInlinePragma
1314 `setLevityInfoWithType` res_ty
1315 -- We give PrimOps a NOINLINE pragma so that we don't
1316 -- get silly warnings from Desugar.dsRule (the inline_shadows_rule
1317 -- test) about a RULE conflicting with a possible inlining
1318 -- cf #7287
1319
1320 -- For each ccall we manufacture a separate CCallOpId, giving it
1321 -- a fresh unique, a type that is correct for this particular ccall,
1322 -- and a CCall structure that gives the correct details about calling
1323 -- convention etc.
1324 --
1325 -- The *name* of this Id is a local name whose OccName gives the full
1326 -- details of the ccall, type and all. This means that the interface
1327 -- file reader can reconstruct a suitable Id
1328
1329 mkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id
1330 mkFCallId dflags uniq fcall ty
1331 = assert (noFreeVarsOfType ty) $
1332 -- A CCallOpId should have no free type variables;
1333 -- when doing substitutions won't substitute over it
1334 mkGlobalId (FCallId fcall) name ty info
1335 where
1336 occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))
1337 -- The "occurrence name" of a ccall is the full info about the
1338 -- ccall; it is encoded, but may have embedded spaces etc!
1339
1340 name = mkFCallName uniq occ_str
1341
1342 info = noCafIdInfo
1343 `setArityInfo` arity
1344 `setDmdSigInfo` strict_sig
1345 `setCprSigInfo` topCprSig
1346 `setLevityInfoWithType` ty
1347
1348 (bndrs, _) = tcSplitPiTys ty
1349 arity = count isAnonTyCoBinder bndrs
1350 strict_sig = mkClosedDmdSig (replicate arity topDmd) topDiv
1351 -- the call does not claim to be strict in its arguments, since they
1352 -- may be lifted (foreign import prim) and the called code doesn't
1353 -- necessarily force them. See #11076.
1354 {-
1355 ************************************************************************
1356 * *
1357 \subsection{DictFuns and default methods}
1358 * *
1359 ************************************************************************
1360
1361 Note [Dict funs and default methods]
1362 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1363 Dict funs and default methods are *not* ImplicitIds. Their definition
1364 involves user-written code, so we can't figure out their strictness etc
1365 based on fixed info, as we can for constructors and record selectors (say).
1366
1367 NB: See also Note [Exported LocalIds] in GHC.Types.Id
1368 -}
1369
1370 mkDictFunId :: Name -- Name to use for the dict fun;
1371 -> [TyVar]
1372 -> ThetaType
1373 -> Class
1374 -> [Type]
1375 -> Id
1376 -- Implements the DFun Superclass Invariant (see GHC.Tc.TyCl.Instance)
1377 -- See Note [Dict funs and default methods]
1378
1379 mkDictFunId dfun_name tvs theta clas tys
1380 = mkExportedLocalId (DFunId is_nt)
1381 dfun_name
1382 dfun_ty
1383 where
1384 is_nt = isNewTyCon (classTyCon clas)
1385 dfun_ty = mkDictFunTy tvs theta clas tys
1386
1387 mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type
1388 mkDictFunTy tvs theta clas tys
1389 = mkSpecSigmaTy tvs theta (mkClassPred clas tys)
1390
1391 {-
1392 ************************************************************************
1393 * *
1394 \subsection{Un-definable}
1395 * *
1396 ************************************************************************
1397
1398 These Ids can't be defined in Haskell. They could be defined in
1399 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
1400 ensure that they were definitely, definitely inlined, because there is
1401 no curried identifier for them. That's what mkCompulsoryUnfolding
1402 does. Alternatively, we could add the definitions to mi_decls of ghcPrimIface
1403 but it's not clear if this would be simpler.
1404
1405 coercionToken# is not listed in ghcPrimIds, since its type uses (~#)
1406 which is not supposed to be used in expressions (GHC throws an assertion
1407 failure when trying.)
1408 -}
1409
1410 nullAddrName, seqName,
1411 realWorldName, voidPrimIdName, coercionTokenName,
1412 coerceName, proxyName,
1413 leftSectionName, rightSectionName :: Name
1414 nullAddrName = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#") nullAddrIdKey nullAddrId
1415 seqName = mkWiredInIdName gHC_PRIM (fsLit "seq") seqIdKey seqId
1416 realWorldName = mkWiredInIdName gHC_PRIM (fsLit "realWorld#") realWorldPrimIdKey realWorldPrimId
1417 voidPrimIdName = mkWiredInIdName gHC_PRIM (fsLit "void#") voidPrimIdKey voidPrimId
1418 coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
1419 coerceName = mkWiredInIdName gHC_PRIM (fsLit "coerce") coerceKey coerceId
1420 proxyName = mkWiredInIdName gHC_PRIM (fsLit "proxy#") proxyHashKey proxyHashId
1421 leftSectionName = mkWiredInIdName gHC_PRIM (fsLit "leftSection") leftSectionKey leftSectionId
1422 rightSectionName = mkWiredInIdName gHC_PRIM (fsLit "rightSection") rightSectionKey rightSectionId
1423
1424 -- Names listed in magicIds; see Note [magicIds]
1425 lazyIdName, oneShotName, noinlineIdName :: Name
1426 lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey lazyId
1427 oneShotName = mkWiredInIdName gHC_MAGIC (fsLit "oneShot") oneShotKey oneShotId
1428 noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId
1429
1430 ------------------------------------------------
1431 proxyHashId :: Id
1432 proxyHashId
1433 = pcMiscPrelId proxyName ty
1434 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1435 `setNeverRepPoly` ty)
1436 where
1437 -- proxy# :: forall {k} (a:k). Proxy# k a
1438 --
1439 -- The visibility of the `k` binder is Inferred to match the type of the
1440 -- Proxy data constructor (#16293).
1441 [kv,tv] = mkTemplateKiTyVars [liftedTypeKind] id
1442 kv_ty = mkTyVarTy kv
1443 tv_ty = mkTyVarTy tv
1444 ty = mkInfForAllTy kv $ mkSpecForAllTy tv $ mkProxyPrimTy kv_ty tv_ty
1445
1446 ------------------------------------------------
1447 nullAddrId :: Id
1448 -- nullAddr# :: Addr#
1449 -- The reason it is here is because we don't provide
1450 -- a way to write this literal in Haskell.
1451 nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
1452 where
1453 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1454 `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts (Lit nullAddrLit)
1455 `setNeverRepPoly` addrPrimTy
1456
1457 ------------------------------------------------
1458 seqId :: Id -- See Note [seqId magic]
1459 seqId = pcMiscPrelId seqName ty info
1460 where
1461 info = noCafIdInfo `setInlinePragInfo` inline_prag
1462 `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
1463 `setArityInfo` arity
1464
1465 inline_prag
1466 = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
1467 NoSourceText 0
1468 -- Make 'seq' not inline-always, so that simpleOptExpr
1469 -- (see GHC.Core.Subst.simple_app) won't inline 'seq' on the
1470 -- LHS of rules. That way we can have rules for 'seq';
1471 -- see Note [seqId magic]
1472
1473 -- seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b
1474 ty =
1475 mkInfForAllTy runtimeRep2TyVar
1476 $ mkSpecForAllTys [alphaTyVar, openBetaTyVar]
1477 $ mkVisFunTyMany alphaTy (mkVisFunTyMany openBetaTy openBetaTy)
1478
1479 [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
1480 rhs = mkLams ([runtimeRep2TyVar, alphaTyVar, openBetaTyVar, x, y]) $
1481 Case (Var x) x openBetaTy [Alt DEFAULT [] (Var y)]
1482
1483 arity = 2
1484
1485 ------------------------------------------------
1486 lazyId :: Id -- See Note [lazyId magic]
1487 lazyId = pcMiscPrelId lazyIdName ty info
1488 where
1489 info = noCafIdInfo `setNeverRepPoly` ty
1490 ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTyMany alphaTy alphaTy)
1491
1492 noinlineId :: Id -- See Note [noinlineId magic]
1493 noinlineId = pcMiscPrelId noinlineIdName ty info
1494 where
1495 info = noCafIdInfo `setNeverRepPoly` ty
1496 ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTyMany alphaTy alphaTy)
1497
1498 oneShotId :: Id -- See Note [The oneShot function]
1499 oneShotId = pcMiscPrelId oneShotName ty info
1500 where
1501 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1502 `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
1503 `setArityInfo` arity
1504 ty = mkInfForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar ] $
1505 mkSpecForAllTys [ openAlphaTyVar, openBetaTyVar ] $
1506 mkVisFunTyMany fun_ty fun_ty
1507 fun_ty = mkVisFunTyMany openAlphaTy openBetaTy
1508 [body, x] = mkTemplateLocals [fun_ty, openAlphaTy]
1509 x' = setOneShotLambda x -- Here is the magic bit!
1510 rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar
1511 , openAlphaTyVar, openBetaTyVar
1512 , body, x'] $
1513 Var body `App` Var x'
1514 arity = 2
1515
1516 ----------------------------------------------------------------------
1517 {- Note [Wired-in Ids for rebindable syntax]
1518 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1519 The functions leftSectionId, rightSectionId are
1520 wired in here ONLY because they are use in a representation-polymorphic way
1521 by the rebindable syntax mechanism. See GHC.Rename.Expr
1522 Note [Handling overloaded and rebindable constructs].
1523
1524 Alas, we can't currenly give Haskell definitions for
1525 representation-polymorphic functions.
1526
1527 They have Compulsory unfoldings, so that the representation polymorphism
1528 does not linger for long.
1529 -}
1530
1531 -- See Note [Left and right sections] in GHC.Rename.Expr
1532 -- See Note [Wired-in Ids for rebindable syntax]
1533 -- leftSection :: forall r1 r2 n (a:TYPE r1) (b:TYPE r2).
1534 -- (a %n-> b) -> a %n-> b
1535 -- leftSection f x = f x
1536 -- Important that it is eta-expanded, so that (leftSection undefined `seq` ())
1537 -- is () and not undefined
1538 -- Important that is is multiplicity-polymorphic (test linear/should_compile/OldList)
1539 leftSectionId :: Id
1540 leftSectionId = pcMiscPrelId leftSectionName ty info
1541 where
1542 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1543 `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
1544 `setArityInfo` arity
1545 ty = mkInfForAllTys [runtimeRep1TyVar,runtimeRep2TyVar, multiplicityTyVar1] $
1546 mkSpecForAllTys [openAlphaTyVar, openBetaTyVar] $
1547 exprType body
1548 [f,x] = mkTemplateLocals [mkVisFunTy mult openAlphaTy openBetaTy, openAlphaTy]
1549
1550 mult = mkTyVarTy multiplicityTyVar1 :: Mult
1551 xmult = setIdMult x mult
1552
1553 rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar, multiplicityTyVar1
1554 , openAlphaTyVar, openBetaTyVar ] body
1555 body = mkLams [f,xmult] $ App (Var f) (Var xmult)
1556 arity = 2
1557
1558 -- See Note [Left and right sections] in GHC.Rename.Expr
1559 -- See Note [Wired-in Ids for rebindable syntax]
1560 -- rightSection :: forall r1 r2 r3 (a:TYPE r1) (b:TYPE r2) (c:TYPE r3).
1561 -- (a %n1 -> b %n2-> c) -> b %n2-> a %n1-> c
1562 -- rightSection f y x = f x y
1563 -- Again, multiplicity polymorphism is important
1564 rightSectionId :: Id
1565 rightSectionId = pcMiscPrelId rightSectionName ty info
1566 where
1567 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1568 `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
1569 `setArityInfo` arity
1570 ty = mkInfForAllTys [runtimeRep1TyVar,runtimeRep2TyVar,runtimeRep3TyVar
1571 , multiplicityTyVar1, multiplicityTyVar2 ] $
1572 mkSpecForAllTys [openAlphaTyVar, openBetaTyVar, openGammaTyVar ] $
1573 exprType body
1574 mult1 = mkTyVarTy multiplicityTyVar1
1575 mult2 = mkTyVarTy multiplicityTyVar2
1576
1577 [f,x,y] = mkTemplateLocals [ mkVisFunTys [ Scaled mult1 openAlphaTy
1578 , Scaled mult2 openBetaTy ] openGammaTy
1579 , openAlphaTy, openBetaTy ]
1580 xmult = setIdMult x mult1
1581 ymult = setIdMult y mult2
1582 rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar
1583 , multiplicityTyVar1, multiplicityTyVar2
1584 , openAlphaTyVar, openBetaTyVar, openGammaTyVar ] body
1585 body = mkLams [f,ymult,xmult] $ mkVarApps (Var f) [xmult,ymult]
1586 arity = 3
1587
1588 --------------------------------------------------------------------------------
1589
1590 coerceId :: Id
1591 coerceId = pcMiscPrelId coerceName ty info
1592 where
1593 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1594 `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
1595 `setArityInfo` 2
1596 eqRTy = mkTyConApp coercibleTyCon [ tYPE r , a, b ]
1597 eqRPrimTy = mkTyConApp eqReprPrimTyCon [ tYPE r, tYPE r, a, b ]
1598 ty = mkInvisForAllTys [ Bndr rv InferredSpec
1599 , Bndr av SpecifiedSpec
1600 , Bndr bv SpecifiedSpec
1601 ] $
1602 mkInvisFunTyMany eqRTy $
1603 mkVisFunTyMany a b
1604
1605 bndrs@[rv,av,bv] = mkTemplateKiTyVar runtimeRepTy
1606 (\r -> [tYPE r, tYPE r])
1607
1608 [r, a, b] = mkTyVarTys bndrs
1609
1610 [eqR,x,eq] = mkTemplateLocals [eqRTy, a, eqRPrimTy]
1611 rhs = mkLams (bndrs ++ [eqR, x]) $
1612 mkWildCase (Var eqR) (unrestricted eqRTy) b $
1613 [Alt (DataAlt coercibleDataCon) [eq] (Cast (Var x) (mkCoVarCo eq))]
1614
1615 {-
1616 Note [seqId magic]
1617 ~~~~~~~~~~~~~~~~~~
1618 'GHC.Prim.seq' is special in several ways.
1619
1620 a) Its fixity is set in GHC.Iface.Load.ghcPrimIface
1621
1622 b) It has quite a bit of desugaring magic.
1623 See GHC.HsToCore.Utils Note [Desugaring seq] (1) and (2) and (3)
1624
1625 c) There is some special rule handing: Note [User-defined RULES for seq]
1626
1627 Historical note:
1628 In GHC.Tc.Gen.Expr we used to need a special typing rule for 'seq', to handle calls
1629 whose second argument had an unboxed type, e.g. x `seq` 3#
1630
1631 However, with representation polymorphism we can now give seq the type
1632 seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b
1633 which handles this case without special treatment in the typechecker.
1634
1635 Note [User-defined RULES for seq]
1636 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1637 Roman found situations where he had
1638 case (f n) of _ -> e
1639 where he knew that f (which was strict in n) would terminate if n did.
1640 Notice that the result of (f n) is discarded. So it makes sense to
1641 transform to
1642 case n of _ -> e
1643
1644 Rather than attempt some general analysis to support this, I've added
1645 enough support that you can do this using a rewrite rule:
1646
1647 RULE "f/seq" forall n. seq (f n) = seq n
1648
1649 You write that rule. When GHC sees a case expression that discards
1650 its result, it mentally transforms it to a call to 'seq' and looks for
1651 a RULE. (This is done in GHC.Core.Opt.Simplify.trySeqRules.) As usual, the
1652 correctness of the rule is up to you.
1653
1654 VERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2.
1655 If we wrote
1656 RULE "f/seq" forall n e. seq (f n) e = seq n e
1657 with rule arity 2, then two bad things would happen:
1658
1659 - The magical desugaring done in Note [seqId magic] item (b)
1660 for saturated application of 'seq' would turn the LHS into
1661 a case expression!
1662
1663 - The code in GHC.Core.Opt.Simplify.rebuildCase would need to actually supply
1664 the value argument, which turns out to be awkward.
1665
1666 See also: Note [User-defined RULES for seq] in GHC.Core.Opt.Simplify.
1667
1668
1669 Note [lazyId magic]
1670 ~~~~~~~~~~~~~~~~~~~
1671 lazy :: forall a. a -> a
1672
1673 'lazy' is used to make sure that a sub-expression, and its free variables,
1674 are truly used call-by-need, with no code motion. Key examples:
1675
1676 * pseq: pseq a b = a `seq` lazy b
1677 We want to make sure that the free vars of 'b' are not evaluated
1678 before 'a', even though the expression is plainly strict in 'b'.
1679
1680 * catch: catch a b = catch# (lazy a) b
1681 Again, it's clear that 'a' will be evaluated strictly (and indeed
1682 applied to a state token) but we want to make sure that any exceptions
1683 arising from the evaluation of 'a' are caught by the catch (see
1684 #11555).
1685
1686 Implementing 'lazy' is a bit tricky:
1687
1688 * It must not have a strictness signature: by being a built-in Id,
1689 all the info about lazyId comes from here, not from GHC.Magic.hi.
1690 This is important, because the strictness analyser will spot it as
1691 strict!
1692
1693 * It must not have an unfolding: it gets "inlined" by a HACK in
1694 CorePrep. It's very important to do this inlining *after* unfoldings
1695 are exposed in the interface file. Otherwise, the unfolding for
1696 (say) pseq in the interface file will not mention 'lazy', so if we
1697 inline 'pseq' we'll totally miss the very thing that 'lazy' was
1698 there for in the first place. See #3259 for a real world
1699 example.
1700
1701 * Suppose CorePrep sees (catch# (lazy e) b). At all costs we must
1702 avoid using call by value here:
1703 case e of r -> catch# r b
1704 Avoiding that is the whole point of 'lazy'. So in CorePrep (which
1705 generate the 'case' expression for a call-by-value call) we must
1706 spot the 'lazy' on the arg (in CorePrep.cpeApp), and build a 'let'
1707 instead.
1708
1709 * lazyId is defined in GHC.Base, so we don't *have* to inline it. If it
1710 appears un-applied, we'll end up just calling it.
1711
1712 Note [noinlineId magic]
1713 ~~~~~~~~~~~~~~~~~~~~~~~
1714 'noinline' is used to make sure that a function f is never inlined,
1715 e.g., as in 'noinline f x'. We won't inline f because we never inline
1716 lone variables (see Note [Lone variables] in GHC.Core.Unfold
1717
1718 You might think that we could implement noinline like this:
1719 {-# NOINLINE #-}
1720 noinline :: forall a. a -> a
1721 noinline x = x
1722
1723 But actually we give 'noinline' a wired-in name for three distinct reasons:
1724
1725 1. We don't want to leave a (useless) call to noinline in the final program,
1726 to be executed at runtime. So we have a little bit of magic to
1727 optimize away 'noinline' after we are done running the simplifier.
1728 This is done in GHC.CoreToStg.Prep.cpeApp.
1729
1730 2. 'noinline' sometimes gets inserted automatically when we serialize an
1731 expression to the interface format, in GHC.CoreToIface.toIfaceVar.
1732 See Note [Inlining and hs-boot files] in GHC.CoreToIface
1733
1734 3. Given foo :: Eq a => [a] -> Bool, the expression
1735 noinline foo x xs
1736 where x::Int, will naturally desugar to
1737 noinline @Int (foo @Int dEqInt) x xs
1738 But now it's entirely possible htat (foo @Int dEqInt) will inline foo,
1739 since 'foo' is no longer a lone variable -- see #18995
1740
1741 Solution: in the desugarer, rewrite
1742 noinline (f x y) ==> noinline f x y
1743 This is done in GHC.HsToCore.Utils.mkCoreAppDs.
1744
1745 Note that noinline as currently implemented can hide some simplifications since
1746 it hides strictness from the demand analyser. Specifically, the demand analyser
1747 will treat 'noinline f x' as lazy in 'x', even if the demand signature of 'f'
1748 specifies that it is strict in its argument. We considered fixing this this by adding a
1749 special case to the demand analyser to address #16588. However, the special
1750 case seemed like a large and expensive hammer to address a rare case and
1751 consequently we rather opted to use a more minimal solution.
1752
1753 Note [The oneShot function]
1754 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1755 In the context of making left-folds fuse somewhat okish (see ticket #7994
1756 and Note [Left folds via right fold]) it was determined that it would be useful
1757 if library authors could explicitly tell the compiler that a certain lambda is
1758 called at most once. The oneShot function allows that.
1759
1760 'oneShot' is representation-polymorphic, i.e. the type variables can refer
1761 to unlifted types as well (#10744); e.g.
1762 oneShot (\x:Int# -> x +# 1#)
1763
1764 Like most magic functions it has a compulsory unfolding, so there is no need
1765 for a real definition somewhere. We have one in GHC.Magic for the convenience
1766 of putting the documentation there.
1767
1768 It uses `setOneShotLambda` on the lambda's binder. That is the whole magic:
1769
1770 A typical call looks like
1771 oneShot (\y. e)
1772 after unfolding the definition `oneShot = \f \x[oneshot]. f x` we get
1773 (\f \x[oneshot]. f x) (\y. e)
1774 --> \x[oneshot]. ((\y.e) x)
1775 --> \x[oneshot] e[x/y]
1776 which is what we want.
1777
1778 It is only effective if the one-shot info survives as long as possible; in
1779 particular it must make it into the interface in unfoldings. See Note [Preserve
1780 OneShotInfo] in GHC.Core.Tidy.
1781
1782 Also see https://gitlab.haskell.org/ghc/ghc/wikis/one-shot.
1783
1784
1785 -------------------------------------------------------------
1786 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
1787 nasty as-is, change it back to a literal (@Literal@).
1788
1789 voidArgId is a Local Id used simply as an argument in functions
1790 where we just want an arg to avoid having a thunk of unlifted type.
1791 E.g.
1792 x = \ void :: Void# -> (# p, q #)
1793
1794 This comes up in strictness analysis
1795
1796 Note [evaldUnfoldings]
1797 ~~~~~~~~~~~~~~~~~~~~~~
1798 The evaldUnfolding makes it look that some primitive value is
1799 evaluated, which in turn makes Simplify.interestingArg return True,
1800 which in turn makes INLINE things applied to said value likely to be
1801 inlined.
1802 -}
1803
1804 realWorldPrimId :: Id -- :: State# RealWorld
1805 realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy
1806 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1807 `setOneShotInfo` stateHackOneShot
1808 `setNeverRepPoly` realWorldStatePrimTy)
1809
1810 voidPrimId :: Id -- Global constant :: Void#
1811 -- The type Void# is now the same as (# #) (ticket #18441),
1812 -- this identifier just signifies the (# #) datacon
1813 -- and is kept for backwards compatibility.
1814 -- We cannot define it in normal Haskell, since it's
1815 -- a top-level unlifted value.
1816 voidPrimId = pcMiscPrelId voidPrimIdName unboxedUnitTy
1817 (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
1818 `setNeverRepPoly` unboxedUnitTy)
1819 where rhs = Var (dataConWorkId unboxedUnitDataCon)
1820
1821
1822 voidArgId :: Id -- Local lambda-bound :: Void#
1823 voidArgId = mkSysLocal (fsLit "void") voidArgIdKey Many unboxedUnitTy
1824
1825 coercionTokenId :: Id -- :: () ~# ()
1826 coercionTokenId -- See Note [Coercion tokens] in "GHC.CoreToStg"
1827 = pcMiscPrelId coercionTokenName
1828 (mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy])
1829 noCafIdInfo
1830
1831 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
1832 pcMiscPrelId name ty info
1833 = mkVanillaGlobalWithInfo name ty info