compiler/basicTypes/MkId.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1998
   3 %
   4 \section[StdIdInfo]{Standard unfoldings}
   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 \begin{code}
  15 module MkId (
  16         mkDictFunId, mkDefaultMethodId,
  17         mkDictSelId,
  18
  19         mkDataConIds,
  20         mkRecordSelId,
  21         mkPrimOpId, mkFCallId,
  22
  23         mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
  24         mkUnpackCase, mkProductBox,
  25
  26         -- And some particular Ids; see below for why they are wired in
  27         wiredInIds, ghcPrimIds,
  28         unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
  29         lazyId, lazyIdUnfolding, lazyIdKey,
  30
  31         mkRuntimeErrorApp,
  32         rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
  33         nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
  34         pAT_ERROR_ID, eRROR_ID,
  35
  36         unsafeCoerceName
  37     ) where
  38
  39 #include "HsVersions.h"
  40
  41
  42 import BasicTypes       ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
  43 import Rules            ( mkSpecInfo )
  44 import TysPrim          ( openAlphaTyVars, alphaTyVar, alphaTy,
  45                           realWorldStatePrimTy, addrPrimTy
  46                         )
  47 import TysWiredIn       ( charTy, mkListTy )
  48 import PrelRules        ( primOpRules )
  49 import Type             ( TyThing(..), mkForAllTy, tyVarsOfTypes, newTyConInstRhs, coreEqType,
  50                           mkTopTvSubst, substTyVar )
  51 import Coercion         ( mkSymCoercion, mkUnsafeCoercion,
  52                           splitNewTypeRepCo_maybe )
  53 import TcType           ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy,
  54                           mkTyConApp, mkTyVarTys, mkClassPred,
  55                           mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy,
  56                           isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
  57                           tcSplitFunTys, tcSplitForAllTys, dataConsStupidTheta
  58                         )
  59 import CoreUtils        ( exprType )
  60 import CoreUnfold       ( mkTopUnfolding, mkCompulsoryUnfolding )
  61 import Literal          ( nullAddrLit, mkStringLit )
  62 import TyCon            ( TyCon, isNewTyCon, tyConDataCons, FieldLabel,
  63                           tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon,
  64                           newTyConCo, tyConArity )
  65 import Class            ( Class, classTyCon, classSelIds )
  66 import Var              ( Id, TyVar, Var, setIdType )
  67 import VarSet           ( isEmptyVarSet, subVarSet, varSetElems )
  68 import Name             ( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..) )
  69 import OccName          ( mkOccNameFS, varName )
  70 import PrimOp           ( PrimOp, primOpSig, primOpOcc, primOpTag )
  71 import ForeignCall      ( ForeignCall )
  72 import DataCon          ( DataCon, DataConIds(..), dataConTyCon, dataConUnivTyVars,
  73                           dataConFieldLabels, dataConRepArity, dataConResTys,
  74                           dataConRepArgTys, dataConRepType, dataConFullSig,
  75                           dataConSig, dataConStrictMarks, dataConExStricts,
  76                           splitProductType, isVanillaDataCon, dataConFieldType,
  77                           dataConInstOrigArgTys, deepSplitProductType
  78                         )
  79 import Id               ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
  80                           mkTemplateLocals, mkTemplateLocalsNum, mkExportedLocalId,
  81                           mkTemplateLocal, idName, mkWildId
  82                         )
  83 import IdInfo           ( IdInfo, noCafIdInfo,  setUnfoldingInfo,
  84                           setArityInfo, setSpecInfo, setCafInfo,
  85                           setAllStrictnessInfo, vanillaIdInfo,
  86                           GlobalIdDetails(..), CafInfo(..)
  87                         )
  88 import NewDemand        ( mkStrictSig, DmdResult(..),
  89                           mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
  90                           Demand(..), Demands(..) )
  91 import DmdAnal          ( dmdAnalTopRhs )
  92 import CoreSyn
  93 import Unique           ( mkBuiltinUnique, mkPrimOpIdUnique )
  94 import Maybes
  95 import PrelNames
  96 import Util             ( dropList, isSingleton )
  97 import Outputable
  98 import FastString
  99 import ListSetOps       ( assoc, minusList )
 100 \end{code}
 101
 102 %************************************************************************
 103 %*                                                                      *
 104 \subsection{Wired in Ids}
 105 %*                                                                      *
 106 %************************************************************************
 107
 108 \begin{code}
 109 wiredInIds
 110   = [   -- These error-y things are wired in because we don't yet have
 111         -- a way to express in an interface file that the result type variable
 112         -- is 'open'; that is can be unified with an unboxed type
 113         --
 114         -- [The interface file format now carry such information, but there's
 115         -- no way yet of expressing at the definition site for these
 116         -- error-reporting functions that they have an 'open'
 117         -- result type. -- sof 1/99]
 118
 119     eRROR_ID,   -- This one isn't used anywhere else in the compiler
 120                 -- But we still need it in wiredInIds so that when GHC
 121                 -- compiles a program that mentions 'error' we don't
 122                 -- import its type from the interface file; we just get
 123                 -- the Id defined here.  Which has an 'open-tyvar' type.
 124
 125     rUNTIME_ERROR_ID,
 126     iRREFUT_PAT_ERROR_ID,
 127     nON_EXHAUSTIVE_GUARDS_ERROR_ID,
 128     nO_METHOD_BINDING_ERROR_ID,
 129     pAT_ERROR_ID,
 130     rEC_CON_ERROR_ID,
 131
 132     lazyId
 133     ] ++ ghcPrimIds
 134
 135 -- These Ids are exported from GHC.Prim
 136 ghcPrimIds
 137   = [   -- These can't be defined in Haskell, but they have
 138         -- perfectly reasonable unfoldings in Core
 139     realWorldPrimId,
 140     unsafeCoerceId,
 141     nullAddrId,
 142     seqId
 143     ]
 144 \end{code}
 145
 146 %************************************************************************
 147 %*                                                                      *
 148 \subsection{Data constructors}
 149 %*                                                                      *
 150 %************************************************************************
 151
 152 The wrapper for a constructor is an ordinary top-level binding that evaluates
 153 any strict args, unboxes any args that are going to be flattened, and calls
 154 the worker.
 155
 156 We're going to build a constructor that looks like:
 157
 158         data (Data a, C b) =>  T a b = T1 !a !Int b
 159
 160         T1 = /\ a b ->
 161              \d1::Data a, d2::C b ->
 162              \p q r -> case p of { p ->
 163                        case q of { q ->
 164                        Con T1 [a,b] [p,q,r]}}
 165
 166 Notice that
 167
 168 * d2 is thrown away --- a context in a data decl is used to make sure
 169   one *could* construct dictionaries at the site the constructor
 170   is used, but the dictionary isn't actually used.
 171
 172 * We have to check that we can construct Data dictionaries for
 173   the types a and Int.  Once we've done that we can throw d1 away too.
 174
 175 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
 176   all that matters is that the arguments are evaluated.  "seq" is
 177   very careful to preserve evaluation order, which we don't need
 178   to be here.
 179
 180   You might think that we could simply give constructors some strictness
 181   info, like PrimOps, and let CoreToStg do the let-to-case transformation.
 182   But we don't do that because in the case of primops and functions strictness
 183   is a *property* not a *requirement*.  In the case of constructors we need to
 184   do something active to evaluate the argument.
 185
 186   Making an explicit case expression allows the simplifier to eliminate
 187   it in the (common) case where the constructor arg is already evaluated.
 188
 189
 190 \begin{code}
 191 mkDataConIds :: Name -> Name -> DataCon -> DataConIds
 192 mkDataConIds wrap_name wkr_name data_con
 193   | isNewTyCon tycon
 194   = NewDC nt_wrap_id
 195
 196   | any isMarkedStrict all_strict_marks         -- Algebraic, needs wrapper
 197     || not (null eq_spec)
 198   = AlgDC (Just alg_wrap_id) wrk_id
 199
 200   | otherwise                                   -- Algebraic, no wrapper
 201   = AlgDC Nothing wrk_id
 202   where
 203     (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys) = dataConFullSig data_con
 204     tycon = dataConTyCon data_con
 205
 206         ----------- Wrapper --------------
 207         -- We used to include the stupid theta in the wrapper's args
 208         -- but now we don't.  Instead the type checker just injects these
 209         -- extra constraints where necessary.
 210     wrap_tvs = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs
 211     subst          = mkTopTvSubst eq_spec
 212     dict_tys       = mkPredTys theta
 213     result_ty_args = map (substTyVar subst) univ_tvs
 214     result_ty      = mkTyConApp tycon result_ty_args
 215     wrap_ty        = mkForAllTys wrap_tvs $ mkFunTys dict_tys $
 216                      mkFunTys orig_arg_tys $ result_ty
 217         -- NB: watch out here if you allow user-written equality
 218         --     constraints in data constructor signatures
 219
 220         ----------- Worker (algebraic data types only) --------------
 221         -- The *worker* for the data constructor is the function that
 222         -- takes the representation arguments and builds the constructor.
 223     wrk_id = mkGlobalId (DataConWorkId data_con) wkr_name
 224                         (dataConRepType data_con) wkr_info
 225
 226     wkr_arity = dataConRepArity data_con
 227     wkr_info  = noCafIdInfo
 228                 `setArityInfo`          wkr_arity
 229                 `setAllStrictnessInfo`  Just wkr_sig
 230                 `setUnfoldingInfo`      evaldUnfolding  -- Record that it's evaluated,
 231                                                         -- even if arity = 0
 232
 233     wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
 234         -- Notice that we do *not* say the worker is strict
 235         -- even if the data constructor is declared strict
 236         --      e.g.    data T = MkT !(Int,Int)
 237         -- Why?  Because the *wrapper* is strict (and its unfolding has case
 238         -- expresssions that do the evals) but the *worker* itself is not.
 239         -- If we pretend it is strict then when we see
 240         --      case x of y -> $wMkT y
 241         -- the simplifier thinks that y is "sure to be evaluated" (because
 242         --  $wMkT is strict) and drops the case.  No, $wMkT is not strict.
 243         --
 244         -- When the simplifer sees a pattern
 245         --      case e of MkT x -> ...
 246         -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
 247         -- but that's fine... dataConRepStrictness comes from the data con
 248         -- not from the worker Id.
 249
 250     cpr_info | isProductTyCon tycon &&
 251                isDataTyCon tycon    &&
 252                wkr_arity > 0        &&
 253                wkr_arity <= mAX_CPR_SIZE        = retCPR
 254              | otherwise                        = TopRes
 255         -- RetCPR is only true for products that are real data types;
 256         -- that is, not unboxed tuples or [non-recursive] newtypes
 257
 258         ----------- Wrappers for newtypes --------------
 259     nt_wrap_id   = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty nt_wrap_info
 260     nt_wrap_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo
 261                   `setArityInfo` 1      -- Arity 1
 262                   `setUnfoldingInfo`     newtype_unf
 263     newtype_unf  = ASSERT( isVanillaDataCon data_con &&
 264                            isSingleton orig_arg_tys )
 265                    -- No existentials on a newtype, but it can have a context
 266                    -- e.g.      newtype Eq a => T a = MkT (...)
 267                    mkCompulsoryUnfolding $
 268                    mkLams wrap_tvs $ Lam id_arg1 $
 269                    wrapNewTypeBody tycon result_ty_args
 270                        (Var id_arg1)
 271
 272     id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
 273
 274         ----------- Wrappers for algebraic data types --------------
 275     alg_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty alg_wrap_info
 276     alg_wrap_info = noCafIdInfo         -- The NoCaf-ness is set by noCafIdInfo
 277                     `setArityInfo`         alg_arity
 278                         -- It's important to specify the arity, so that partial
 279                         -- applications are treated as values
 280                     `setUnfoldingInfo`     alg_unf
 281                     `setAllStrictnessInfo` Just wrap_sig
 282
 283     all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
 284     wrap_sig = mkStrictSig (mkTopDmdType arg_dmds cpr_info)
 285     arg_dmds = map mk_dmd all_strict_marks
 286     mk_dmd str | isMarkedStrict str = evalDmd
 287                | otherwise          = lazyDmd
 288         -- The Cpr info can be important inside INLINE rhss, where the
 289         -- wrapper constructor isn't inlined.
 290         -- And the argument strictness can be important too; we
 291         -- may not inline a contructor when it is partially applied.
 292         -- For example:
 293         --      data W = C !Int !Int !Int
 294         --      ...(let w = C x in ...(w p q)...)...
 295         -- we want to see that w is strict in its two arguments
 296
 297     alg_unf = mkTopUnfolding $ Note InlineMe $
 298               mkLams wrap_tvs $
 299               mkLams dict_args $ mkLams id_args $
 300               foldr mk_case con_app
 301                     (zip (dict_args ++ id_args) all_strict_marks)
 302                     i3 []
 303
 304     con_app i rep_ids = Var wrk_id `mkTyApps`  result_ty_args
 305                                    `mkVarApps` ex_tvs
 306                                    `mkTyApps`  map snd eq_spec
 307                                    `mkVarApps` reverse rep_ids
 308
 309     (dict_args,i2) = mkLocals 1  dict_tys
 310     (id_args,i3)   = mkLocals i2 orig_arg_tys
 311     alg_arity      = i3-1
 312
 313     mk_case
 314            :: (Id, StrictnessMark)      -- Arg, strictness
 315            -> (Int -> [Id] -> CoreExpr) -- Body
 316            -> Int                       -- Next rep arg id
 317            -> [Id]                      -- Rep args so far, reversed
 318            -> CoreExpr
 319     mk_case (arg,strict) body i rep_args
 320           = case strict of
 321                 NotMarkedStrict -> body i (arg:rep_args)
 322                 MarkedStrict
 323                    | isUnLiftedType (idType arg) -> body i (arg:rep_args)
 324                    | otherwise ->
 325                         Case (Var arg) arg result_ty [(DEFAULT,[], body i (arg:rep_args))]
 326
 327                 MarkedUnboxed
 328                    -> unboxProduct i (Var arg) (idType arg) the_body result_ty
 329                       where
 330                         the_body i con_args = body i (reverse con_args ++ rep_args)
 331
 332 mAX_CPR_SIZE :: Arity
 333 mAX_CPR_SIZE = 10
 334 -- We do not treat very big tuples as CPR-ish:
 335 --      a) for a start we get into trouble because there aren't
 336 --         "enough" unboxed tuple types (a tiresome restriction,
 337 --         but hard to fix),
 338 --      b) more importantly, big unboxed tuples get returned mainly
 339 --         on the stack, and are often then allocated in the heap
 340 --         by the caller.  So doing CPR for them may in fact make
 341 --         things worse.
 342
 343 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
 344                where
 345                  n = length tys
 346 \end{code}
 347
 348
 349 %************************************************************************
 350 %*                                                                      *
 351 \subsection{Record selectors}
 352 %*                                                                      *
 353 %************************************************************************
 354
 355 We're going to build a record selector unfolding that looks like this:
 356
 357         data T a b c = T1 { ..., op :: a, ...}
 358                      | T2 { ..., op :: a, ...}
 359                      | T3
 360
 361         sel = /\ a b c -> \ d -> case d of
 362                                     T1 ... x ... -> x
 363                                     T2 ... x ... -> x
 364                                     other        -> error "..."
 365
 366 Similarly for newtypes
 367
 368         newtype N a = MkN { unN :: a->a }
 369
 370         unN :: N a -> a -> a
 371         unN n = coerce (a->a) n
 372
 373 We need to take a little care if the field has a polymorphic type:
 374
 375         data R = R { f :: forall a. a->a }
 376
 377 Then we want
 378
 379         f :: forall a. R -> a -> a
 380         f = /\ a \ r = case r of
 381                           R f -> f a
 382
 383 (not f :: R -> forall a. a->a, which gives the type inference mechanism
 384 problems at call sites)
 385
 386 Similarly for (recursive) newtypes
 387
 388         newtype N = MkN { unN :: forall a. a->a }
 389
 390         unN :: forall b. N -> b -> b
 391         unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
 392
 393
 394 Note [Naughty record selectors]
 395 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 396 A "naughty" field is one for which we can't define a record
 397 selector, because an existential type variable would escape.  For example:
 398         data T = forall a. MkT { x,y::a }
 399 We obviously can't define
 400         x (MkT v _) = v
 401 Nevertheless we *do* put a RecordSelId into the type environment
 402 so that if the user tries to use 'x' as a selector we can bleat
 403 helpfully, rather than saying unhelpfully that 'x' is not in scope.
 404 Hence the sel_naughty flag, to identify record selectors that don't really exist.
 405
 406 In general, a field is naughty if its type mentions a type variable that
 407 isn't in the result type of the constructor.
 408
 409 Note [GADT record selectors]
 410 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 411 For GADTs, we require that all constructors with a common field 'f' have the same
 412 result type (modulo alpha conversion).  [Checked in TcTyClsDecls.checkValidTyCon]
 413 E.g.
 414         data T where
 415           T1 { f :: a } :: T [a]
 416           T2 { f :: a, y :: b  } :: T [a]
 417 and now the selector takes that type as its argument:
 418         f :: forall a. T [a] -> a
 419         f t = case t of
 420                 T1 { f = v } -> v
 421                 T2 { f = v } -> v
 422 Note the forall'd tyvars of the selector are just the free tyvars
 423 of the result type; there may be other tyvars in the constructor's
 424 type (e.g. 'b' in T2).
 425
 426 \begin{code}
 427
 428 -- Steps for handling "naughty" vs "non-naughty" selectors:
 429 --  1. Determine naughtiness by comparing field type vs result type
 430 --  2. Install naughty ones with selector_ty of type _|_ and fill in mzero for info
 431 --  3. If it's not naughty, do the normal plan.
 432
 433 mkRecordSelId :: TyCon -> FieldLabel -> Id
 434 mkRecordSelId tycon field_label
 435         -- Assumes that all fields with the same field label have the same type
 436   | is_naughty = naughty_id
 437   | otherwise  = sel_id
 438   where
 439     is_naughty = not (tyVarsOfType field_ty `subVarSet` res_tv_set)
 440     sel_id_details = RecordSelId tycon field_label is_naughty
 441
 442     -- Escapist case here for naughty construcotrs
 443     -- We give it no IdInfo, and a type of forall a.a (never looked at)
 444     naughty_id = mkGlobalId sel_id_details field_label forall_a_a noCafIdInfo
 445     forall_a_a = mkForAllTy alphaTyVar (mkTyVarTy alphaTyVar)
 446
 447     -- Normal case starts here
 448     sel_id = mkGlobalId sel_id_details field_label selector_ty info
 449     data_cons         = tyConDataCons tycon
 450     data_cons_w_field = filter has_field data_cons      -- Can't be empty!
 451     has_field con     = field_label `elem` dataConFieldLabels con
 452
 453     con1        = head data_cons_w_field
 454     res_tys     = dataConResTys con1
 455     res_tv_set  = tyVarsOfTypes res_tys
 456     res_tvs     = varSetElems res_tv_set
 457     data_ty     = mkTyConApp tycon res_tys
 458     field_ty    = dataConFieldType con1 field_label
 459
 460         -- *Very* tiresomely, the selectors are (unnecessarily!) overloaded over
 461         -- just the dictionaries in the types of the constructors that contain
 462         -- the relevant field.  [The Report says that pattern matching on a
 463         -- constructor gives the same constraints as applying it.]  Urgh.
 464         --
 465         -- However, not all data cons have all constraints (because of
 466         -- BuildTyCl.mkDataConStupidTheta).  So we need to find all the data cons
 467         -- involved in the pattern match and take the union of their constraints.
 468     stupid_dict_tys = mkPredTys (dataConsStupidTheta data_cons_w_field)
 469     n_stupid_dicts  = length stupid_dict_tys
 470
 471     (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
 472     field_dict_tys                       = mkPredTys field_theta
 473     n_field_dict_tys                     = length field_dict_tys
 474         -- If the field has a universally quantified type we have to
 475         -- be a bit careful.  Suppose we have
 476         --      data R = R { op :: forall a. Foo a => a -> a }
 477         -- Then we can't give op the type
 478         --      op :: R -> forall a. Foo a => a -> a
 479         -- because the typechecker doesn't understand foralls to the
 480         -- right of an arrow.  The "right" type to give it is
 481         --      op :: forall a. Foo a => R -> a -> a
 482         -- But then we must generate the right unfolding too:
 483         --      op = /\a -> \dfoo -> \ r ->
 484         --           case r of
 485         --              R op -> op a dfoo
 486         -- Note that this is exactly the type we'd infer from a user defn
 487         --      op (R op) = op
 488
 489     selector_ty :: Type
 490     selector_ty  = mkForAllTys res_tvs $ mkForAllTys field_tyvars $
 491                    mkFunTys stupid_dict_tys  $  mkFunTys field_dict_tys $
 492                    mkFunTy data_ty field_tau
 493
 494     arity = 1 + n_stupid_dicts + n_field_dict_tys
 495
 496     (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
 497         -- Use the demand analyser to work out strictness.
 498         -- With all this unpackery it's not easy!
 499
 500     info = noCafIdInfo
 501            `setCafInfo`           caf_info
 502            `setArityInfo`         arity
 503            `setUnfoldingInfo`     mkTopUnfolding rhs_w_str
 504            `setAllStrictnessInfo` Just strict_sig
 505
 506         -- Allocate Ids.  We do it a funny way round because field_dict_tys is
 507         -- almost always empty.  Also note that we use max_dict_tys
 508         -- rather than n_dict_tys, because the latter gives an infinite loop:
 509         -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
 510         -- on arity, which depends on n_dict tys.  Sigh!  Mega sigh!
 511     stupid_dict_ids  = mkTemplateLocalsNum 1 stupid_dict_tys
 512     max_stupid_dicts = length (tyConStupidTheta tycon)
 513     field_dict_base  = max_stupid_dicts + 1
 514     field_dict_ids   = mkTemplateLocalsNum field_dict_base field_dict_tys
 515     dict_id_base     = field_dict_base + n_field_dict_tys
 516     data_id          = mkTemplateLocal dict_id_base data_ty
 517     arg_base         = dict_id_base + 1
 518
 519     the_alts :: [CoreAlt]
 520     the_alts   = map mk_alt data_cons_w_field   -- Already sorted by data-con
 521     no_default = length data_cons == length data_cons_w_field   -- No default needed
 522
 523     default_alt | no_default = []
 524                 | otherwise  = [(DEFAULT, [], error_expr)]
 525
 526         -- The default branch may have CAF refs, because it calls recSelError etc.
 527     caf_info    | no_default = NoCafRefs
 528                 | otherwise  = MayHaveCafRefs
 529
 530     sel_rhs = mkLams res_tvs $ mkLams field_tyvars $
 531               mkLams stupid_dict_ids $ mkLams field_dict_ids $
 532               Lam data_id     $ mk_result sel_body
 533
 534         -- NB: A newtype always has a vanilla DataCon; no existentials etc
 535         --     res_tys will simply be the dataConUnivTyVars
 536     sel_body | isNewTyCon tycon = unwrapNewTypeBody tycon res_tys (Var data_id)
 537              | otherwise        = Case (Var data_id) data_id field_ty (default_alt ++ the_alts)
 538
 539     mk_result poly_result = mkVarApps (mkVarApps poly_result field_tyvars) field_dict_ids
 540         -- We pull the field lambdas to the top, so we need to
 541         -- apply them in the body.  For example:
 542         --      data T = MkT { foo :: forall a. a->a }
 543         --
 544         --      foo :: forall a. T -> a -> a
 545         --      foo = /\a. \t:T. case t of { MkT f -> f a }
 546
 547     mk_alt data_con
 548       =         -- In the non-vanilla case, the pattern must bind type variables and
 549                 -- the context stuff; hence the arg_prefix binding below
 550           mkReboxingAlt uniqs data_con (arg_prefix ++ arg_ids) (Var the_arg_id)
 551       where
 552         (arg_prefix, arg_ids)
 553            | isVanillaDataCon data_con          -- Instantiate from commmon base
 554            = ([], mkTemplateLocalsNum arg_base (dataConInstOrigArgTys data_con res_tys))
 555            | otherwise          -- The case pattern binds type variables, which are used
 556                                 -- in the types of the arguments of the pattern
 557            = (dc_tvs ++ mkTemplateLocalsNum arg_base (mkPredTys dc_theta),
 558               mkTemplateLocalsNum arg_base' dc_arg_tys)
 559
 560         (dc_tvs, dc_theta, dc_arg_tys) = dataConSig data_con
 561         arg_base' = arg_base + length dc_theta
 562
 563         unpack_base = arg_base' + length dc_arg_tys
 564         uniqs = map mkBuiltinUnique [unpack_base..]
 565
 566         the_arg_id  = assoc "mkRecordSelId:mk_alt" (field_lbls `zip` arg_ids) field_label
 567         field_lbls  = dataConFieldLabels data_con
 568
 569     error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
 570     full_msg   = showSDoc (sep [text "No match in record selector", ppr sel_id])
 571
 572 -- unbox a product type...
 573 -- we will recurse into newtypes, casting along the way, and unbox at the
 574 -- first product data constructor we find. e.g.
 575 --
 576 --   data PairInt = PairInt Int Int
 577 --   newtype S = MkS PairInt
 578 --   newtype T = MkT S
 579 --
 580 -- If we have e = MkT (MkS (PairInt 0 1)) and some body expecting a list of
 581 -- ids, we get (modulo int passing)
 582 --
 583 --   case (e `cast` (sym CoT)) `cast` (sym CoS) of
 584 --     PairInt a b -> body [a,b]
 585 --
 586 -- The Ints passed around are just for creating fresh locals
 587 unboxProduct :: Int -> CoreExpr -> Type -> (Int -> [Id] -> CoreExpr) -> Type -> CoreExpr
 588 unboxProduct i arg arg_ty body res_ty
 589   = result
 590   where
 591     result = mkUnpackCase the_id arg arg_ty con_args boxing_con rhs
 592     (tycon, tycon_args, boxing_con, tys) = deepSplitProductType "unboxProduct" arg_ty
 593     ([the_id], i') = mkLocals i [arg_ty]
 594     (con_args, i'') = mkLocals i' tys
 595     rhs = body i'' con_args
 596
 597 mkUnpackCase ::  Id -> CoreExpr -> Type -> [Id] -> DataCon -> CoreExpr -> CoreExpr
 598 -- (mkUnpackCase x e args Con body)
 599 --      returns
 600 -- case (e `cast` ...) of bndr { Con args -> body }
 601 --
 602 -- the type of the bndr passed in is irrelevent
 603 mkUnpackCase bndr arg arg_ty unpk_args boxing_con body
 604   = Case cast_arg (setIdType bndr bndr_ty) (exprType body) [(DataAlt boxing_con, unpk_args, body)]
 605   where
 606   (cast_arg, bndr_ty) = go (idType bndr) arg
 607   go ty arg
 608     | res@(tycon, tycon_args, _, _)  <- splitProductType "mkUnpackCase" ty
 609     , isNewTyCon tycon && not (isRecursiveTyCon tycon)
 610     = go (newTyConInstRhs tycon tycon_args)
 611          (unwrapNewTypeBody tycon tycon_args arg)
 612     | otherwise = (arg, ty)
 613
 614 -- ...and the dual
 615 reboxProduct :: [Unique]     -- uniques to create new local binders
 616              -> Type         -- type of product to box
 617              -> ([Unique],   -- remaining uniques
 618                  CoreExpr,   -- boxed product
 619                  [Id])       -- Ids being boxed into product
 620 reboxProduct us ty
 621   = let
 622         (tycon, tycon_args, pack_con, con_arg_tys) = deepSplitProductType "reboxProduct" ty
 623
 624         us' = dropList con_arg_tys us
 625
 626         arg_ids  = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
 627
 628         bind_rhs = mkProductBox arg_ids ty
 629
 630     in
 631       (us', bind_rhs, arg_ids)
 632
 633 mkProductBox :: [Id] -> Type -> CoreExpr
 634 mkProductBox arg_ids ty
 635   = result_expr
 636   where
 637     (tycon, tycon_args, pack_con, con_arg_tys) = splitProductType "mkProductBox" ty
 638
 639     result_expr
 640       | isNewTyCon tycon && not (isRecursiveTyCon tycon)
 641       = wrap (mkProductBox arg_ids (newTyConInstRhs tycon tycon_args))
 642       | otherwise = mkConApp pack_con (map Type tycon_args ++ map Var arg_ids)
 643
 644     wrap expr = wrapNewTypeBody tycon tycon_args expr
 645
 646
 647 -- (mkReboxingAlt us con xs rhs) basically constructs the case
 648 -- alternative  (con, xs, rhs)
 649 -- but it does the reboxing necessary to construct the *source*
 650 -- arguments, xs, from the representation arguments ys.
 651 -- For example:
 652 --      data T = MkT !(Int,Int) Bool
 653 --
 654 -- mkReboxingAlt MkT [x,b] r
 655 --      = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
 656 --
 657 -- mkDataAlt should really be in DataCon, but it can't because
 658 -- it manipulates CoreSyn.
 659
 660 mkReboxingAlt
 661   :: [Unique]           -- Uniques for the new Ids
 662   -> DataCon
 663   -> [Var]              -- Source-level args, including existential dicts
 664   -> CoreExpr           -- RHS
 665   -> CoreAlt
 666
 667 mkReboxingAlt us con args rhs
 668   | not (any isMarkedUnboxed stricts)
 669   = (DataAlt con, args, rhs)
 670
 671   | otherwise
 672   = let
 673         (binds, args') = go args stricts us
 674     in
 675     (DataAlt con, args', mkLets binds rhs)
 676
 677   where
 678     stricts = dataConExStricts con ++ dataConStrictMarks con
 679
 680     go [] stricts us = ([], [])
 681
 682         -- Type variable case
 683     go (arg:args) stricts us
 684       | isTyVar arg
 685       = let (binds, args') = go args stricts us
 686         in  (binds, arg:args')
 687
 688         -- Term variable case
 689     go (arg:args) (str:stricts) us
 690       | isMarkedUnboxed str
 691       =
 692         let (binds, unpacked_args')        = go args stricts us'
 693             (us', bind_rhs, unpacked_args) = reboxProduct us (idType arg)
 694         in
 695             (NonRec arg bind_rhs : binds, unpacked_args ++ unpacked_args')
 696       | otherwise
 697       = let (binds, args') = go args stricts us
 698         in  (binds, arg:args')
 699 \end{code}
 700
 701
 702 %************************************************************************
 703 %*                                                                      *
 704 \subsection{Dictionary selectors}
 705 %*                                                                      *
 706 %************************************************************************
 707
 708 Selecting a field for a dictionary.  If there is just one field, then
 709 there's nothing to do.
 710
 711 Dictionary selectors may get nested forall-types.  Thus:
 712
 713         class Foo a where
 714           op :: forall b. Ord b => a -> b -> b
 715
 716 Then the top-level type for op is
 717
 718         op :: forall a. Foo a =>
 719               forall b. Ord b =>
 720               a -> b -> b
 721
 722 This is unlike ordinary record selectors, which have all the for-alls
 723 at the outside.  When dealing with classes it's very convenient to
 724 recover the original type signature from the class op selector.
 725
 726 \begin{code}
 727 mkDictSelId :: Name -> Class -> Id
 728 mkDictSelId name clas
 729   = mkGlobalId (ClassOpId clas) name sel_ty info
 730   where
 731     sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
 732         -- We can't just say (exprType rhs), because that would give a type
 733         --      C a -> C a
 734         -- for a single-op class (after all, the selector is the identity)
 735         -- But it's type must expose the representation of the dictionary
 736         -- to gat (say)         C a -> (a -> a)
 737
 738     info = noCafIdInfo
 739                 `setArityInfo`          1
 740                 `setUnfoldingInfo`      mkTopUnfolding rhs
 741                 `setAllStrictnessInfo`  Just strict_sig
 742
 743         -- We no longer use 'must-inline' on record selectors.  They'll
 744         -- inline like crazy if they scrutinise a constructor
 745
 746         -- The strictness signature is of the form U(AAAVAAAA) -> T
 747         -- where the V depends on which item we are selecting
 748         -- It's worth giving one, so that absence info etc is generated
 749         -- even if the selector isn't inlined
 750     strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
 751     arg_dmd | isNewTyCon tycon = evalDmd
 752             | otherwise        = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
 753                                             | id <- arg_ids ])
 754
 755     tycon      = classTyCon clas
 756     [data_con] = tyConDataCons tycon
 757     tyvars     = dataConUnivTyVars data_con
 758     arg_tys    = ASSERT( isVanillaDataCon data_con ) dataConRepArgTys data_con
 759     the_arg_id = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` arg_ids) name
 760
 761     pred              = mkClassPred clas (mkTyVarTys tyvars)
 762     (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
 763
 764     rhs = mkLams tyvars (Lam dict_id rhs_body)
 765     rhs_body | isNewTyCon tycon = unwrapNewTypeBody tycon (map mkTyVarTy tyvars) (Var dict_id)
 766              | otherwise        = Case (Var dict_id) dict_id (idType the_arg_id)
 767                                        [(DataAlt data_con, arg_ids, Var the_arg_id)]
 768
 769 wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 770 -- The wrapper for the data constructor for a newtype looks like this:
 771 --      newtype T a = MkT (a,Int)
 772 --      MkT :: forall a. (a,Int) -> T a
 773 --      MkT = /\a. \(x:(a,Int)). x `cast` CoT a
 774 -- where CoT is the coercion TyCon assoicated with the newtype
 775 --
 776 -- The call (wrapNewTypeBody T [a] e) returns the
 777 -- body of the wrapper, namely
 778 --      e `cast` CoT [a]
 779 --
 780 -- If a coercion constructor is prodivided in the newtype, then we use
 781 -- it, otherwise the wrap/unwrap are both no-ops
 782 --
 783 wrapNewTypeBody tycon args result_expr
 784   | Just co_con <- newTyConCo tycon
 785   = Cast result_expr (mkTyConApp co_con args)
 786   | otherwise
 787   = result_expr
 788
 789 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 790 unwrapNewTypeBody tycon args result_expr
 791   | Just co_con <- newTyConCo tycon
 792   = Cast result_expr (mkSymCoercion (mkTyConApp co_con args))
 793   | otherwise
 794   = result_expr
 795
 796
 797 \end{code}
 798
 799
 800 %************************************************************************
 801 %*                                                                      *
 802 \subsection{Primitive operations
 803 %*                                                                      *
 804 %************************************************************************
 805
 806 \begin{code}
 807 mkPrimOpId :: PrimOp -> Id
 808 mkPrimOpId prim_op
 809   = id
 810   where
 811     (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
 812     ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
 813     name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
 814                          (mkPrimOpIdUnique (primOpTag prim_op))
 815                          Nothing (AnId id) UserSyntax
 816     id   = mkGlobalId (PrimOpId prim_op) name ty info
 817
 818     info = noCafIdInfo
 819            `setSpecInfo`          mkSpecInfo (primOpRules prim_op name)
 820            `setArityInfo`         arity
 821            `setAllStrictnessInfo` Just strict_sig
 822
 823 -- For each ccall we manufacture a separate CCallOpId, giving it
 824 -- a fresh unique, a type that is correct for this particular ccall,
 825 -- and a CCall structure that gives the correct details about calling
 826 -- convention etc.
 827 --
 828 -- The *name* of this Id is a local name whose OccName gives the full
 829 -- details of the ccall, type and all.  This means that the interface
 830 -- file reader can reconstruct a suitable Id
 831
 832 mkFCallId :: Unique -> ForeignCall -> Type -> Id
 833 mkFCallId uniq fcall ty
 834   = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
 835         -- A CCallOpId should have no free type variables;
 836         -- when doing substitutions won't substitute over it
 837     mkGlobalId (FCallId fcall) name ty info
 838   where
 839     occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
 840         -- The "occurrence name" of a ccall is the full info about the
 841         -- ccall; it is encoded, but may have embedded spaces etc!
 842
 843     name = mkFCallName uniq occ_str
 844
 845     info = noCafIdInfo
 846            `setArityInfo`               arity
 847            `setAllStrictnessInfo`       Just strict_sig
 848
 849     (_, tau)     = tcSplitForAllTys ty
 850     (arg_tys, _) = tcSplitFunTys tau
 851     arity        = length arg_tys
 852     strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
 853 \end{code}
 854
 855
 856 %************************************************************************
 857 %*                                                                      *
 858 \subsection{DictFuns and default methods}
 859 %*                                                                      *
 860 %************************************************************************
 861
 862 Important notes about dict funs and default methods
 863 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 864 Dict funs and default methods are *not* ImplicitIds.  Their definition
 865 involves user-written code, so we can't figure out their strictness etc
 866 based on fixed info, as we can for constructors and record selectors (say).
 867
 868 We build them as LocalIds, but with External Names.  This ensures that
 869 they are taken to account by free-variable finding and dependency
 870 analysis (e.g. CoreFVs.exprFreeVars).
 871
 872 Why shouldn't they be bound as GlobalIds?  Because, in particular, if
 873 they are globals, the specialiser floats dict uses above their defns,
 874 which prevents good simplifications happening.  Also the strictness
 875 analyser treats a occurrence of a GlobalId as imported and assumes it
 876 contains strictness in its IdInfo, which isn't true if the thing is
 877 bound in the same module as the occurrence.
 878
 879 It's OK for dfuns to be LocalIds, because we form the instance-env to
 880 pass on to the next module (md_insts) in CoreTidy, afer tidying
 881 and globalising the top-level Ids.
 882
 883 BUT make sure they are *exported* LocalIds (mkExportedLocalId) so
 884 that they aren't discarded by the occurrence analyser.
 885
 886 \begin{code}
 887 mkDefaultMethodId dm_name ty = mkExportedLocalId dm_name ty
 888
 889 mkDictFunId :: Name             -- Name to use for the dict fun;
 890             -> [TyVar]
 891             -> ThetaType
 892             -> Class
 893             -> [Type]
 894             -> Id
 895
 896 mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
 897   = mkExportedLocalId dfun_name dfun_ty
 898   where
 899     dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
 900
 901 {-  1 dec 99: disable the Mark Jones optimisation for the sake
 902     of compatibility with Hugs.
 903     See `types/InstEnv' for a discussion related to this.
 904
 905     (class_tyvars, sc_theta, _, _) = classBigSig clas
 906     not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
 907     sc_theta' = substClasses (zipTopTvSubst class_tyvars inst_tys) sc_theta
 908     dfun_theta = case inst_decl_theta of
 909                    []    -> []  -- If inst_decl_theta is empty, then we don't
 910                                 -- want to have any dict arguments, so that we can
 911                                 -- expose the constant methods.
 912
 913                    other -> nub (inst_decl_theta ++ filter not_const sc_theta')
 914                                 -- Otherwise we pass the superclass dictionaries to
 915                                 -- the dictionary function; the Mark Jones optimisation.
 916                                 --
 917                                 -- NOTE the "nub".  I got caught by this one:
 918                                 --   class Monad m => MonadT t m where ...
 919                                 --   instance Monad m => MonadT (EnvT env) m where ...
 920                                 -- Here, the inst_decl_theta has (Monad m); but so
 921                                 -- does the sc_theta'!
 922                                 --
 923                                 -- NOTE the "not_const".  I got caught by this one too:
 924                                 --   class Foo a => Baz a b where ...
 925                                 --   instance Wob b => Baz T b where..
 926                                 -- Now sc_theta' has Foo T
 927 -}
 928 \end{code}
 929
 930
 931 %************************************************************************
 932 %*                                                                      *
 933 \subsection{Un-definable}
 934 %*                                                                      *
 935 %************************************************************************
 936
 937 These Ids can't be defined in Haskell.  They could be defined in
 938 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
 939 ensure that they were definitely, definitely inlined, because there is
 940 no curried identifier for them.  That's what mkCompulsoryUnfolding
 941 does.  If we had a way to get a compulsory unfolding from an interface
 942 file, we could do that, but we don't right now.
 943
 944 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
 945 just gets expanded into a type coercion wherever it occurs.  Hence we
 946 add it as a built-in Id with an unfolding here.
 947
 948 The type variables we use here are "open" type variables: this means
 949 they can unify with both unlifted and lifted types.  Hence we provide
 950 another gun with which to shoot yourself in the foot.
 951
 952 \begin{code}
 953 mkWiredInIdName mod fs uniq id
 954  = mkWiredInName mod (mkOccNameFS varName fs) uniq Nothing (AnId id) UserSyntax
 955
 956 unsafeCoerceName = mkWiredInIdName gHC_PRIM FSLIT("unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
 957 nullAddrName     = mkWiredInIdName gHC_PRIM FSLIT("nullAddr#")     nullAddrIdKey      nullAddrId
 958 seqName          = mkWiredInIdName gHC_PRIM FSLIT("seq")           seqIdKey           seqId
 959 realWorldName    = mkWiredInIdName gHC_PRIM FSLIT("realWorld#")    realWorldPrimIdKey realWorldPrimId
 960 lazyIdName       = mkWiredInIdName gHC_BASE FSLIT("lazy")         lazyIdKey           lazyId
 961
 962 errorName                = mkWiredInIdName gHC_ERR FSLIT("error")            errorIdKey eRROR_ID
 963 recSelErrorName          = mkWiredInIdName gHC_ERR FSLIT("recSelError")     recSelErrorIdKey rEC_SEL_ERROR_ID
 964 runtimeErrorName         = mkWiredInIdName gHC_ERR FSLIT("runtimeError")    runtimeErrorIdKey rUNTIME_ERROR_ID
 965 irrefutPatErrorName      = mkWiredInIdName gHC_ERR FSLIT("irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
 966 recConErrorName          = mkWiredInIdName gHC_ERR FSLIT("recConError")     recConErrorIdKey rEC_CON_ERROR_ID
 967 patErrorName             = mkWiredInIdName gHC_ERR FSLIT("patError")         patErrorIdKey pAT_ERROR_ID
 968 noMethodBindingErrorName = mkWiredInIdName gHC_ERR FSLIT("noMethodBindingError")
 969                                            noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
 970 nonExhaustiveGuardsErrorName
 971   = mkWiredInIdName gHC_ERR FSLIT("nonExhaustiveGuardsError")
 972                     nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
 973 \end{code}
 974
 975 \begin{code}
 976 -- unsafeCoerce# :: forall a b. a -> b
 977 unsafeCoerceId
 978   = pcMiscPrelId unsafeCoerceName ty info
 979   where
 980     info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
 981
 982
 983     ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
 984                       (mkFunTy openAlphaTy openBetaTy)
 985     [x] = mkTemplateLocals [openAlphaTy]
 986     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
 987 --       Note (Coerce openBetaTy openAlphaTy) (Var x)
 988          Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
 989
 990 -- nullAddr# :: Addr#
 991 -- The reason is is here is because we don't provide
 992 -- a way to write this literal in Haskell.
 993 nullAddrId
 994   = pcMiscPrelId nullAddrName addrPrimTy info
 995   where
 996     info = noCafIdInfo `setUnfoldingInfo`
 997            mkCompulsoryUnfolding (Lit nullAddrLit)
 998
 999 seqId
1000   = pcMiscPrelId seqName ty info
1001   where
1002     info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1003
1004
1005     ty  = mkForAllTys [alphaTyVar,openBetaTyVar]
1006                       (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
1007     [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
1008     rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)])
1009
1010 -- lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)
1011 -- Used to lazify pseq:         pseq a b = a `seq` lazy b
1012 --
1013 -- Also, no strictness: by being a built-in Id, all the info about lazyId comes from here,
1014 -- not from GHC.Base.hi.   This is important, because the strictness
1015 -- analyser will spot it as strict!
1016 --
1017 -- Also no unfolding in lazyId: it gets "inlined" by a HACK in the worker/wrapper pass
1018 --      (see WorkWrap.wwExpr)
1019 -- We could use inline phases to do this, but that would be vulnerable to changes in
1020 -- phase numbering....we must inline precisely after strictness analysis.
1021 lazyId
1022   = pcMiscPrelId lazyIdName ty info
1023   where
1024     info = noCafIdInfo
1025     ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
1026
1027 lazyIdUnfolding :: CoreExpr     -- Used to expand 'lazyId' after strictness anal
1028 lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
1029                 where
1030                   [x] = mkTemplateLocals [openAlphaTy]
1031 \end{code}
1032
1033 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
1034 nasty as-is, change it back to a literal (@Literal@).
1035
1036 voidArgId is a Local Id used simply as an argument in functions
1037 where we just want an arg to avoid having a thunk of unlifted type.
1038 E.g.
1039         x = \ void :: State# RealWorld -> (# p, q #)
1040
1041 This comes up in strictness analysis
1042
1043 \begin{code}
1044 realWorldPrimId -- :: State# RealWorld
1045   = pcMiscPrelId realWorldName realWorldStatePrimTy
1046                  (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
1047         -- The evaldUnfolding makes it look that realWorld# is evaluated
1048         -- which in turn makes Simplify.interestingArg return True,
1049         -- which in turn makes INLINE things applied to realWorld# likely
1050         -- to be inlined
1051
1052 voidArgId       -- :: State# RealWorld
1053   = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
1054 \end{code}
1055
1056
1057 %************************************************************************
1058 %*                                                                      *
1059 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
1060 %*                                                                      *
1061 %************************************************************************
1062
1063 GHC randomly injects these into the code.
1064
1065 @patError@ is just a version of @error@ for pattern-matching
1066 failures.  It knows various ``codes'' which expand to longer
1067 strings---this saves space!
1068
1069 @absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
1070 well shouldn't be yanked on, but if one is, then you will get a
1071 friendly message from @absentErr@ (rather than a totally random
1072 crash).
1073
1074 @parError@ is a special version of @error@ which the compiler does
1075 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
1076 templates, but we don't ever expect to generate code for it.
1077
1078 \begin{code}
1079 mkRuntimeErrorApp
1080         :: Id           -- Should be of type (forall a. Addr# -> a)
1081                         --      where Addr# points to a UTF8 encoded string
1082         -> Type         -- The type to instantiate 'a'
1083         -> String       -- The string to print
1084         -> CoreExpr
1085
1086 mkRuntimeErrorApp err_id res_ty err_msg
1087   = mkApps (Var err_id) [Type res_ty, err_string]
1088   where
1089     err_string = Lit (mkStringLit err_msg)
1090
1091 rEC_SEL_ERROR_ID                = mkRuntimeErrorId recSelErrorName
1092 rUNTIME_ERROR_ID                = mkRuntimeErrorId runtimeErrorName
1093 iRREFUT_PAT_ERROR_ID            = mkRuntimeErrorId irrefutPatErrorName
1094 rEC_CON_ERROR_ID                = mkRuntimeErrorId recConErrorName
1095 pAT_ERROR_ID                    = mkRuntimeErrorId patErrorName
1096 nO_METHOD_BINDING_ERROR_ID      = mkRuntimeErrorId noMethodBindingErrorName
1097 nON_EXHAUSTIVE_GUARDS_ERROR_ID  = mkRuntimeErrorId nonExhaustiveGuardsErrorName
1098
1099 -- The runtime error Ids take a UTF8-encoded string as argument
1100 mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
1101 runtimeErrorTy        = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
1102 \end{code}
1103
1104 \begin{code}
1105 eRROR_ID = pc_bottoming_Id errorName errorTy
1106
1107 errorTy  :: Type
1108 errorTy  = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
1109     -- Notice the openAlphaTyVar.  It says that "error" can be applied
1110     -- to unboxed as well as boxed types.  This is OK because it never
1111     -- returns, so the return type is irrelevant.
1112 \end{code}
1113
1114
1115 %************************************************************************
1116 %*                                                                      *
1117 \subsection{Utilities}
1118 %*                                                                      *
1119 %************************************************************************
1120
1121 \begin{code}
1122 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
1123 pcMiscPrelId name ty info
1124   = mkVanillaGlobal name ty info
1125     -- We lie and say the thing is imported; otherwise, we get into
1126     -- a mess with dependency analysis; e.g., core2stg may heave in
1127     -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
1128     -- being compiled, then it's just a matter of luck if the definition
1129     -- will be in "the right place" to be in scope.
1130
1131 pc_bottoming_Id name ty
1132  = pcMiscPrelId name ty bottoming_info
1133  where
1134     bottoming_info = vanillaIdInfo `setAllStrictnessInfo` Just strict_sig
1135         -- Do *not* mark them as NoCafRefs, because they can indeed have
1136         -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,
1137         -- which has some CAFs
1138         -- In due course we may arrange that these error-y things are
1139         -- regarded by the GC as permanently live, in which case we
1140         -- can give them NoCaf info.  As it is, any function that calls
1141         -- any pc_bottoming_Id will itself have CafRefs, which bloats
1142         -- SRTs.
1143
1144     strict_sig     = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
1145         -- These "bottom" out, no matter what their arguments
1146
1147 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
1148 openAlphaTy  = mkTyVarTy openAlphaTyVar
1149 openBetaTy   = mkTyVarTy openBetaTyVar
1150 \end{code}
1151