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