ghc/compiler/basicTypes/Id.lhs

   1
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[Id]{@Ids@: Value and constructor identifiers}
   5
   6 \begin{code}
   7 module Id (
   8         -- TYPES
   9         GenId,                  -- Abstract
  10         Id,
  11         IdDetails(..),          -- Exposed only to MkId
  12         StrictnessMark(..),
  13         ConTag, fIRST_TAG,
  14         DataCon, DictFun, DictVar,
  15
  16         -- Construction and modification
  17         mkId, mkIdWithNewUniq, mkIdWithNewName, mkIdWithNewType,
  18         mkTemplateLocals,
  19         setIdVisibility, mkIdVisible,
  20         mkVanillaId,
  21
  22         -- DESTRUCTION (excluding pragmatic info)
  23         idPrimRep,
  24         idType,
  25         idUnique,
  26         idName,
  27
  28         -- Extracting pieces of particular sorts of Ids
  29         dataConRepType,
  30         dataConArgTys,
  31         dataConNumFields,
  32         dataConFieldLabels,
  33         dataConRawArgTys,
  34         dataConSig,
  35         dataConStrictMarks,
  36         dataConTag,
  37         dataConTyCon,
  38
  39         recordSelectorFieldLabel,
  40
  41         -- PREDICATES
  42         omitIfaceSigForId,
  43         cmpId,
  44         externallyVisibleId,
  45         idHasNoFreeTyVars,
  46         idWantsToBeINLINEd, getInlinePragma,
  47         idMustBeINLINEd, idMustNotBeINLINEd,
  48         isBottomingId,
  49
  50         isDataCon, isAlgCon, isNewCon, isTupleCon,
  51         isNullaryDataCon,
  52
  53         isRecordSelector, isSpecPragmaId,
  54         isPrimitiveId_maybe,
  55
  56         -- PRINTING and RENUMBERING
  57         pprId,
  58         showId,
  59
  60         -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
  61         idInfo,
  62         addIdUnfolding,
  63         addIdArity,
  64         addIdDemandInfo,
  65         addIdStrictness,
  66         addIdUpdateInfo,
  67         getIdArity,
  68         getIdDemandInfo,
  69         getIdStrictness,
  70         getIdUnfolding,
  71         getIdUpdateInfo,
  72         replaceIdInfo,
  73         addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
  74         getIdSpecialisation,
  75         setIdSpecialisation,
  76
  77         -- IdEnvs AND IdSets
  78         IdEnv, GenIdSet, IdSet,
  79         addOneToIdEnv,
  80         addOneToIdSet,
  81         combineIdEnvs,
  82         delManyFromIdEnv,
  83         delOneFromIdEnv,
  84         elementOfIdSet,
  85         emptyIdSet,
  86         growIdEnv,
  87         growIdEnvList,
  88         idSetToList,
  89         intersectIdSets,
  90         isEmptyIdSet,
  91         isNullIdEnv,
  92         lookupIdEnv, lookupIdSubst,
  93         lookupNoFailIdEnv,
  94         mapIdEnv,
  95         minusIdSet,
  96         mkIdEnv, elemIdEnv,
  97         mkIdSet,
  98         modifyIdEnv,
  99         modifyIdEnv_Directly,
 100         nullIdEnv,
 101         rngIdEnv,
 102         unionIdSets,
 103         unionManyIdSets,
 104         unitIdEnv,
 105         unitIdSet
 106     ) where
 107
 108 #include "HsVersions.h"
 109
 110 import {-# SOURCE #-} CoreUnfold ( Unfolding )
 111
 112 import CmdLineOpts      ( opt_PprStyle_All )
 113 import Bag
 114 import IdInfo
 115 import Name             ( nameUnique, isLocalName, mkSysLocalName,
 116                           isWiredInName, setNameVisibility, mkNameVisible,
 117                           changeUnique,
 118                           ExportFlag(..), Provenance,
 119                           OccName(..), Name, Module,
 120                           NamedThing(..)
 121                         )
 122 import PrimOp           ( PrimOp )
 123 import PrelMods         ( pREL_TUP, pREL_BASE )
 124 import FieldLabel       ( fieldLabelName, FieldLabel(..) )
 125 import SrcLoc           ( mkBuiltinSrcLoc )
 126 import TysWiredIn       ( tupleTyCon )
 127 import TyCon            ( TyCon, isDataTyCon, isNewTyCon )
 128 import Type             ( mkSigmaTy, mkTyVarTys, mkFunTys,
 129                           mkTyConApp, instantiateTy, mkForAllTys,
 130                           tyVarsOfType, instantiateTy, typePrimRep,
 131                           instantiateTauTy,
 132                           ThetaType, TauType, Type, GenType
 133                         )
 134 import TyVar            ( TyVar, alphaTyVars, isEmptyTyVarSet,
 135                           TyVarEnv, zipTyVarEnv, mkTyVarEnv
 136                         )
 137 import UniqFM
 138 import UniqSet          -- practically all of it
 139 import Unique           ( Unique, Uniquable(..), getBuiltinUniques )
 140 import Outputable
 141 import SrcLoc           ( SrcLoc )
 142 import Util             ( nOfThem, assoc )
 143 import GlaExts          ( Int# )
 144 \end{code}
 145
 146 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
 147 follow.
 148
 149 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
 150 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
 151 strictness).  The essential info about different kinds of @Ids@ is
 152 in its @IdDetails@.
 153
 154 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
 155
 156 \begin{code}
 157 data GenId ty = Id {
 158         idUnique  :: Unique,            -- Key for fast comparison
 159         idName    :: Name,
 160         idType    :: ty,                -- Id's type; used all the time;
 161         idDetails :: IdDetails,         -- Stuff about individual kinds of Ids.
 162         idInfo    :: IdInfo             -- Properties of this Id deduced by compiler
 163         }
 164
 165 type Id            = GenId Type
 166
 167 data StrictnessMark = MarkedStrict | NotMarkedStrict
 168
 169 data IdDetails
 170
 171   ---------------- Local values
 172
 173   = VanillaId   Bool            -- Ordinary Id
 174                                 -- True <=> no free type vars
 175
 176   | PrimitiveId PrimOp          -- The Id for a primitive operation
 177
 178
 179   ---------------- Data constructors
 180
 181   | AlgConId                    -- Used for both data and newtype constructors.
 182                                 -- You can tell the difference by looking at the TyCon
 183                 ConTag
 184                 [StrictnessMark] -- Strict args; length = arity
 185                 [FieldLabel]    -- Field labels for this constructor;
 186                                 --length = 0 (not a record) or arity
 187
 188                 [TyVar] ThetaType       -- Type vars and context for the data type decl
 189                 [TyVar] ThetaType       -- Ditto for the context of the constructor,
 190                                         -- the existentially quantified stuff
 191                 [Type] TyCon            -- Args and result tycon
 192                                 -- the type is:
 193                                 -- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
 194                                 --    unitype_1 -> ... -> unitype_n -> tycon tyvars
 195
 196   | TupleConId  Int             -- Its arity
 197
 198   | RecordSelId FieldLabel
 199
 200   | SpecPragmaId                -- This guy exists only to make Ids that are
 201                                 -- on the *LHS* of bindings created by SPECIALISE
 202                                 -- pragmas; eg:         s = f Int d
 203                                 -- The SpecPragmaId is never itself mentioned; it
 204                                 -- exists solely so that the specialiser will find
 205                                 -- the call to f, and make specialised version of it.
 206                                 -- The SpecPragmaId binding is discarded by the specialiser
 207                                 -- when it gathers up overloaded calls.
 208                                 -- Meanwhile, it is not discarded as dead code.
 209
 210
 211
 212 type ConTag     = Int
 213 type DictVar    = Id
 214 type DictFun    = Id
 215 type DataCon    = Id
 216 \end{code}
 217
 218
 219 %************************************************************************
 220 %*                                                                      *
 221 \subsection{Construction}
 222 %*                                                                      *
 223 %************************************************************************
 224
 225 \begin{code}
 226 mkId :: Name -> ty -> IdDetails -> IdInfo -> GenId ty
 227 mkId name ty details info
 228   = Id {idName = name, idUnique = nameUnique name, idType = ty,
 229         idDetails = details, idInfo = info}
 230
 231 mkVanillaId :: Name -> (GenType flexi) -> IdInfo -> GenId (GenType flexi)
 232 mkVanillaId name ty info
 233   = Id {idName = name, idUnique = nameUnique name, idType = ty,
 234         idDetails = VanillaId (isEmptyTyVarSet (tyVarsOfType ty)),
 235         idInfo = info}
 236
 237 mkIdWithNewUniq :: Id -> Unique -> Id
 238 mkIdWithNewUniq id uniq = id {idUnique = uniq, idName = changeUnique (idName id) uniq}
 239
 240 mkIdWithNewName :: Id -> Name -> Id
 241 mkIdWithNewName id new_name
 242   = id {idUnique = uniqueOf new_name, idName = new_name}
 243
 244 mkIdWithNewType :: GenId ty1 -> ty2 -> GenId ty2
 245 mkIdWithNewType id ty = id {idType = ty}
 246 \end{code}
 247
 248
 249 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 250 @Uniques@, but that's OK because the templates are supposed to be
 251 instantiated before use.
 252
 253 \begin{code}
 254 mkTemplateLocals :: [Type] -> [Id]
 255 mkTemplateLocals tys
 256   = zipWith3 mk (getBuiltinUniques (length tys)) tys [1..]
 257   where
 258     mk uniq ty n = mkVanillaId (mkSysLocalName uniq (_PK_ ("x"++show n)) mkBuiltinSrcLoc)
 259                                ty noIdInfo
 260 \end{code}
 261
 262
 263 \begin{code}
 264 -- See notes with setNameVisibility (Name.lhs)
 265 setIdVisibility :: Maybe Module -> Unique -> Id -> Id
 266 setIdVisibility maybe_mod u id
 267   = id {idName = setNameVisibility maybe_mod u (idName id)}
 268
 269 mkIdVisible :: Module -> Unique -> Id -> Id
 270 mkIdVisible mod u id = id {idName = mkNameVisible mod u (idName id)}
 271
 272 replaceIdInfo :: GenId ty -> IdInfo -> GenId ty
 273 replaceIdInfo id info = id {idInfo = info}
 274 \end{code}
 275
 276 %************************************************************************
 277 %*                                                                      *
 278 \subsection[Id-general-funs]{General @Id@-related functions}
 279 %*                                                                      *
 280 %************************************************************************
 281
 282 \begin{code}
 283 fIRST_TAG :: ConTag
 284 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 285
 286 -- isDataCon returns False for @newtype@ constructors
 287 isDataCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isDataTyCon tc
 288 isDataCon (Id {idDetails = TupleConId _})                = True
 289 isDataCon other                                          = False
 290
 291 isNewCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isNewTyCon tc
 292 isNewCon other                                          = False
 293
 294 -- isAlgCon returns True for @data@ or @newtype@ constructors
 295 isAlgCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ _}) = True
 296 isAlgCon (Id {idDetails = TupleConId _})               = True
 297 isAlgCon other                                         = False
 298
 299 isTupleCon (Id {idDetails = TupleConId _}) = True
 300 isTupleCon other                           = False
 301 \end{code}
 302
 303 \begin{code}
 304 idHasNoFreeTyVars :: Id -> Bool
 305
 306 idHasNoFreeTyVars (Id {idDetails = details})
 307   = chk details
 308   where
 309     chk (AlgConId _ _ _ _ _ _ _ _ _) = True
 310     chk (TupleConId _)             = True
 311     chk (RecordSelId _)            = True
 312     chk (VanillaId    no_free_tvs) = no_free_tvs
 313     chk (PrimitiveId _)            = True
 314     chk SpecPragmaId               = False      -- Play safe
 315
 316 -- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
 317 -- so we don't need to put its signature in an interface file, even if it's mentioned
 318 -- in some other interface unfolding.
 319
 320 omitIfaceSigForId
 321         :: Id
 322         -> Bool
 323
 324 omitIfaceSigForId (Id {idName = name, idDetails = details})
 325   | isWiredInName name
 326   = True
 327
 328   | otherwise
 329   = case details of
 330         (PrimitiveId _)   -> True               -- Ditto, for primitives
 331
 332         -- This group is Ids that are implied by their type or class decl;
 333         -- remember that all type and class decls appear in the interface file.
 334         -- The dfun id must *not* be omitted, because it carries version info for
 335         -- the instance decl
 336         (AlgConId _ _ _ _ _ _ _ _ _) -> True
 337         (TupleConId _)               -> True
 338         (RecordSelId _)              -> True
 339
 340         other                        -> False   -- Don't omit!
 341                 -- NB DefaultMethodIds are not omitted
 342 \end{code}
 343
 344 \begin{code}
 345 isBottomingId id = bottomIsGuaranteed (strictnessInfo (idInfo id))
 346
 347 isPrimitiveId_maybe (Id {idDetails = PrimitiveId primop}) = Just primop
 348 isPrimitiveId_maybe other                                 = Nothing
 349
 350 isSpecPragmaId (Id {idDetails = SpecPragmaId}) = True
 351 isSpecPragmaId _                               = False
 352 \end{code}
 353
 354 @externallyVisibleId@: is it true that another module might be
 355 able to ``see'' this Id in a code generation sense. That
 356 is, another .o file might refer to this Id.
 357
 358 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
 359 local-ness precisely so that the test here would be easy
 360
 361 \begin{code}
 362 externallyVisibleId :: Id -> Bool
 363 externallyVisibleId id = not (isLocalName (idName id))
 364                      -- not local => global => externally visible
 365 \end{code}
 366
 367
 368 \begin{code}
 369 idPrimRep id = typePrimRep (idType id)
 370 \end{code}
 371
 372
 373 %************************************************************************
 374 %*                                                                      *
 375 \subsection[Id-arities]{Arity-related functions}
 376 %*                                                                      *
 377 %************************************************************************
 378
 379 For locally-defined Ids, the code generator maintains its own notion
 380 of their arities; so it should not be asking...  (but other things
 381 besides the code-generator need arity info!)
 382
 383 \begin{code}
 384 getIdArity :: Id -> ArityInfo
 385 getIdArity id = arityInfo (idInfo id)
 386
 387 addIdArity :: Id -> ArityInfo -> Id
 388 addIdArity id@(Id {idInfo = info}) arity
 389   = id {idInfo = arity `setArityInfo` info}
 390 \end{code}
 391
 392 %************************************************************************
 393 %*                                                                      *
 394 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
 395 %*                                                                      *
 396 %************************************************************************
 397
 398
 399 dataConNumFields gives the number of actual fields in the
 400 {\em representation} of the data constructor.  This may be more than appear
 401 in the source code; the extra ones are the existentially quantified
 402 dictionaries
 403
 404 \begin{code}
 405 dataConNumFields id
 406   = ASSERT( if (isDataCon id) then True else
 407             pprTrace "dataConNumFields" (ppr id) False )
 408     case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
 409     length con_theta + length arg_tys }
 410
 411 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
 412
 413 \end{code}
 414
 415
 416 \begin{code}
 417 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
 418 dataConTag (Id {idDetails = AlgConId tag _ _ _ _ _ _ _ _}) = tag
 419 dataConTag (Id {idDetails = TupleConId _})                 = fIRST_TAG
 420
 421 dataConTyCon :: DataCon -> TyCon        -- will panic if not a DataCon
 422 dataConTyCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tycon}) = tycon
 423 dataConTyCon (Id {idDetails = TupleConId a})                   = tupleTyCon a
 424
 425 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
 426                                         -- will panic if not a DataCon
 427
 428 dataConSig (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
 429   = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
 430
 431 dataConSig (Id {idDetails = TupleConId arity})
 432   = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
 433   where
 434     tyvars      = take arity alphaTyVars
 435     tyvar_tys   = mkTyVarTys tyvars
 436
 437
 438 -- dataConRepType returns the type of the representation of a contructor
 439 -- This may differ from the type of the contructor Id itself for two reasons:
 440 --      a) the constructor Id may be overloaded, but the dictionary isn't stored
 441 --         e.g.    data Eq a => T a = MkT a a
 442 --
 443 --      b) the constructor may store an unboxed version of a strict field.
 444 --
 445 -- Here's an example illustrating both:
 446 --      data Ord a => T a = MkT Int! a
 447 -- Here
 448 --      T :: Ord a => Int -> a -> T a
 449 -- but the rep type is
 450 --      Trep :: Int# -> a -> T a
 451 -- Actually, the unboxed part isn't implemented yet!
 452
 453 dataConRepType :: Id -> Type
 454 dataConRepType (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
 455   = mkForAllTys (tyvars++con_tyvars)
 456                 (mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
 457 dataConRepType other_id
 458   = ASSERT( isDataCon other_id )
 459     idType other_id
 460
 461 dataConFieldLabels :: DataCon -> [FieldLabel]
 462 dataConFieldLabels (Id {idDetails = AlgConId _ _ fields _ _ _ _ _ _}) = fields
 463 dataConFieldLabels (Id {idDetails = TupleConId _})                    = []
 464 #ifdef DEBUG
 465 dataConFieldLabels x@(Id {idDetails = idt}) =
 466   panic ("dataConFieldLabel: " ++
 467     (case idt of
 468       VanillaId _   -> "l"
 469       PrimitiveId _ -> "p"
 470       RecordSelId _ -> "r"))
 471 #endif
 472
 473 dataConStrictMarks :: DataCon -> [StrictnessMark]
 474 dataConStrictMarks (Id {idDetails = AlgConId _ stricts _ _ _ _ _ _ _}) = stricts
 475 dataConStrictMarks (Id {idDetails = TupleConId arity})                 = nOfThem arity NotMarkedStrict
 476
 477 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
 478 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
 479
 480 dataConArgTys :: DataCon
 481               -> [Type]         -- Instantiated at these types
 482               -> [Type]         -- Needs arguments of these types
 483 dataConArgTys con_id inst_tys
 484  = map (instantiateTy tenv) arg_tys
 485  where
 486     (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
 487     tenv                          = zipTyVarEnv tyvars inst_tys
 488 \end{code}
 489
 490 \begin{code}
 491 recordSelectorFieldLabel :: Id -> FieldLabel
 492 recordSelectorFieldLabel (Id {idDetails = RecordSelId lbl}) = lbl
 493
 494 isRecordSelector (Id {idDetails = RecordSelId lbl}) = True
 495 isRecordSelector other                              = False
 496 \end{code}
 497
 498
 499 %************************************************************************
 500 %*                                                                      *
 501 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
 502 %*                                                                      *
 503 %************************************************************************
 504
 505 \begin{code}
 506 getIdUnfolding :: Id -> Unfolding
 507
 508 getIdUnfolding id = unfoldingInfo (idInfo id)
 509
 510 addIdUnfolding :: Id -> Unfolding -> Id
 511 addIdUnfolding id@(Id {idInfo = info}) unfolding
 512   = id {idInfo = unfolding `setUnfoldingInfo` info}
 513 \end{code}
 514
 515 The inline pragma tells us to be very keen to inline this Id, but it's still
 516 OK not to if optimisation is switched off.
 517
 518 \begin{code}
 519 getInlinePragma :: Id -> InlinePragInfo
 520 getInlinePragma id = inlinePragInfo (idInfo id)
 521
 522 idWantsToBeINLINEd :: Id -> Bool
 523
 524 idWantsToBeINLINEd id = case getInlinePragma id of
 525                           IWantToBeINLINEd -> True
 526                           IMustBeINLINEd   -> True
 527                           other            -> False
 528
 529 idMustNotBeINLINEd id = case getInlinePragma id of
 530                           IDontWantToBeINLINEd -> True
 531                           IMustNotBeINLINEd    -> True
 532                           other                -> False
 533
 534 idMustBeINLINEd id =  case getInlinePragma id of
 535                         IMustBeINLINEd -> True
 536                         other          -> False
 537
 538 addInlinePragma :: Id -> Id
 539 addInlinePragma id@(Id {idInfo = info})
 540   = id {idInfo = setInlinePragInfo IWantToBeINLINEd info}
 541
 542 nukeNoInlinePragma :: Id -> Id
 543 nukeNoInlinePragma id@(Id {idInfo = info})
 544   = case inlinePragInfo info of
 545         IMustNotBeINLINEd -> id {idInfo = setInlinePragInfo NoPragmaInfo info}
 546         other             -> id
 547
 548 -- If the user has already marked this binding as NOINLINE, then don't
 549 -- add the IMustNotBeINLINEd tag, since it will get nuked later whereas
 550 -- IDontWantToBeINLINEd is permanent.
 551
 552 addNoInlinePragma :: Id -> Id
 553 addNoInlinePragma id@(Id {idInfo = info})
 554   = case inlinePragInfo info of
 555         IDontWantToBeINLINEd -> id
 556         other -> id {idInfo = IMustNotBeINLINEd `setInlinePragInfo` info}
 557
 558 mustInlineInfo   = IMustBeINLINEd   `setInlinePragInfo` noIdInfo
 559 wantToInlineInfo = IWantToBeINLINEd `setInlinePragInfo` noIdInfo
 560 \end{code}
 561
 562
 563
 564 %************************************************************************
 565 %*                                                                      *
 566 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
 567 %*                                                                      *
 568 %************************************************************************
 569
 570 \begin{code}
 571 getIdDemandInfo :: Id -> DemandInfo
 572 getIdDemandInfo id = demandInfo (idInfo id)
 573
 574 addIdDemandInfo :: Id -> DemandInfo -> Id
 575 addIdDemandInfo id@(Id {idInfo = info}) demand_info
 576   = id {idInfo = demand_info `setDemandInfo` info}
 577 \end{code}p
 578
 579 \begin{code}
 580 getIdUpdateInfo :: Id -> UpdateInfo
 581 getIdUpdateInfo id = updateInfo (idInfo id)
 582
 583 addIdUpdateInfo :: Id -> UpdateInfo -> Id
 584 addIdUpdateInfo id@(Id {idInfo = info}) upd_info
 585   = id {idInfo = upd_info `setUpdateInfo` info}
 586 \end{code}
 587
 588 \begin{code}
 589 getIdSpecialisation :: Id -> IdSpecEnv
 590 getIdSpecialisation id = specInfo (idInfo id)
 591
 592 setIdSpecialisation :: Id -> IdSpecEnv -> Id
 593 setIdSpecialisation id@(Id {idInfo = info}) spec_info
 594   = id {idInfo = spec_info `setSpecInfo` info}
 595 \end{code}
 596
 597 \begin{code}
 598 getIdStrictness :: Id -> StrictnessInfo
 599 getIdStrictness id = strictnessInfo (idInfo id)
 600
 601 addIdStrictness :: Id -> StrictnessInfo -> Id
 602 addIdStrictness id@(Id {idInfo = info}) strict_info
 603   = id {idInfo = strict_info `setStrictnessInfo` info}
 604 \end{code}
 605
 606 %************************************************************************
 607 %*                                                                      *
 608 \subsection[Id-comparison]{Comparison functions for @Id@s}
 609 %*                                                                      *
 610 %************************************************************************
 611
 612 Comparison: equality and ordering---this stuff gets {\em hammered}.
 613
 614 \begin{code}
 615 cmpId (Id {idUnique = u1}) (Id {idUnique = u2}) = compare u1 u2
 616 \end{code}
 617
 618 \begin{code}
 619 instance Eq (GenId ty) where
 620     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 621     a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
 622
 623 instance Ord (GenId ty) where
 624     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 625     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 626     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 627     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 628     compare a b = cmpId a b
 629 \end{code}
 630
 631 %************************************************************************
 632 %*                                                                      *
 633 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
 634 %*                                                                      *
 635 %************************************************************************
 636
 637 \begin{code}
 638 instance Outputable ty => Outputable (GenId ty) where
 639     ppr id = pprId id
 640
 641 showId :: Id -> String
 642 showId id = showSDoc (pprId id)
 643 \end{code}
 644
 645 Default printing code (not used for interfaces):
 646 \begin{code}
 647 pprId :: Outputable ty => GenId ty -> SDoc
 648
 649 pprId Id {idUnique = u, idName = n, idInfo = info}
 650   = hcat [ppr n, pp_prags]
 651   where
 652     pp_prags sty
 653       | opt_PprStyle_All && not (codeStyle sty)
 654       = (case inlinePragInfo info of
 655             IMustNotBeINLINEd -> text "{n}"
 656             IWantToBeINLINEd  -> text "{i}"
 657             IMustBeINLINEd    -> text "{I}"
 658             other             -> empty) sty
 659
 660       | otherwise
 661       = empty sty
 662
 663 \end{code}
 664
 665 \begin{code}
 666 instance Uniquable (GenId ty) where
 667     uniqueOf = idUnique
 668
 669 instance NamedThing (GenId ty) where
 670     getName = idName
 671 \end{code}
 672
 673 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
 674 the @Uniques@ out of local @Ids@ given to it.
 675
 676 %************************************************************************
 677 %*                                                                      *
 678 \subsection{@IdEnv@s and @IdSet@s}
 679 %*                                                                      *
 680 %************************************************************************
 681
 682 \begin{code}
 683 type IdEnv elt = UniqFM elt
 684
 685 nullIdEnv         :: IdEnv a
 686
 687 mkIdEnv           :: [(GenId ty, a)] -> IdEnv a
 688 unitIdEnv         :: GenId ty -> a -> IdEnv a
 689 addOneToIdEnv     :: IdEnv a -> GenId ty -> a -> IdEnv a
 690 growIdEnv         :: IdEnv a -> IdEnv a -> IdEnv a
 691 growIdEnvList     :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
 692
 693 delManyFromIdEnv  :: IdEnv a -> [GenId ty] -> IdEnv a
 694 delOneFromIdEnv   :: IdEnv a -> GenId ty -> IdEnv a
 695 combineIdEnvs     :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
 696 mapIdEnv          :: (a -> b) -> IdEnv a -> IdEnv b
 697 modifyIdEnv       :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
 698 rngIdEnv          :: IdEnv a -> [a]
 699
 700 isNullIdEnv       :: IdEnv a -> Bool
 701 lookupIdEnv       :: IdEnv a -> GenId ty -> Maybe a
 702 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
 703 elemIdEnv         :: Id -> IdEnv a -> Bool
 704 \end{code}
 705
 706 \begin{code}
 707 elemIdEnv        = elemUFM
 708 addOneToIdEnv    = addToUFM
 709 combineIdEnvs    = plusUFM_C
 710 delManyFromIdEnv = delListFromUFM
 711 delOneFromIdEnv  = delFromUFM
 712 growIdEnv        = plusUFM
 713 lookupIdEnv      = lookupUFM
 714 mapIdEnv         = mapUFM
 715 mkIdEnv          = listToUFM
 716 nullIdEnv        = emptyUFM
 717 rngIdEnv         = eltsUFM
 718 unitIdEnv        = unitUFM
 719 isNullIdEnv      = isNullUFM
 720
 721 growIdEnvList     env pairs = plusUFM env (listToUFM pairs)
 722 lookupNoFailIdEnv env id    = case (lookupIdEnv env id) of { Just xx -> xx }
 723
 724 lookupIdSubst :: IdEnv Id -> Id -> Id
 725 lookupIdSubst env id = case lookupIdEnv env id of
 726                          Just id' -> id'        -- Return original if
 727                          Nothing  -> id         -- it isn't in subst
 728
 729 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
 730 -- modify function, and put it back.
 731
 732 modifyIdEnv mangle_fn env key
 733   = case (lookupIdEnv env key) of
 734       Nothing -> env
 735       Just xx -> addOneToIdEnv env key (mangle_fn xx)
 736
 737 modifyIdEnv_Directly mangle_fn env key
 738   = case (lookupUFM_Directly env key) of
 739       Nothing -> env
 740       Just xx -> addToUFM_Directly env key (mangle_fn xx)
 741 \end{code}
 742
 743 \begin{code}
 744 type GenIdSet ty = UniqSet (GenId ty)
 745 type IdSet       = UniqSet (GenId Type)
 746
 747 emptyIdSet      :: GenIdSet ty
 748 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
 749 unionIdSets     :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
 750 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
 751 idSetToList     :: GenIdSet ty -> [GenId ty]
 752 unitIdSet       :: GenId ty -> GenIdSet ty
 753 addOneToIdSet   :: GenIdSet ty -> GenId ty -> GenIdSet ty
 754 elementOfIdSet  :: GenId ty -> GenIdSet ty -> Bool
 755 minusIdSet      :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
 756 isEmptyIdSet    :: GenIdSet ty -> Bool
 757 mkIdSet         :: [GenId ty] -> GenIdSet ty
 758
 759 emptyIdSet      = emptyUniqSet
 760 unitIdSet       = unitUniqSet
 761 addOneToIdSet   = addOneToUniqSet
 762 intersectIdSets = intersectUniqSets
 763 unionIdSets     = unionUniqSets
 764 unionManyIdSets = unionManyUniqSets
 765 idSetToList     = uniqSetToList
 766 elementOfIdSet  = elementOfUniqSet
 767 minusIdSet      = minusUniqSet
 768 isEmptyIdSet    = isEmptyUniqSet
 769 mkIdSet         = mkUniqSet
 770 \end{code}