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, classTyVars, classSelIds )
  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" (classSelIds clas `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  = classTyVars 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 = inst_decl_theta
 457
 458 {-  1 dec 99: disable the Mark Jones optimisation for the sake
 459     of compatibility with Hugs.
 460
 461     dfun_theta = case inst_decl_theta of
 462                    []    -> []  -- If inst_decl_theta is empty, then we don't
 463                                 -- want to have any dict arguments, so that we can
 464                                 -- expose the constant methods.
 465
 466                    other -> nub (inst_decl_theta ++ filter not_const sc_theta')
 467                                 -- Otherwise we pass the superclass dictionaries to
 468                                 -- the dictionary function; the Mark Jones optimisation.
 469                                 --
 470                                 -- NOTE the "nub".  I got caught by this one:
 471                                 --   class Monad m => MonadT t m where ...
 472                                 --   instance Monad m => MonadT (EnvT env) m where ...
 473                                 -- Here, the inst_decl_theta has (Monad m); but so
 474                                 -- does the sc_theta'!
 475                                 --
 476                                 -- NOTE the "not_const".  I got caught by this one too:
 477                                 --   class Foo a => Baz a b where ...
 478                                 --   instance Wob b => Baz T b where..
 479                                 -- Now sc_theta' has Foo T
 480 -}
 481     dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
 482
 483     not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
 484 \end{code}
 485
 486
 487 %************************************************************************
 488 %*                                                                      *
 489 \subsection{Un-definable}
 490 %*                                                                      *
 491 %************************************************************************
 492
 493 These two can't be defined in Haskell.
 494
 495 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
 496 just gets expanded into a type coercion wherever it occurs.  Hence we
 497 add it as a built-in Id with an unfolding here.
 498
 499 The type variables we use here are "open" type variables: this means
 500 they can unify with both unlifted and lifted types.  Hence we provide
 501 another gun with which to shoot yourself in the foot.
 502
 503 \begin{code}
 504 unsafeCoerceId
 505   = pcMiscPrelId unsafeCoerceIdKey pREL_GHC SLIT("unsafeCoerce#") ty info
 506   where
 507     info = vanillaIdInfo
 508            `setUnfoldingInfo` mkCompulsoryUnfolding rhs
 509
 510
 511     ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
 512                       (mkFunTy openAlphaTy openBetaTy)
 513     [x] = mkTemplateLocals [openAlphaTy]
 514     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
 515           Note (Coerce openBetaTy openAlphaTy) (Var x)
 516 \end{code}
 517
 518
 519 @getTag#@ is another function which can't be defined in Haskell.  It needs to
 520 evaluate its argument and call the dataToTag# primitive.
 521
 522 \begin{code}
 523 getTagId
 524   = pcMiscPrelId getTagIdKey pREL_GHC SLIT("getTag#") ty info
 525   where
 526     info = vanillaIdInfo
 527            `setUnfoldingInfo`   mkCompulsoryUnfolding rhs
 528         -- We don't provide a defn for this; you must inline it
 529
 530     ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
 531     [x,y] = mkTemplateLocals [alphaTy,alphaTy]
 532     rhs = mkLams [alphaTyVar,x] $
 533           Case (Var x) y [ (DEFAULT, [],
 534                    Con (PrimOp DataToTagOp) [Type alphaTy, Var y]) ]
 535 \end{code}
 536
 537 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
 538 nasty as-is, change it back to a literal (@Literal@).
 539
 540 \begin{code}
 541 realWorldPrimId -- :: State# RealWorld
 542   = pcMiscPrelId realWorldPrimIdKey pREL_GHC SLIT("realWorld#")
 543                  realWorldStatePrimTy
 544                  noCafIdInfo
 545 \end{code}
 546
 547
 548 %************************************************************************
 549 %*                                                                      *
 550 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
 551 %*                                                                      *
 552 %************************************************************************
 553
 554 GHC randomly injects these into the code.
 555
 556 @patError@ is just a version of @error@ for pattern-matching
 557 failures.  It knows various ``codes'' which expand to longer
 558 strings---this saves space!
 559
 560 @absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
 561 well shouldn't be yanked on, but if one is, then you will get a
 562 friendly message from @absentErr@ (rather than a totally random
 563 crash).
 564
 565 @parError@ is a special version of @error@ which the compiler does
 566 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
 567 templates, but we don't ever expect to generate code for it.
 568
 569 \begin{code}
 570 eRROR_ID
 571   = pc_bottoming_Id errorIdKey pREL_ERR SLIT("error") errorTy
 572 rEC_SEL_ERROR_ID
 573   = generic_ERROR_ID recSelErrIdKey SLIT("patError")
 574 pAT_ERROR_ID
 575   = generic_ERROR_ID patErrorIdKey SLIT("patError")
 576 rEC_CON_ERROR_ID
 577   = generic_ERROR_ID recConErrorIdKey SLIT("recConError")
 578 rEC_UPD_ERROR_ID
 579   = generic_ERROR_ID recUpdErrorIdKey SLIT("recUpdError")
 580 iRREFUT_PAT_ERROR_ID
 581   = generic_ERROR_ID irrefutPatErrorIdKey SLIT("irrefutPatError")
 582 nON_EXHAUSTIVE_GUARDS_ERROR_ID
 583   = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey SLIT("nonExhaustiveGuardsError")
 584 nO_METHOD_BINDING_ERROR_ID
 585   = generic_ERROR_ID noMethodBindingErrorIdKey SLIT("noMethodBindingError")
 586
 587 aBSENT_ERROR_ID
 588   = pc_bottoming_Id absentErrorIdKey pREL_ERR SLIT("absentErr")
 589         (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
 590
 591 pAR_ERROR_ID
 592   = pcMiscPrelId parErrorIdKey pREL_ERR SLIT("parError")
 593     (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noCafIdInfo
 594
 595 \end{code}
 596
 597
 598 %************************************************************************
 599 %*                                                                      *
 600 \subsection{Utilities}
 601 %*                                                                      *
 602 %************************************************************************
 603
 604 \begin{code}
 605 pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
 606 pcMiscPrelId key mod str ty info
 607   = let
 608         name = mkWiredInIdName key mod (mkSrcVarOcc str) imp
 609         imp  = mkId name ty info -- the usual case...
 610     in
 611     imp
 612     -- We lie and say the thing is imported; otherwise, we get into
 613     -- a mess with dependency analysis; e.g., core2stg may heave in
 614     -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
 615     -- being compiled, then it's just a matter of luck if the definition
 616     -- will be in "the right place" to be in scope.
 617
 618 pc_bottoming_Id key mod name ty
 619  = pcMiscPrelId key mod name ty bottoming_info
 620  where
 621     bottoming_info = noCafIdInfo
 622                      `setStrictnessInfo` mkStrictnessInfo ([wwStrict], True)
 623
 624         -- these "bottom" out, no matter what their arguments
 625
 626 generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy
 627
 628 -- Very useful...
 629 noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs
 630
 631 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
 632 openAlphaTy  = mkTyVarTy openAlphaTyVar
 633 openBetaTy   = mkTyVarTy openBetaTyVar
 634
 635 errorTy  :: Type
 636 errorTy  = mkUsgTy UsMany $
 637            mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkUsgTy UsOnce (mkListTy charTy)]
 638                                                    (mkUsgTy UsMany openAlphaTy))
 639     -- Notice the openAlphaTyVar.  It says that "error" can be applied
 640     -- to unboxed as well as boxed types.  This is OK because it never
 641     -- returns, so the return type is irrelevant.
 642 \end{code}
 643