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       ( mkUnfolding )
  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 = mkUnfolding (Note InlineMe con_rhs)
 203
 204         (tyvars, theta, ex_tyvars, ex_theta, orig_arg_tys, tycon)
 205            = dataConSig data_con
 206         rep_arg_tys = dataConRawArgTys data_con
 207         all_tyvars   = tyvars ++ ex_tyvars
 208
 209         dict_tys     = [mkDictTy clas tys | (clas,tys) <- theta]
 210         ex_dict_tys  = [mkDictTy clas tys | (clas,tys) <- ex_theta]
 211
 212         n_dicts      = length dict_tys
 213         n_ex_dicts   = length ex_dict_tys
 214         n_id_args    = length orig_arg_tys
 215         n_rep_args   = length rep_arg_tys
 216
 217         result_ty    = mkTyConApp tycon (mkTyVarTys tyvars)
 218
 219         mkLocals i n tys   = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
 220         (dict_args, i1)    = mkLocals 1  n_dicts    dict_tys
 221         (ex_dict_args,i2)  = mkLocals i1 n_ex_dicts ex_dict_tys
 222         (id_args,i3)       = mkLocals i2 n_id_args  orig_arg_tys
 223
 224         (id_arg1:_) = id_args           -- Used for newtype only
 225         strict_marks  = dataConStrictMarks data_con
 226
 227         con_app i rep_ids
 228                 | isNewTyCon tycon
 229                 = ASSERT( length orig_arg_tys == 1 )
 230                   Note (Coerce result_ty (head orig_arg_tys)) (Var id_arg1)
 231                 | otherwise
 232                 = mkConApp data_con
 233                         (map Type (mkTyVarTys all_tyvars) ++
 234                          map Var (reverse rep_ids))
 235
 236         con_rhs = mkLams all_tyvars $ mkLams dict_args $
 237                   mkLams ex_dict_args $ mkLams id_args $
 238                   foldr mk_case con_app
 239                      (zip (ex_dict_args++id_args) strict_marks) i3 []
 240
 241         mk_case
 242            :: (Id, StrictnessMark)      -- arg, strictness
 243            -> (Int -> [Id] -> CoreExpr) -- body
 244            -> Int                       -- next rep arg id
 245            -> [Id]                      -- rep args so far
 246            -> CoreExpr
 247         mk_case (arg,strict) body i rep_args
 248           = case strict of
 249                 NotMarkedStrict -> body i (arg:rep_args)
 250                 MarkedStrict
 251                    | isUnLiftedType (idType arg) -> body i (arg:rep_args)
 252                    | otherwise ->
 253                         Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
 254
 255                 MarkedUnboxed con tys ->
 256                    Case (Var arg) arg [(DataCon con, con_args,
 257                                         body i' (reverse con_args++rep_args))]
 258                    where n_tys = length tys
 259                          (con_args,i') = mkLocals i (length tys) tys
 260 \end{code}
 261
 262
 263 %************************************************************************
 264 %*                                                                      *
 265 \subsection{Record selectors}
 266 %*                                                                      *
 267 %************************************************************************
 268
 269 We're going to build a record selector unfolding that looks like this:
 270
 271         data T a b c = T1 { ..., op :: a, ...}
 272                      | T2 { ..., op :: a, ...}
 273                      | T3
 274
 275         sel = /\ a b c -> \ d -> case d of
 276                                     T1 ... x ... -> x
 277                                     T2 ... x ... -> x
 278                                     other        -> error "..."
 279
 280 \begin{code}
 281 mkRecordSelId field_label selector_ty
 282   = ASSERT( null theta && isDataTyCon tycon )
 283     sel_id
 284   where
 285     sel_id = mkId (fieldLabelName field_label) selector_ty info
 286
 287     info = mkIdInfo (RecordSelId field_label)
 288            `setArityInfo`       exactArity 1
 289            `setUnfoldingInfo`   unfolding
 290
 291         -- ToDo: consider adding further IdInfo
 292
 293     unfolding = mkUnfolding sel_rhs
 294
 295     (tyvars, theta, tau)  = splitSigmaTy selector_ty
 296     (data_ty,rhs_ty)      = expectJust "StdIdInfoRec" (splitFunTy_maybe tau)
 297                                         -- tau is of form (T a b c -> field-type)
 298     (tycon, _, data_cons) = splitAlgTyConApp data_ty
 299     tyvar_tys             = mkTyVarTys tyvars
 300
 301     [data_id] = mkTemplateLocals [data_ty]
 302     alts      = map mk_maybe_alt data_cons
 303     the_alts  = catMaybes alts
 304     default_alt | all isJust alts = []  -- No default needed
 305                 | otherwise       = [(DEFAULT, [], error_expr)]
 306
 307     sel_rhs   = mkLams tyvars $ Lam data_id $
 308                 Case (Var data_id) data_id (the_alts ++ default_alt)
 309
 310     mk_maybe_alt data_con
 311           = case maybe_the_arg_id of
 312                 Nothing         -> Nothing
 313                 Just the_arg_id -> Just (DataCon data_con, arg_ids, Var the_arg_id)
 314           where
 315             arg_ids          = mkTemplateLocals (dataConArgTys data_con tyvar_tys)
 316                                     -- The first one will shadow data_id, but who cares
 317             field_lbls       = dataConFieldLabels data_con
 318             maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
 319
 320     error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type (unUsgTy rhs_ty), mkStringLit full_msg]
 321        -- preserves invariant that type args are *not* usage-annotated on top.  KSW 1999-04.
 322     full_msg   = showSDoc (sep [text "No match in record selector", ppr sel_id])
 323 \end{code}
 324
 325
 326 %************************************************************************
 327 %*                                                                      *
 328 \subsection{Newtype field selectors}
 329 %*                                                                      *
 330 %************************************************************************
 331
 332 Possibly overkill to do it this way:
 333
 334 \begin{code}
 335 mkNewTySelId field_label selector_ty = sel_id
 336   where
 337     sel_id = mkId (fieldLabelName field_label) selector_ty info
 338
 339
 340     info = mkIdInfo (RecordSelId field_label)
 341            `setArityInfo`       exactArity 1
 342            `setUnfoldingInfo`   unfolding
 343
 344         -- ToDo: consider adding further IdInfo
 345
 346     unfolding = mkUnfolding sel_rhs
 347
 348     (tyvars, theta, tau)  = splitSigmaTy selector_ty
 349     (data_ty,rhs_ty)      = expectJust "StdIdInfoRec" (splitFunTy_maybe tau)
 350                                         -- tau is of form (T a b c -> field-type)
 351     (tycon, _, data_cons) = splitAlgTyConApp data_ty
 352     tyvar_tys             = mkTyVarTys tyvars
 353
 354     [data_id] = mkTemplateLocals [data_ty]
 355     sel_rhs   = mkLams tyvars $ Lam data_id $
 356                 Note (Coerce rhs_ty data_ty) (Var data_id)
 357 \end{code}
 358
 359
 360 %************************************************************************
 361 %*                                                                      *
 362 \subsection{Dictionary selectors}
 363 %*                                                                      *
 364 %************************************************************************
 365
 366 Selecting a field for a dictionary.  If there is just one field, then
 367 there's nothing to do.
 368
 369 \begin{code}
 370 mkDictSelId name clas ty
 371   = sel_id
 372   where
 373     sel_id    = mkId name ty info
 374     field_lbl = mkFieldLabel name ty tag
 375     tag       = assoc "MkId.mkDictSelId" ((sc_sel_ids ++ op_sel_ids) `zip` allFieldLabelTags) sel_id
 376
 377     info      = mkIdInfo (RecordSelId field_lbl)
 378                 `setUnfoldingInfo`  unfolding
 379
 380         -- We no longer use 'must-inline' on record selectors.  They'll
 381         -- inline like crazy if they scrutinise a constructor
 382
 383     unfolding = mkUnfolding rhs
 384
 385     (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
 386
 387     tycon      = classTyCon clas
 388     [data_con] = tyConDataCons tycon
 389     tyvar_tys  = mkTyVarTys tyvars
 390     arg_tys    = dataConArgTys data_con tyvar_tys
 391     the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
 392
 393     dict_ty    = mkDictTy clas tyvar_tys
 394     (dict_id:arg_ids) = mkTemplateLocals (dict_ty : arg_tys)
 395
 396     rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
 397                              Note (Coerce (head arg_tys) dict_ty) (Var dict_id)
 398         | otherwise        = mkLams tyvars $ Lam dict_id $
 399                              Case (Var dict_id) dict_id
 400                                   [(DataCon data_con, arg_ids, Var the_arg_id)]
 401 \end{code}
 402
 403
 404 %************************************************************************
 405 %*                                                                      *
 406 \subsection{Primitive operations
 407 %*                                                                      *
 408 %************************************************************************
 409
 410 \begin{code}
 411 mkPrimitiveId :: PrimOp -> Id
 412 mkPrimitiveId prim_op
 413   = id
 414   where
 415     (tyvars,arg_tys,res_ty) = primOpSig prim_op
 416     ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
 417     name = mkPrimOpIdName prim_op id
 418     id   = mkId name ty info
 419
 420     info = mkIdInfo (ConstantId (PrimOp prim_op))
 421            `setUnfoldingInfo`   unfolding
 422            `setInlinePragInfo`  IMustBeINLINEd
 423                 -- The pragma @IMustBeINLINEd@ says that this Id absolutely
 424                 -- must be inlined.  It's only used for primitives,
 425                 -- because we don't want to make a closure for each of them.
 426
 427
 428     unfolding = mkUnfolding rhs
 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`   mkUnfolding rhs
 504            `setInlinePragInfo`  IMustBeINLINEd
 505
 506
 507     ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
 508                       (mkFunTy openAlphaTy openBetaTy)
 509     [x] = mkTemplateLocals [openAlphaTy]
 510     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
 511           Note (Coerce openBetaTy openAlphaTy) (Var x)
 512 \end{code}
 513
 514
 515 @getTag#@ is another function which can't be defined in Haskell.  It needs to
 516 evaluate its argument and call the dataToTag# primitive.
 517
 518 \begin{code}
 519 getTagId
 520   = pcMiscPrelId getTagIdKey pREL_GHC SLIT("getTag#") ty info
 521   where
 522     info = vanillaIdInfo
 523            `setUnfoldingInfo`   mkUnfolding rhs
 524            `setInlinePragInfo`  IMustBeINLINEd
 525         -- We don't provide a defn for this; you must inline it
 526
 527     ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
 528     [x,y] = mkTemplateLocals [alphaTy,alphaTy]
 529     rhs = mkLams [alphaTyVar,x] $
 530           Case (Var x) y [ (DEFAULT, [],
 531                    Con (PrimOp DataToTagOp) [Type alphaTy, Var y]) ]
 532 \end{code}
 533
 534 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
 535 nasty as-is, change it back to a literal (@Literal@).
 536
 537 \begin{code}
 538 realWorldPrimId -- :: State# RealWorld
 539   = pcMiscPrelId realWorldPrimIdKey pREL_GHC SLIT("realWorld#")
 540                  realWorldStatePrimTy
 541                  noCafIdInfo
 542 \end{code}
 543
 544
 545 %************************************************************************
 546 %*                                                                      *
 547 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
 548 %*                                                                      *
 549 %************************************************************************
 550
 551 GHC randomly injects these into the code.
 552
 553 @patError@ is just a version of @error@ for pattern-matching
 554 failures.  It knows various ``codes'' which expand to longer
 555 strings---this saves space!
 556
 557 @absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
 558 well shouldn't be yanked on, but if one is, then you will get a
 559 friendly message from @absentErr@ (rather than a totally random
 560 crash).
 561
 562 @parError@ is a special version of @error@ which the compiler does
 563 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
 564 templates, but we don't ever expect to generate code for it.
 565
 566 \begin{code}
 567 eRROR_ID
 568   = pc_bottoming_Id errorIdKey pREL_ERR SLIT("error") errorTy
 569 rEC_SEL_ERROR_ID
 570   = generic_ERROR_ID recSelErrIdKey SLIT("patError")
 571 pAT_ERROR_ID
 572   = generic_ERROR_ID patErrorIdKey SLIT("patError")
 573 rEC_CON_ERROR_ID
 574   = generic_ERROR_ID recConErrorIdKey SLIT("recConError")
 575 rEC_UPD_ERROR_ID
 576   = generic_ERROR_ID recUpdErrorIdKey SLIT("recUpdError")
 577 iRREFUT_PAT_ERROR_ID
 578   = generic_ERROR_ID irrefutPatErrorIdKey SLIT("irrefutPatError")
 579 nON_EXHAUSTIVE_GUARDS_ERROR_ID
 580   = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey SLIT("nonExhaustiveGuardsError")
 581 nO_METHOD_BINDING_ERROR_ID
 582   = generic_ERROR_ID noMethodBindingErrorIdKey SLIT("noMethodBindingError")
 583
 584 aBSENT_ERROR_ID
 585   = pc_bottoming_Id absentErrorIdKey pREL_ERR SLIT("absentErr")
 586         (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
 587
 588 pAR_ERROR_ID
 589   = pcMiscPrelId parErrorIdKey pREL_ERR SLIT("parError")
 590     (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noCafIdInfo
 591
 592 \end{code}
 593
 594
 595 %************************************************************************
 596 %*                                                                      *
 597 \subsection{Utilities}
 598 %*                                                                      *
 599 %************************************************************************
 600
 601 \begin{code}
 602 pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
 603 pcMiscPrelId key mod str ty info
 604   = let
 605         name = mkWiredInIdName key mod (mkSrcVarOcc str) imp
 606         imp  = mkId name ty info -- the usual case...
 607     in
 608     imp
 609     -- We lie and say the thing is imported; otherwise, we get into
 610     -- a mess with dependency analysis; e.g., core2stg may heave in
 611     -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
 612     -- being compiled, then it's just a matter of luck if the definition
 613     -- will be in "the right place" to be in scope.
 614
 615 pc_bottoming_Id key mod name ty
 616  = pcMiscPrelId key mod name ty bottoming_info
 617  where
 618     bottoming_info = noCafIdInfo
 619                      `setStrictnessInfo` mkStrictnessInfo ([wwStrict], True)
 620
 621         -- these "bottom" out, no matter what their arguments
 622
 623 generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy
 624
 625 -- Very useful...
 626 noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs
 627
 628 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
 629 openAlphaTy  = mkTyVarTy openAlphaTyVar
 630 openBetaTy   = mkTyVarTy openBetaTyVar
 631
 632 errorTy  :: Type
 633 errorTy  = mkUsgTy UsMany $
 634            mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkUsgTy UsOnce (mkListTy charTy)]
 635                                                    (mkUsgTy UsMany openAlphaTy))
 636     -- Notice the openAlphaTyVar.  It says that "error" can be applied
 637     -- to unboxed as well as boxed types.  This is OK because it never
 638     -- returns, so the return type is irrelevant.
 639 \end{code}
 640