ghc/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         mkSpecPragmaId, mkWorkerId,
  17
  18         mkDictFunId, mkDefaultMethodId,
  19         mkDictSelId,
  20
  21         mkDataConId,
  22         mkRecordSelId,
  23         mkNewTySelId,
  24         mkPrimitiveId,
  25
  26         -- And some particular Ids; see below for why they are wired in
  27         wiredInIds,
  28         unsafeCoerceId, realWorldPrimId,
  29         eRROR_ID, rEC_SEL_ERROR_ID, pAT_ERROR_ID, rEC_CON_ERROR_ID,
  30         rEC_UPD_ERROR_ID, iRREFUT_PAT_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID,
  31         nO_METHOD_BINDING_ERROR_ID, aBSENT_ERROR_ID, pAR_ERROR_ID
  32     ) where
  33
  34 #include "HsVersions.h"
  35
  36
  37 import TysPrim          ( openAlphaTyVars, alphaTyVar, alphaTy,
  38                           intPrimTy, realWorldStatePrimTy
  39                         )
  40 import TysWiredIn       ( boolTy, charTy, mkListTy )
  41 import PrelMods         ( pREL_ERR, pREL_GHC )
  42 import Type             ( Type, ThetaType,
  43                           mkDictTy, mkTyConApp, mkTyVarTys, mkFunTys, mkFunTy, mkSigmaTy,
  44                           isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfTypes,
  45                           splitSigmaTy, splitFunTy_maybe, splitAlgTyConApp,
  46                           splitFunTys, splitForAllTys, unUsgTy,
  47                           mkUsgTy, UsageAnn(..)
  48                         )
  49 import Module           ( Module )
  50 import CoreUnfold       ( mkTopUnfolding, mkCompulsoryUnfolding )
  51 import Subst            ( mkTopTyVarSubst, substTheta )
  52 import TyCon            ( TyCon, isNewTyCon, tyConDataCons, isDataTyCon )
  53 import Class            ( Class, classBigSig, classTyCon )
  54 import Var              ( Id, TyVar )
  55 import VarSet           ( isEmptyVarSet )
  56 import Const            ( Con(..) )
  57 import Name             ( mkDerivedName, mkWiredInIdName, mkLocalName,
  58                           mkWorkerOcc, mkSuperDictSelOcc,
  59                           Name, NamedThing(..),
  60                         )
  61 import OccName          ( mkSrcVarOcc )
  62 import PrimOp           ( PrimOp(DataToTagOp), primOpSig, mkPrimOpIdName )
  63 import Demand           ( wwStrict )
  64 import DataCon          ( DataCon, StrictnessMark(..), dataConStrictMarks, dataConFieldLabels,
  65                           dataConArgTys, dataConSig, dataConRawArgTys
  66                         )
  67 import Id               ( idType, mkId,
  68                           mkVanillaId, mkTemplateLocals,
  69                           mkTemplateLocal, setInlinePragma
  70                         )
  71 import IdInfo           ( vanillaIdInfo, mkIdInfo,
  72                           exactArity, setUnfoldingInfo, setCafInfo,
  73                           setArityInfo, setInlinePragInfo,
  74                           mkStrictnessInfo, setStrictnessInfo,
  75                           IdFlavour(..), InlinePragInfo(..), CafInfo(..), IdInfo
  76                         )
  77 import FieldLabel       ( FieldLabel, FieldLabelTag, mkFieldLabel, fieldLabelName,
  78                           firstFieldLabelTag, allFieldLabelTags
  79                         )
  80 import CoreSyn
  81 import Maybes
  82 import BasicTypes       ( Arity )
  83 import Unique
  84 import Maybe            ( isJust )
  85 import Outputable
  86 import Util             ( assoc )
  87 import List             ( nub )
  88 \end{code}
  89
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection{Wired in Ids}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 \begin{code}
  98 wiredInIds
  99   = [   -- These error-y things are wired in because we don't yet have
 100         -- a way to express in an interface file that the result type variable
 101         -- is 'open'; that is can be unified with an unboxed type
 102         --
 103         -- [The interface file format now carry such information, but there's
 104         --  no way yet of expressing at the definition site for these error-reporting
 105         --  functions that they have an 'open' result type. -- sof 1/99]
 106
 107       aBSENT_ERROR_ID
 108     , eRROR_ID
 109     , iRREFUT_PAT_ERROR_ID
 110     , nON_EXHAUSTIVE_GUARDS_ERROR_ID
 111     , nO_METHOD_BINDING_ERROR_ID
 112     , pAR_ERROR_ID
 113     , pAT_ERROR_ID
 114     , rEC_CON_ERROR_ID
 115     , rEC_UPD_ERROR_ID
 116
 117         -- These two can't be defined in Haskell
 118     , realWorldPrimId
 119     , unsafeCoerceId
 120     , getTagId
 121     ]
 122 \end{code}
 123
 124 %************************************************************************
 125 %*                                                                      *
 126 \subsection{Easy ones}
 127 %*                                                                      *
 128 %************************************************************************
 129
 130 \begin{code}
 131 mkSpecPragmaId occ uniq ty loc
 132   = mkId (mkLocalName uniq occ loc) ty (mkIdInfo SpecPragmaId)
 133         -- Maybe a SysLocal?  But then we'd lose the location
 134
 135 mkDefaultMethodId dm_name rec_c ty
 136   = mkVanillaId dm_name ty
 137
 138 mkWorkerId uniq unwrkr ty
 139   = mkVanillaId (mkDerivedName mkWorkerOcc (getName unwrkr) uniq) ty
 140 \end{code}
 141
 142 %************************************************************************
 143 %*                                                                      *
 144 \subsection{Data constructors}
 145 %*                                                                      *
 146 %************************************************************************
 147
 148 \begin{code}
 149 mkDataConId :: DataCon -> Id
 150 mkDataConId data_con
 151   = mkId (getName data_con)
 152          id_ty
 153          (dataConInfo data_con)
 154   where
 155     (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon) = dataConSig data_con
 156     id_ty = mkSigmaTy (tyvars ++ ex_tyvars)
 157                       (theta ++ ex_theta)
 158                       (mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
 159 \end{code}
 160
 161 We're going to build a constructor that looks like:
 162
 163         data (Data a, C b) =>  T a b = T1 !a !Int b
 164
 165         T1 = /\ a b ->
 166              \d1::Data a, d2::C b ->
 167              \p q r -> case p of { p ->
 168                        case q of { q ->
 169                        Con T1 [a,b] [p,q,r]}}
 170
 171 Notice that
 172
 173 * d2 is thrown away --- a context in a data decl is used to make sure
 174   one *could* construct dictionaries at the site the constructor
 175   is used, but the dictionary isn't actually used.
 176
 177 * We have to check that we can construct Data dictionaries for
 178   the types a and Int.  Once we've done that we can throw d1 away too.
 179
 180 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
 181   all that matters is that the arguments are evaluated.  "seq" is
 182   very careful to preserve evaluation order, which we don't need
 183   to be here.
 184
 185   You might think that we could simply give constructors some strictness
 186   info, like PrimOps, and let CoreToStg do the let-to-case transformation.
 187   But we don't do that because in the case of primops and functions strictness
 188   is a *property* not a *requirement*.  In the case of constructors we need to
 189   do something active to evaluate the argument.
 190
 191   Making an explicit case expression allows the simplifier to eliminate
 192   it in the (common) case where the constructor arg is already evaluated.
 193
 194 \begin{code}
 195 dataConInfo :: DataCon -> IdInfo
 196
 197 dataConInfo data_con
 198   = mkIdInfo (ConstantId (DataCon data_con))
 199     `setArityInfo` exactArity (n_dicts + n_ex_dicts + n_id_args)
 200     `setUnfoldingInfo` unfolding
 201   where
 202         unfolding = mkTopUnfolding (Note InlineMe con_rhs)
 203         -- The dictionary constructors of a class don't get a binding,
 204         -- but they are always saturated, so they should always be inlined.
 205
 206         (tyvars, theta, ex_tyvars, ex_theta, orig_arg_tys, tycon)
 207            = dataConSig data_con
 208         rep_arg_tys = dataConRawArgTys data_con
 209         all_tyvars   = tyvars ++ ex_tyvars
 210
 211         dict_tys     = [mkDictTy clas tys | (clas,tys) <- theta]
 212         ex_dict_tys  = [mkDictTy clas tys | (clas,tys) <- ex_theta]
 213
 214         n_dicts      = length dict_tys
 215         n_ex_dicts   = length ex_dict_tys
 216         n_id_args    = length orig_arg_tys
 217         n_rep_args   = length rep_arg_tys
 218
 219         result_ty    = mkTyConApp tycon (mkTyVarTys tyvars)
 220
 221         mkLocals i n tys   = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
 222         (dict_args, i1)    = mkLocals 1  n_dicts    dict_tys
 223         (ex_dict_args,i2)  = mkLocals i1 n_ex_dicts ex_dict_tys
 224         (id_args,i3)       = mkLocals i2 n_id_args  orig_arg_tys
 225
 226         (id_arg1:_) = id_args           -- Used for newtype only
 227         strict_marks  = dataConStrictMarks data_con
 228
 229         con_app i rep_ids
 230                 | isNewTyCon tycon
 231                 = ASSERT( length orig_arg_tys == 1 )
 232                   Note (Coerce result_ty (head orig_arg_tys)) (Var id_arg1)
 233                 | otherwise
 234                 = mkConApp data_con
 235                         (map Type (mkTyVarTys all_tyvars) ++
 236                          map Var (reverse rep_ids))
 237
 238         con_rhs = mkLams all_tyvars $ mkLams dict_args $
 239                   mkLams ex_dict_args $ mkLams id_args $
 240                   foldr mk_case con_app
 241                      (zip (ex_dict_args++id_args) strict_marks) i3 []
 242
 243         mk_case
 244            :: (Id, StrictnessMark)      -- arg, strictness
 245            -> (Int -> [Id] -> CoreExpr) -- body
 246            -> Int                       -- next rep arg id
 247            -> [Id]                      -- rep args so far
 248            -> CoreExpr
 249         mk_case (arg,strict) body i rep_args
 250           = case strict of
 251                 NotMarkedStrict -> body i (arg:rep_args)
 252                 MarkedStrict
 253                    | isUnLiftedType (idType arg) -> body i (arg:rep_args)
 254                    | otherwise ->
 255                         Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
 256
 257                 MarkedUnboxed con tys ->
 258                    Case (Var arg) arg [(DataCon con, con_args,
 259                                         body i' (reverse con_args++rep_args))]
 260                    where n_tys = length tys
 261                          (con_args,i') = mkLocals i (length tys) tys
 262 \end{code}
 263
 264
 265 %************************************************************************
 266 %*                                                                      *
 267 \subsection{Record selectors}
 268 %*                                                                      *
 269 %************************************************************************
 270
 271 We're going to build a record selector unfolding that looks like this:
 272
 273         data T a b c = T1 { ..., op :: a, ...}
 274                      | T2 { ..., op :: a, ...}
 275                      | T3
 276
 277         sel = /\ a b c -> \ d -> case d of
 278                                     T1 ... x ... -> x
 279                                     T2 ... x ... -> x
 280                                     other        -> error "..."
 281
 282 \begin{code}
 283 mkRecordSelId field_label selector_ty
 284   = ASSERT( null theta && isDataTyCon tycon )
 285     sel_id
 286   where
 287     sel_id = mkId (fieldLabelName field_label) selector_ty info
 288
 289     info = mkIdInfo (RecordSelId field_label)
 290            `setArityInfo`       exactArity 1
 291            `setUnfoldingInfo`   unfolding
 292
 293         -- ToDo: consider adding further IdInfo
 294
 295     unfolding = mkTopUnfolding sel_rhs
 296
 297     (tyvars, theta, tau)  = splitSigmaTy selector_ty
 298     (data_ty,rhs_ty)      = expectJust "StdIdInfoRec" (splitFunTy_maybe tau)
 299                                         -- tau is of form (T a b c -> field-type)
 300     (tycon, _, data_cons) = splitAlgTyConApp data_ty
 301     tyvar_tys             = mkTyVarTys tyvars
 302
 303     [data_id] = mkTemplateLocals [data_ty]
 304     alts      = map mk_maybe_alt data_cons
 305     the_alts  = catMaybes alts
 306     default_alt | all isJust alts = []  -- No default needed
 307                 | otherwise       = [(DEFAULT, [], error_expr)]
 308
 309     sel_rhs   = mkLams tyvars $ Lam data_id $
 310                 Case (Var data_id) data_id (the_alts ++ default_alt)
 311
 312     mk_maybe_alt data_con
 313           = case maybe_the_arg_id of
 314                 Nothing         -> Nothing
 315                 Just the_arg_id -> Just (DataCon data_con, arg_ids, Var the_arg_id)
 316           where
 317             arg_ids          = mkTemplateLocals (dataConArgTys data_con tyvar_tys)
 318                                     -- The first one will shadow data_id, but who cares
 319             field_lbls       = dataConFieldLabels data_con
 320             maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
 321
 322     error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type (unUsgTy rhs_ty), mkStringLit full_msg]
 323        -- preserves invariant that type args are *not* usage-annotated on top.  KSW 1999-04.
 324     full_msg   = showSDoc (sep [text "No match in record selector", ppr sel_id])
 325 \end{code}
 326
 327
 328 %************************************************************************
 329 %*                                                                      *
 330 \subsection{Newtype field selectors}
 331 %*                                                                      *
 332 %************************************************************************
 333
 334 Possibly overkill to do it this way:
 335
 336 \begin{code}
 337 mkNewTySelId field_label selector_ty = sel_id
 338   where
 339     sel_id = mkId (fieldLabelName field_label) selector_ty info
 340
 341
 342     info = mkIdInfo (RecordSelId field_label)
 343            `setArityInfo`       exactArity 1
 344            `setUnfoldingInfo`   unfolding
 345
 346         -- ToDo: consider adding further IdInfo
 347
 348     unfolding = mkTopUnfolding sel_rhs
 349
 350     (tyvars, theta, tau)  = splitSigmaTy selector_ty
 351     (data_ty,rhs_ty)      = expectJust "StdIdInfoRec" (splitFunTy_maybe tau)
 352                                         -- tau is of form (T a b c -> field-type)
 353     (tycon, _, data_cons) = splitAlgTyConApp data_ty
 354     tyvar_tys             = mkTyVarTys tyvars
 355
 356     [data_id] = mkTemplateLocals [data_ty]
 357     sel_rhs   = mkLams tyvars $ Lam data_id $
 358                 Note (Coerce (unUsgTy rhs_ty) (unUsgTy data_ty)) (Var data_id)
 359 \end{code}
 360
 361
 362 %************************************************************************
 363 %*                                                                      *
 364 \subsection{Dictionary selectors}
 365 %*                                                                      *
 366 %************************************************************************
 367
 368 Selecting a field for a dictionary.  If there is just one field, then
 369 there's nothing to do.
 370
 371 \begin{code}
 372 mkDictSelId name clas ty
 373   = sel_id
 374   where
 375     sel_id    = mkId name ty info
 376     field_lbl = mkFieldLabel name ty tag
 377     tag       = assoc "MkId.mkDictSelId" ((sc_sel_ids ++ op_sel_ids) `zip` allFieldLabelTags) sel_id
 378
 379     info      = mkIdInfo (RecordSelId field_lbl)
 380                 `setUnfoldingInfo`  unfolding
 381
 382         -- We no longer use 'must-inline' on record selectors.  They'll
 383         -- inline like crazy if they scrutinise a constructor
 384
 385     unfolding = mkTopUnfolding rhs
 386
 387     (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
 388
 389     tycon      = classTyCon clas
 390     [data_con] = tyConDataCons tycon
 391     tyvar_tys  = mkTyVarTys tyvars
 392     arg_tys    = dataConArgTys data_con tyvar_tys
 393     the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
 394
 395     dict_ty    = mkDictTy clas tyvar_tys
 396     (dict_id:arg_ids) = mkTemplateLocals (dict_ty : arg_tys)
 397
 398     rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
 399                              Note (Coerce (head arg_tys) dict_ty) (Var dict_id)
 400         | otherwise        = mkLams tyvars $ Lam dict_id $
 401                              Case (Var dict_id) dict_id
 402                                   [(DataCon data_con, arg_ids, Var the_arg_id)]
 403 \end{code}
 404
 405
 406 %************************************************************************
 407 %*                                                                      *
 408 \subsection{Primitive operations
 409 %*                                                                      *
 410 %************************************************************************
 411
 412 \begin{code}
 413 mkPrimitiveId :: PrimOp -> Id
 414 mkPrimitiveId prim_op
 415   = id
 416   where
 417     (tyvars,arg_tys,res_ty) = primOpSig prim_op
 418     ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
 419     name = mkPrimOpIdName prim_op id
 420     id   = mkId name ty info
 421
 422     info = mkIdInfo (ConstantId (PrimOp prim_op))
 423            `setUnfoldingInfo`   unfolding
 424
 425     unfolding = mkCompulsoryUnfolding rhs
 426                 -- The mkCompulsoryUnfolding says that this Id absolutely
 427                 -- must be inlined.  It's only used for primitives,
 428                 -- because we don't want to make a closure for each of them.
 429
 430     args = mkTemplateLocals arg_tys
 431     rhs =  mkLams tyvars $ mkLams args $
 432            mkPrimApp prim_op (map Type (mkTyVarTys tyvars) ++ map Var args)
 433 \end{code}
 434
 435
 436 %************************************************************************
 437 %*                                                                      *
 438 \subsection{DictFuns}
 439 %*                                                                      *
 440 %************************************************************************
 441
 442 \begin{code}
 443 mkDictFunId :: Name             -- Name to use for the dict fun;
 444             -> Class
 445             -> [TyVar]
 446             -> [Type]
 447             -> ThetaType
 448             -> Id
 449
 450 mkDictFunId dfun_name clas inst_tyvars inst_tys inst_decl_theta
 451   = mkVanillaId dfun_name dfun_ty
 452   where
 453     (class_tyvars, sc_theta, _, _, _) = classBigSig clas
 454     sc_theta' = substTheta (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
 455
 456     dfun_theta = case inst_decl_theta of
 457                    []    -> []  -- If inst_decl_theta is empty, then we don't
 458                                 -- want to have any dict arguments, so that we can
 459                                 -- expose the constant methods.
 460
 461                    other -> nub (inst_decl_theta ++ filter not_const sc_theta')
 462                                 -- Otherwise we pass the superclass dictionaries to
 463                                 -- the dictionary function; the Mark Jones optimisation.
 464                                 --
 465                                 -- NOTE the "nub".  I got caught by this one:
 466                                 --   class Monad m => MonadT t m where ...
 467                                 --   instance Monad m => MonadT (EnvT env) m where ...
 468                                 -- Here, the inst_decl_theta has (Monad m); but so
 469                                 -- does the sc_theta'!
 470                                 --
 471                                 -- NOTE the "not_const".  I got caught by this one too:
 472                                 --   class Foo a => Baz a b where ...
 473                                 --   instance Wob b => Baz T b where..
 474                                 -- Now sc_theta' has Foo T
 475
 476     dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
 477
 478     not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
 479 \end{code}
 480
 481
 482 %************************************************************************
 483 %*                                                                      *
 484 \subsection{Un-definable}
 485 %*                                                                      *
 486 %************************************************************************
 487
 488 These two can't be defined in Haskell.
 489
 490 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
 491 just gets expanded into a type coercion wherever it occurs.  Hence we
 492 add it as a built-in Id with an unfolding here.
 493
 494 The type variables we use here are "open" type variables: this means
 495 they can unify with both unlifted and lifted types.  Hence we provide
 496 another gun with which to shoot yourself in the foot.
 497
 498 \begin{code}
 499 unsafeCoerceId
 500   = pcMiscPrelId unsafeCoerceIdKey pREL_GHC SLIT("unsafeCoerce#") ty info
 501   where
 502     info = vanillaIdInfo
 503            `setUnfoldingInfo` mkCompulsoryUnfolding rhs
 504
 505
 506     ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
 507                       (mkFunTy openAlphaTy openBetaTy)
 508     [x] = mkTemplateLocals [openAlphaTy]
 509     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
 510           Note (Coerce openBetaTy openAlphaTy) (Var x)
 511 \end{code}
 512
 513
 514 @getTag#@ is another function which can't be defined in Haskell.  It needs to
 515 evaluate its argument and call the dataToTag# primitive.
 516
 517 \begin{code}
 518 getTagId
 519   = pcMiscPrelId getTagIdKey pREL_GHC SLIT("getTag#") ty info
 520   where
 521     info = vanillaIdInfo
 522            `setUnfoldingInfo`   mkCompulsoryUnfolding rhs
 523         -- We don't provide a defn for this; you must inline it
 524
 525     ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
 526     [x,y] = mkTemplateLocals [alphaTy,alphaTy]
 527     rhs = mkLams [alphaTyVar,x] $
 528           Case (Var x) y [ (DEFAULT, [],
 529                    Con (PrimOp DataToTagOp) [Type alphaTy, Var y]) ]
 530 \end{code}
 531
 532 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
 533 nasty as-is, change it back to a literal (@Literal@).
 534
 535 \begin{code}
 536 realWorldPrimId -- :: State# RealWorld
 537   = pcMiscPrelId realWorldPrimIdKey pREL_GHC SLIT("realWorld#")
 538                  realWorldStatePrimTy
 539                  noCafIdInfo
 540 \end{code}
 541
 542
 543 %************************************************************************
 544 %*                                                                      *
 545 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
 546 %*                                                                      *
 547 %************************************************************************
 548
 549 GHC randomly injects these into the code.
 550
 551 @patError@ is just a version of @error@ for pattern-matching
 552 failures.  It knows various ``codes'' which expand to longer
 553 strings---this saves space!
 554
 555 @absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
 556 well shouldn't be yanked on, but if one is, then you will get a
 557 friendly message from @absentErr@ (rather than a totally random
 558 crash).
 559
 560 @parError@ is a special version of @error@ which the compiler does
 561 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
 562 templates, but we don't ever expect to generate code for it.
 563
 564 \begin{code}
 565 eRROR_ID
 566   = pc_bottoming_Id errorIdKey pREL_ERR SLIT("error") errorTy
 567 rEC_SEL_ERROR_ID
 568   = generic_ERROR_ID recSelErrIdKey SLIT("patError")
 569 pAT_ERROR_ID
 570   = generic_ERROR_ID patErrorIdKey SLIT("patError")
 571 rEC_CON_ERROR_ID
 572   = generic_ERROR_ID recConErrorIdKey SLIT("recConError")
 573 rEC_UPD_ERROR_ID
 574   = generic_ERROR_ID recUpdErrorIdKey SLIT("recUpdError")
 575 iRREFUT_PAT_ERROR_ID
 576   = generic_ERROR_ID irrefutPatErrorIdKey SLIT("irrefutPatError")
 577 nON_EXHAUSTIVE_GUARDS_ERROR_ID
 578   = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey SLIT("nonExhaustiveGuardsError")
 579 nO_METHOD_BINDING_ERROR_ID
 580   = generic_ERROR_ID noMethodBindingErrorIdKey SLIT("noMethodBindingError")
 581
 582 aBSENT_ERROR_ID
 583   = pc_bottoming_Id absentErrorIdKey pREL_ERR SLIT("absentErr")
 584         (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
 585
 586 pAR_ERROR_ID
 587   = pcMiscPrelId parErrorIdKey pREL_ERR SLIT("parError")
 588     (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noCafIdInfo
 589
 590 \end{code}
 591
 592
 593 %************************************************************************
 594 %*                                                                      *
 595 \subsection{Utilities}
 596 %*                                                                      *
 597 %************************************************************************
 598
 599 \begin{code}
 600 pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
 601 pcMiscPrelId key mod str ty info
 602   = let
 603         name = mkWiredInIdName key mod (mkSrcVarOcc str) imp
 604         imp  = mkId name ty info -- the usual case...
 605     in
 606     imp
 607     -- We lie and say the thing is imported; otherwise, we get into
 608     -- a mess with dependency analysis; e.g., core2stg may heave in
 609     -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
 610     -- being compiled, then it's just a matter of luck if the definition
 611     -- will be in "the right place" to be in scope.
 612
 613 pc_bottoming_Id key mod name ty
 614  = pcMiscPrelId key mod name ty bottoming_info
 615  where
 616     bottoming_info = noCafIdInfo
 617                      `setStrictnessInfo` mkStrictnessInfo ([wwStrict], True)
 618
 619         -- these "bottom" out, no matter what their arguments
 620
 621 generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy
 622
 623 -- Very useful...
 624 noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs
 625
 626 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
 627 openAlphaTy  = mkTyVarTy openAlphaTyVar
 628 openBetaTy   = mkTyVarTy openBetaTyVar
 629
 630 errorTy  :: Type
 631 errorTy  = mkUsgTy UsMany $
 632            mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkUsgTy UsOnce (mkListTy charTy)]
 633                                                    (mkUsgTy UsMany openAlphaTy))
 634     -- Notice the openAlphaTyVar.  It says that "error" can be applied
 635     -- to unboxed as well as boxed types.  This is OK because it never
 636     -- returns, so the return type is irrelevant.
 637 \end{code}
 638