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