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