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(..), -- *naughtily* used in some places (e.g., TcHsSyn)
  10         Id, IdDetails,
  11         StrictnessMark(..),
  12         ConTag, fIRST_TAG,
  13         DataCon, DictFun, DictVar,
  14
  15         -- CONSTRUCTION
  16         mkDataCon,
  17         mkDefaultMethodId,
  18         mkDictFunId,
  19         mkIdWithNewUniq, mkIdWithNewName, mkIdWithNewType,
  20         mkImported,
  21         mkMethodSelId,
  22         mkRecordSelId,
  23         mkSuperDictSelId,
  24         mkSysLocal,
  25         mkTemplateLocals,
  26         mkTupleCon,
  27         mkUserId,
  28         mkUserLocal,
  29         mkPrimitiveId,
  30         mkWorkerId,
  31         setIdVisibility,
  32
  33         -- DESTRUCTION (excluding pragmatic info)
  34         idPrimRep,
  35         idType,
  36         idUnique,
  37         idName,
  38
  39         dataConRepType,
  40         dataConArgTys,
  41         dataConNumFields,
  42         dataConFieldLabels,
  43         dataConRawArgTys,
  44         dataConSig,
  45         dataConStrictMarks,
  46         dataConTag,
  47         dataConTyCon,
  48
  49         recordSelectorFieldLabel,
  50
  51         -- PREDICATES
  52         omitIfaceSigForId,
  53         cmpEqDataCon,
  54         cmpId,
  55         cmpId_withSpecDataCon,
  56         externallyVisibleId,
  57         idHasNoFreeTyVars,
  58         idWantsToBeINLINEd, getInlinePragma,
  59         idMustBeINLINEd, idMustNotBeINLINEd,
  60         isBottomingId,
  61         isDataCon, isAlgCon, isNewCon,
  62         isDefaultMethodId,
  63         isDefaultMethodId_maybe,
  64         isDictFunId,
  65         isImportedId,
  66         isRecordSelector,
  67         isMethodSelId_maybe,
  68         isNullaryDataCon,
  69         isSpecPragmaId,
  70         isSuperDictSelId_maybe,
  71         isPrimitiveId_maybe,
  72         isSysLocalId,
  73         isTupleCon,
  74         isWrapperId,
  75         toplevelishId,
  76         unfoldingUnfriendlyId,
  77
  78         -- SUBSTITUTION
  79         applyTypeEnvToId,
  80         apply_to_Id,
  81
  82         -- PRINTING and RENUMBERING
  83         pprId,
  84 --      pprIdInUnfolding,
  85         showId,
  86
  87         -- Specialialisation
  88         getIdSpecialisation,
  89         addIdSpecialisation,
  90
  91         -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
  92         addIdUnfolding,
  93         addIdArity,
  94         addIdDemandInfo,
  95         addIdStrictness,
  96         addIdUpdateInfo,
  97         getIdArity,
  98         getIdDemandInfo,
  99         getIdInfo,
 100         getIdStrictness,
 101         getIdUnfolding,
 102         getIdUpdateInfo,
 103         getPragmaInfo,
 104         replaceIdInfo, replacePragmaInfo,
 105         addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
 106
 107         -- IdEnvs AND IdSets
 108         IdEnv, GenIdSet, IdSet,
 109         addOneToIdEnv,
 110         addOneToIdSet,
 111         combineIdEnvs,
 112         delManyFromIdEnv,
 113         delOneFromIdEnv,
 114         elementOfIdSet,
 115         emptyIdSet,
 116         growIdEnv,
 117         growIdEnvList,
 118         idSetToList,
 119         intersectIdSets,
 120         isEmptyIdSet,
 121         isNullIdEnv,
 122         lookupIdEnv,
 123         lookupNoFailIdEnv,
 124         mapIdEnv,
 125         minusIdSet,
 126         mkIdEnv,
 127         mkIdSet,
 128         modifyIdEnv,
 129         modifyIdEnv_Directly,
 130         nullIdEnv,
 131         rngIdEnv,
 132         unionIdSets,
 133         unionManyIdSets,
 134         unitIdEnv,
 135         unitIdSet
 136     ) where
 137
 138 #include "HsVersions.h"
 139
 140 import {-# SOURCE #-} CoreUnfold ( Unfolding )
 141 import {-# SOURCE #-} StdIdInfo  ( addStandardIdInfo )
 142
 143 import CmdLineOpts      ( opt_PprStyle_All )
 144 import SpecEnv          ( SpecEnv   )
 145 import Bag
 146 import Class            ( Class )
 147 import BasicTypes       ( Arity )
 148 import IdInfo
 149 import Maybes           ( maybeToBool )
 150 import Name             ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
 151                           mkCompoundName,
 152                           isLocallyDefinedName, occNameString, modAndOcc,
 153                           isLocallyDefined, changeUnique, isWiredInName,
 154                           nameString, getOccString, setNameVisibility,
 155                           isExported, ExportFlag(..), Provenance,
 156                           OccName(..), Name, Module,
 157                           NamedThing(..)
 158                         )
 159 import PrimOp           ( PrimOp )
 160 import PrelMods         ( pREL_TUP, pREL_BASE )
 161 import Lex              ( mkTupNameStr )
 162 import FieldLabel       ( fieldLabelName, FieldLabel(..){-instances-} )
 163 import PragmaInfo       ( PragmaInfo(..) )
 164 import SrcLoc           ( mkBuiltinSrcLoc )
 165 import TysWiredIn       ( tupleTyCon )
 166 import TyCon            ( TyCon, tyConDataCons, isDataTyCon, isNewTyCon, mkSpecTyCon )
 167 import Type             ( mkSigmaTy, mkTyVarTys, mkFunTys, splitSigmaTy,
 168                           mkTyConApp, instantiateTy, mkForAllTys,
 169                           tyVarsOfType, instantiateTy, typePrimRep,
 170                           instantiateTauTy,
 171                           GenType, ThetaType, TauType, Type
 172                         )
 173 import TyVar            ( TyVar, alphaTyVars, isEmptyTyVarSet,
 174                           TyVarEnv, zipTyVarEnv, mkTyVarEnv
 175                         )
 176 import UniqFM
 177 import UniqSet          -- practically all of it
 178 import Unique           ( getBuiltinUniques, pprUnique, Unique, Uniquable(..) )
 179 import Outputable
 180 import SrcLoc           ( SrcLoc )
 181 import Util             ( mapAccumL, nOfThem, zipEqual, assoc )
 182 import GlaExts          ( Int# )
 183 \end{code}
 184
 185 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
 186 follow.
 187
 188 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
 189 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
 190 strictness).  The essential info about different kinds of @Ids@ is
 191 in its @IdDetails@.
 192
 193 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
 194
 195 \begin{code}
 196 data GenId ty = Id
 197         Unique          -- Key for fast comparison
 198         Name
 199         ty              -- Id's type; used all the time;
 200         IdDetails       -- Stuff about individual kinds of Ids.
 201         PragmaInfo      -- Properties of this Id requested by programmer
 202                         -- eg specialise-me, inline-me
 203         IdInfo          -- Properties of this Id deduced by compiler
 204
 205 type Id            = GenId Type
 206
 207 data StrictnessMark = MarkedStrict | NotMarkedStrict
 208
 209 data IdDetails
 210
 211   ---------------- Local values
 212
 213   = LocalId     Bool            -- Local name; mentioned by the user
 214                                 -- True <=> no free type vars
 215
 216   | SysLocalId  Bool            -- Local name; made up by the compiler
 217                                 -- as for LocalId
 218
 219   | PrimitiveId PrimOp          -- The Id for a primitive operation
 220
 221   | SpecPragmaId                -- Local name; introduced by the compiler
 222                  (Maybe Id)     -- for explicit specid in pragma
 223                  Bool           -- as for LocalId
 224
 225   ---------------- Global values
 226
 227   | ImportedId                  -- Global name (Imported or Implicit); Id imported from an interface
 228
 229   ---------------- Data constructors
 230
 231   | AlgConId                    -- Used for both data and newtype constructors.
 232                                 -- You can tell the difference by looking at the TyCon
 233                 ConTag
 234                 [StrictnessMark] -- Strict args; length = arity
 235                 [FieldLabel]    -- Field labels for this constructor;
 236                                 --length = 0 (not a record) or arity
 237
 238                 [TyVar] ThetaType       -- Type vars and context for the data type decl
 239                 [TyVar] ThetaType       -- Ditto for the context of the constructor,
 240                                         -- the existentially quantified stuff
 241                 [Type] TyCon            -- Args and result tycon
 242                                 -- the type is:
 243                                 -- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
 244                                 --    unitype_1 -> ... -> unitype_n -> tycon tyvars
 245
 246   | TupleConId  Int             -- Its arity
 247
 248   | RecordSelId FieldLabel
 249
 250   ---------------- Things to do with overloading
 251
 252   | SuperDictSelId              -- Selector for superclass dictionary
 253                 Class           -- The class (input dict)
 254                 Class           -- The superclass (result dict)
 255
 256   | MethodSelId Class           -- An overloaded class operation, with
 257                                 -- a fully polymorphic type.  Its code
 258                                 -- just selects a method from the
 259                                 -- dictionary.
 260
 261         -- NB: The IdInfo for a MethodSelId has all the info about its
 262         -- related "constant method Ids", which are just
 263         -- specialisations of this general one.
 264
 265   | DefaultMethodId             -- Default method for a particular class op
 266                 Class           -- same class, <blah-blah> info as MethodSelId
 267
 268                                 -- see below
 269   | DictFunId   Class           -- A DictFun is uniquely identified
 270                 [Type]          -- by its class and type; this type has free type vars,
 271                                 -- whose identity is irrelevant.  Eg Class = Eq
 272                                 --                                   Type  = Tree a
 273                                 -- The "a" is irrelevant.  As it is too painful to
 274                                 -- actually do comparisons that way, we kindly supply
 275                                 -- a Unique for that purpose.
 276
 277   | SpecId                      -- A specialisation of another Id
 278                 Id              -- Id of which this is a specialisation
 279                 [Maybe Type]    -- Types at which it is specialised;
 280                                 -- A "Nothing" says this type ain't relevant.
 281                 Bool            -- True <=> no free type vars; it's not enough
 282                                 -- to know about the unspec version, because
 283                                 -- we may specialise to a type w/ free tyvars
 284                                 -- (i.e., in one of the "Maybe Type" dudes).
 285
 286 type ConTag     = Int
 287 type DictVar    = Id
 288 type DictFun    = Id
 289 type DataCon    = Id
 290 \end{code}
 291
 292 DictFunIds are generated from instance decls.
 293 \begin{verbatim}
 294         class Foo a where
 295           op :: a -> a -> Bool
 296
 297         instance Foo a => Foo [a] where
 298           op = ...
 299 \end{verbatim}
 300 generates the dict fun id decl
 301 \begin{verbatim}
 302         dfun.Foo.[*] = \d -> ...
 303 \end{verbatim}
 304 The dfun id is uniquely named by the (class, type) pair.  Notice, it
 305 isn't a (class,tycon) pair any more, because we may get manually or
 306 automatically generated specialisations of the instance decl:
 307 \begin{verbatim}
 308         instance Foo [Int] where
 309           op = ...
 310 \end{verbatim}
 311 generates
 312 \begin{verbatim}
 313         dfun.Foo.[Int] = ...
 314 \end{verbatim}
 315 The type variables in the name are irrelevant; we print them as stars.
 316
 317
 318 Constant method ids are generated from instance decls where
 319 there is no context; that is, no dictionaries are needed to
 320 construct the method.  Example
 321 \begin{verbatim}
 322         instance Foo Int where
 323           op = ...
 324 \end{verbatim}
 325 Then we get a constant method
 326 \begin{verbatim}
 327         Foo.op.Int = ...
 328 \end{verbatim}
 329
 330 It is possible, albeit unusual, to have a constant method
 331 for an instance decl which has type vars:
 332 \begin{verbatim}
 333         instance Foo [a] where
 334           op []     ys = True
 335           op (x:xs) ys = False
 336 \end{verbatim}
 337 We get the constant method
 338 \begin{verbatim}
 339         Foo.op.[*] = ...
 340 \end{verbatim}
 341 So a constant method is identified by a class/op/type triple.
 342 The type variables in the type are irrelevant.
 343
 344
 345 For Ids whose names must be known/deducible in other modules, we have
 346 to conjure up their worker's names (and their worker's worker's
 347 names... etc) in a known systematic way.
 348
 349
 350 %************************************************************************
 351 %*                                                                      *
 352 \subsection[Id-documentation]{Documentation}
 353 %*                                                                      *
 354 %************************************************************************
 355
 356 [A BIT DATED [WDP]]
 357
 358 The @Id@ datatype describes {\em values}.  The basic things we want to
 359 know: (1)~a value's {\em type} (@idType@ is a very common
 360 operation in the compiler); and (2)~what ``flavour'' of value it might
 361 be---for example, it can be terribly useful to know that a value is a
 362 class method.
 363
 364 \begin{description}
 365 %----------------------------------------------------------------------
 366 \item[@AlgConId@:] For the data constructors declared by a @data@
 367 declaration.  Their type is kept in {\em two} forms---as a regular
 368 @Type@ (in the usual place), and also in its constituent pieces (in
 369 the ``details''). We are frequently interested in those pieces.
 370
 371 %----------------------------------------------------------------------
 372 \item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
 373 the infinite family of tuples.
 374
 375 %----------------------------------------------------------------------
 376 \item[@ImportedId@:] These are values defined outside this module.
 377 {\em Everything} we want to know about them must be stored here (or in
 378 their @IdInfo@).
 379
 380 %----------------------------------------------------------------------
 381 \item[@MethodSelId@:] A selector from a dictionary; it may select either
 382 a method or a dictionary for one of the class's superclasses.
 383
 384 %----------------------------------------------------------------------
 385 \item[@DictFunId@:]
 386
 387 @mkDictFunId [a,b..] theta C T@ is the function derived from the
 388 instance declaration
 389
 390         instance theta => C (T a b ..) where
 391                 ...
 392
 393 It builds function @Id@ which maps dictionaries for theta,
 394 to a dictionary for C (T a b ..).
 395
 396 *Note* that with the ``Mark Jones optimisation'', the theta may
 397 include dictionaries for the immediate superclasses of C at the type
 398 (T a b ..).
 399
 400 %----------------------------------------------------------------------
 401 \item[@SpecId@:]
 402
 403 %----------------------------------------------------------------------
 404 \item[@LocalId@:] A purely-local value, e.g., a function argument,
 405 something defined in a @where@ clauses, ... --- but which appears in
 406 the original program text.
 407
 408 %----------------------------------------------------------------------
 409 \item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
 410 the original program text; these are introduced by the compiler in
 411 doing its thing.
 412
 413 %----------------------------------------------------------------------
 414 \item[@SpecPragmaId@:] Introduced by the compiler to record
 415 Specialisation pragmas. It is dead code which MUST NOT be removed
 416 before specialisation.
 417 \end{description}
 418
 419 Further remarks:
 420 \begin{enumerate}
 421 %----------------------------------------------------------------------
 422 \item
 423
 424 @DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
 425 @MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
 426 properties:
 427 \begin{itemize}
 428 \item
 429 They have no free type variables, so if you are making a
 430 type-variable substitution you don't need to look inside them.
 431 \item
 432 They are constants, so they are not free variables.  (When the STG
 433 machine makes a closure, it puts all the free variables in the
 434 closure; the above are not required.)
 435 \end{itemize}
 436 Note that @Locals@ and @SysLocals@ {\em may} have the above
 437 properties, but they may not.
 438 \end{enumerate}
 439
 440 %************************************************************************
 441 %*                                                                      *
 442 \subsection[Id-general-funs]{General @Id@-related functions}
 443 %*                                                                      *
 444 %************************************************************************
 445
 446 \begin{code}
 447 -- isDataCon returns False for @newtype@ constructors
 448 isDataCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isDataTyCon tc
 449 isDataCon (Id _ _ _ (TupleConId _) _ _)                 = True
 450 isDataCon (Id _ _ _ (SpecId unspec _ _) _ _)            = isDataCon unspec
 451 isDataCon other                                         = False
 452
 453 isNewCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isNewTyCon tc
 454 isNewCon other                                         = False
 455
 456 -- isAlgCon returns True for @data@ or @newtype@ constructors
 457 isAlgCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ _) _ _) = True
 458 isAlgCon (Id _ _ _ (TupleConId _) _ _)                = True
 459 isAlgCon (Id _ _ _ (SpecId unspec _ _) _ _)           = isAlgCon unspec
 460 isAlgCon other                                        = False
 461
 462 isTupleCon (Id _ _ _ (TupleConId _) _ _)         = True
 463 isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _)    = isTupleCon unspec
 464 isTupleCon other                                 = False
 465 \end{code}
 466
 467 @toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
 468 @let(rec)@ (returns @False@), or whether it is {\em sure} to be
 469 defined at top level (returns @True@). This is used to decide whether
 470 the @Id@ is a candidate free variable. NB: you are only {\em sure}
 471 about something if it returns @True@!
 472
 473 \begin{code}
 474 toplevelishId     :: Id -> Bool
 475 idHasNoFreeTyVars :: Id -> Bool
 476
 477 toplevelishId (Id _ _ _ details _ _)
 478   = chk details
 479   where
 480     chk (AlgConId _ __ _ _ _ _ _ _)   = True
 481     chk (TupleConId _)              = True
 482     chk (RecordSelId _)             = True
 483     chk ImportedId                  = True
 484     chk (SuperDictSelId _ _)        = True
 485     chk (MethodSelId _)             = True
 486     chk (DefaultMethodId _)         = True
 487     chk (DictFunId     _ _)         = True
 488     chk (SpecId unspec _ _)         = toplevelishId unspec
 489                                     -- depends what the unspecialised thing is
 490     chk (LocalId      _)            = False
 491     chk (SysLocalId   _)            = False
 492     chk (SpecPragmaId _ _)          = False
 493     chk (PrimitiveId _)             = True
 494
 495 idHasNoFreeTyVars (Id _ _ _ details _ info)
 496   = chk details
 497   where
 498     chk (AlgConId _ _ _ _ _ _ _ _ _) = True
 499     chk (TupleConId _)            = True
 500     chk (RecordSelId _)           = True
 501     chk ImportedId                = True
 502     chk (SuperDictSelId _ _)      = True
 503     chk (MethodSelId _)           = True
 504     chk (DefaultMethodId _)       = True
 505     chk (DictFunId     _ _)       = True
 506     chk (SpecId _     _   no_free_tvs) = no_free_tvs
 507     chk (LocalId        no_free_tvs) = no_free_tvs
 508     chk (SysLocalId     no_free_tvs) = no_free_tvs
 509     chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
 510     chk (PrimitiveId _)             = True
 511
 512 -- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
 513 -- so we don't need to put its signature in an interface file, even if it's mentioned
 514 -- in some other interface unfolding.
 515
 516 omitIfaceSigForId
 517         :: Id
 518         -> Bool
 519
 520 omitIfaceSigForId (Id _ name _ details _ _)
 521   | isWiredInName name
 522   = True
 523
 524   | otherwise
 525   = case details of
 526         ImportedId        -> True               -- Never put imports in interface file
 527         (PrimitiveId _)   -> True               -- Ditto, for primitives
 528
 529         -- This group is Ids that are implied by their type or class decl;
 530         -- remember that all type and class decls appear in the interface file.
 531         -- The dfun id must *not* be omitted, because it carries version info for
 532         -- the instance decl
 533         (AlgConId _ _ _ _ _ _ _ _ _) -> True
 534         (TupleConId _)            -> True
 535         (RecordSelId _)           -> True
 536         (SuperDictSelId _ _)      -> True
 537         (MethodSelId _)           -> True
 538
 539         other                     -> False      -- Don't omit!
 540                 -- NB DefaultMethodIds are not omitted
 541 \end{code}
 542
 543 \begin{code}
 544 isImportedId (Id _ _ _ ImportedId _ _) = True
 545 isImportedId other                     = False
 546
 547 isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
 548
 549 isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
 550 isSysLocalId other                         = False
 551
 552 isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
 553 isSpecPragmaId other                             = False
 554
 555 isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
 556   = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
 557     Just (unspec, ty_maybes)
 558 isSpecId_maybe other_id
 559   = Nothing
 560
 561 isMethodSelId_maybe (Id _ _ _ (MethodSelId cls) _ _) = Just cls
 562 isMethodSelId_maybe _                                = Nothing
 563
 564 isDefaultMethodId (Id _ _ _ (DefaultMethodId _) _ _) = True
 565 isDefaultMethodId other                              = False
 566
 567 isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls) _ _)
 568   = Just cls
 569 isDefaultMethodId_maybe other = Nothing
 570
 571 isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
 572 isDictFunId other                          = False
 573
 574 isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
 575 isSuperDictSelId_maybe other_id                           = Nothing
 576
 577 isWrapperId id = workerExists (getIdStrictness id)
 578
 579 isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
 580 isPrimitiveId_maybe other                               = Nothing
 581 \end{code}
 582
 583 \begin{code}
 584 unfoldingUnfriendlyId   -- return True iff it is definitely a bad
 585         :: Id           -- idea to export an unfolding that
 586         -> Bool         -- mentions this Id.  Reason: it cannot
 587                         -- possibly be seen in another module.
 588
 589 unfoldingUnfriendlyId id = not (externallyVisibleId id)
 590 \end{code}
 591
 592 @externallyVisibleId@: is it true that another module might be
 593 able to ``see'' this Id in a code generation sense. That
 594 is, another .o file might refer to this Id.
 595
 596 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
 597 local-ness precisely so that the test here would be easy
 598
 599 \begin{code}
 600 externallyVisibleId :: Id -> Bool
 601 externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
 602                      -- not local => global => externally visible
 603 \end{code}
 604
 605 CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
 606 `Top-levelish Ids'' cannot have any free type variables, so applying
 607 the type-env cannot have any effect.  (NB: checked in CoreLint?)
 608
 609 \begin{code}
 610 type TypeEnv = TyVarEnv Type
 611
 612 applyTypeEnvToId :: TypeEnv -> Id -> Id
 613 applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
 614   = apply_to_Id ( \ ty ->
 615         instantiateTy type_env ty
 616     ) id
 617 \end{code}
 618
 619 \begin{code}
 620 apply_to_Id :: (Type -> Type) -> Id -> Id
 621
 622 apply_to_Id ty_fn id@(Id u n ty details prag info)
 623   | idHasNoFreeTyVars id
 624   = id
 625   | otherwise
 626   = Id u n (ty_fn ty) (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
 627   where
 628     apply_to_details (SpecId unspec ty_maybes no_ftvs)
 629       = let
 630             new_unspec = apply_to_Id ty_fn unspec
 631             new_maybes = map apply_to_maybe ty_maybes
 632         in
 633         SpecId new_unspec new_maybes (no_free_tvs ty)
 634         -- ToDo: gratuitous recalc no_ftvs????
 635       where
 636         apply_to_maybe Nothing   = Nothing
 637         apply_to_maybe (Just ty) = Just (ty_fn ty)
 638
 639     apply_to_details other = other
 640 \end{code}
 641
 642
 643 %************************************************************************
 644 %*                                                                      *
 645 \subsection[Id-type-funs]{Type-related @Id@ functions}
 646 %*                                                                      *
 647 %************************************************************************
 648
 649 \begin{code}
 650 idName :: GenId ty -> Name
 651 idName (Id _ n _ _ _ _) = n
 652
 653 idType :: GenId ty -> ty
 654 idType (Id _ _ ty _ _ _) = ty
 655
 656 idPrimRep i = typePrimRep (idType i)
 657 \end{code}
 658
 659 %************************************************************************
 660 %*                                                                      *
 661 \subsection[Id-overloading]{Functions related to overloading}
 662 %*                                                                      *
 663 %************************************************************************
 664
 665 \begin{code}
 666 mkSuperDictSelId u clas sc ty
 667   = addStandardIdInfo $
 668     Id u name ty details NoPragmaInfo noIdInfo
 669   where
 670     name    = mkCompoundName name_fn u (getName clas)
 671     details = SuperDictSelId clas sc
 672     name_fn clas_str = SLIT("scsel_") _APPEND_ clas_str _APPEND_ mod _APPEND_ occNameString occ
 673     (mod,occ) = modAndOcc sc
 674
 675         -- For method selectors the clean thing to do is
 676         -- to give the method selector the same name as the class op itself.
 677 mkMethodSelId op_name rec_c ty
 678   = addStandardIdInfo $
 679     Id (uniqueOf op_name) op_name ty (MethodSelId rec_c) NoPragmaInfo noIdInfo
 680
 681 mkDefaultMethodId dm_name rec_c ty
 682   = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c) NoPragmaInfo noIdInfo
 683
 684 mkDictFunId dfun_name full_ty clas itys
 685   = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
 686   where
 687     details  = DictFunId clas itys
 688
 689 mkWorkerId u unwrkr ty info
 690   = Id u name ty details NoPragmaInfo info
 691   where
 692     details = LocalId (no_free_tvs ty)
 693     name    = mkCompoundName name_fn u (getName unwrkr)
 694     name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
 695 \end{code}
 696
 697 %************************************************************************
 698 %*                                                                      *
 699 \subsection[local-funs]{@LocalId@-related functions}
 700 %*                                                                      *
 701 %************************************************************************
 702
 703 \begin{code}
 704 mkImported  n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
 705
 706 mkPrimitiveId n ty primop
 707   = addStandardIdInfo $
 708     Id (nameUnique n) n ty (PrimitiveId primop) IMustBeINLINEd noIdInfo
 709         -- The pragma @IMustBeINLINEd@ says that this Id absolutely must be inlined.
 710         -- It's only true for primitives, because we don't want to make a closure for each of them.
 711
 712 \end{code}
 713
 714 \begin{code}
 715 no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
 716
 717 -- SysLocal: for an Id being created by the compiler out of thin air...
 718 -- UserLocal: an Id with a name the user might recognize...
 719 mkSysLocal  :: FAST_STRING -> Unique -> GenType flexi -> SrcLoc -> GenId (GenType flexi)
 720 mkUserLocal :: OccName     -> Unique -> GenType flexi -> SrcLoc -> GenId (GenType flexi)
 721
 722 mkSysLocal str uniq ty loc
 723   = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
 724
 725 mkUserLocal occ uniq ty loc
 726   = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
 727
 728 mkUserId :: Name -> GenType flexi -> PragmaInfo -> GenId (GenType flexi)
 729 mkUserId name ty pragma_info
 730   = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
 731 \end{code}
 732
 733 \begin{code}
 734 -- See notes with setNameVisibility (Name.lhs)
 735 setIdVisibility :: Maybe Module -> Unique -> Id -> Id
 736 setIdVisibility maybe_mod u (Id uniq name ty details prag info)
 737   = Id uniq (setNameVisibility maybe_mod u name) ty details prag info
 738
 739 mkIdWithNewUniq :: Id -> Unique -> Id
 740 mkIdWithNewUniq (Id _ n ty details prag info) u
 741   = Id u (changeUnique n u) ty details prag info
 742
 743 mkIdWithNewName :: Id -> Name -> Id
 744 mkIdWithNewName (Id _ _ ty details prag info) new_name
 745   = Id (uniqueOf new_name) new_name ty details prag info
 746
 747 mkIdWithNewType :: Id -> Type -> Id
 748 mkIdWithNewType (Id u name _ details pragma info) ty
 749   = Id u name ty details pragma info
 750
 751 {-
 752 -- Specialised version of constructor: only used in STG and code generation
 753 -- Note: The specialsied Id has the same unique as the unspeced Id
 754
 755 mkSameSpecCon ty_maybes unspec@(Id u name ty details pragma info)
 756   = ASSERT(isDataCon unspec)
 757     ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
 758     Id u name new_ty (SpecId unspec ty_maybes (no_free_tvs new_ty)) pragma info
 759   where
 760     new_ty = specialiseTy ty ty_maybes 0
 761
 762     -- pprTrace "SameSpecCon:Unique:"
 763     --          (ppSep (ppr unspec: [pprMaybeTy ty | ty <- ty_maybes]))
 764 -}
 765 \end{code}
 766
 767 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 768 @Uniques@, but that's OK because the templates are supposed to be
 769 instantiated before use.
 770 \begin{code}
 771 mkTemplateLocals :: [Type] -> [Id]
 772 mkTemplateLocals tys
 773   = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
 774             (getBuiltinUniques (length tys))
 775             tys
 776 \end{code}
 777
 778 \begin{code}
 779 getIdInfo     :: GenId ty -> IdInfo
 780 getPragmaInfo :: GenId ty -> PragmaInfo
 781
 782 getIdInfo     (Id _ _ _ _ _ info) = info
 783 getPragmaInfo (Id _ _ _ _ info _) = info
 784
 785 replaceIdInfo :: Id -> IdInfo -> Id
 786 replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
 787
 788 replacePragmaInfo :: GenId ty -> PragmaInfo -> GenId ty
 789 replacePragmaInfo (Id u sn ty details _ info) prag = Id u sn ty details prag info
 790 \end{code}
 791
 792 %************************************************************************
 793 %*                                                                      *
 794 \subsection[Id-arities]{Arity-related functions}
 795 %*                                                                      *
 796 %************************************************************************
 797
 798 For locally-defined Ids, the code generator maintains its own notion
 799 of their arities; so it should not be asking...  (but other things
 800 besides the code-generator need arity info!)
 801
 802 \begin{code}
 803 getIdArity :: Id -> ArityInfo
 804 getIdArity id@(Id _ _ _ _ _ id_info)
 805   = arityInfo id_info
 806
 807 addIdArity :: Id -> ArityInfo -> Id
 808 addIdArity (Id u n ty details pinfo info) arity
 809   = Id u n ty details pinfo (info `addArityInfo` arity)
 810 \end{code}
 811
 812 %************************************************************************
 813 %*                                                                      *
 814 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
 815 %*                                                                      *
 816 %************************************************************************
 817
 818 \begin{code}
 819 mkDataCon :: Name
 820           -> [StrictnessMark] -> [FieldLabel]
 821           -> [TyVar] -> ThetaType
 822           -> [TyVar] -> ThetaType
 823           -> [TauType] -> TyCon
 824           -> Id
 825   -- can get the tag and all the pieces of the type from the Type
 826
 827 mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
 828   = ASSERT(length stricts == length args_tys)
 829     addStandardIdInfo data_con
 830   where
 831     -- NB: data_con self-recursion; should be OK as tags are not
 832     -- looked at until late in the game.
 833     data_con
 834       = Id (nameUnique n)
 835            n
 836            data_con_ty
 837            (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
 838            IWantToBeINLINEd     -- Always inline constructors if possible
 839            noIdInfo
 840
 841     data_con_tag    = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
 842     data_con_family = tyConDataCons tycon
 843
 844     data_con_ty
 845       = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
 846         (mkFunTys args_tys (mkTyConApp tycon (mkTyVarTys tvs)))
 847
 848
 849 mkTupleCon :: Arity -> Name -> Type -> Id
 850 mkTupleCon arity name ty
 851   = addStandardIdInfo tuple_id
 852   where
 853     tuple_id = Id (nameUnique name) name ty
 854                   (TupleConId arity)
 855                   IWantToBeINLINEd              -- Always inline constructors if possible
 856                   noIdInfo
 857
 858 fIRST_TAG :: ConTag
 859 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 860 \end{code}
 861
 862 dataConNumFields gives the number of actual fields in the
 863 {\em representation} of the data constructor.  This may be more than appear
 864 in the source code; the extra ones are the existentially quantified
 865 dictionaries
 866
 867 \begin{code}
 868 dataConNumFields id
 869   = ASSERT( if (isDataCon id) then True else
 870             pprTrace "dataConNumFields" (ppr id) False )
 871     case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
 872     length con_theta + length arg_tys }
 873
 874 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
 875
 876 \end{code}
 877
 878
 879 \begin{code}
 880 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
 881 dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
 882 dataConTag (Id _ _ _ (TupleConId _) _ _)              = fIRST_TAG
 883 dataConTag (Id _ _ _ (SpecId unspec _ _) _ _)         = dataConTag unspec
 884
 885 dataConTyCon :: DataCon -> TyCon        -- will panic if not a DataCon
 886 dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
 887 dataConTyCon (Id _ _ _ (TupleConId a) _ _)                = tupleTyCon a
 888
 889 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
 890                                         -- will panic if not a DataCon
 891
 892 dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
 893   = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
 894
 895 dataConSig (Id _ _ _ (TupleConId arity) _ _)
 896   = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
 897   where
 898     tyvars      = take arity alphaTyVars
 899     tyvar_tys   = mkTyVarTys tyvars
 900
 901 dataConSig (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
 902   = (spec_tyvars, spec_theta_ty, spec_con_tyvars, spec_con_theta, spec_arg_tys, spec_tycon)
 903   where
 904     (tyvars, theta_ty, con_tyvars, con_theta, arg_tys, tycon) = dataConSig unspec
 905
 906     ty_env = tyvars `zip` ty_maybes
 907
 908     spec_tyvars     = [tyvar | (tyvar, Nothing) <- ty_env]
 909     spec_con_tyvars = [tyvar | (tyvar, Nothing) <- con_tyvars `zip` ty_maybes] -- Hmm..
 910
 911     spec_env = mkTyVarEnv [(tyvar, ty) | (tyvar, Just ty) <- ty_env]
 912     spec_arg_tys = map (instantiateTauTy spec_env) arg_tys
 913
 914     spec_theta_ty  = if null theta_ty then []
 915                      else panic "dataConSig:ThetaTy:SpecDataCon1"
 916     spec_con_theta = if null con_theta then []
 917                      else panic "dataConSig:ThetaTy:SpecDataCon2"
 918     spec_tycon     = mkSpecTyCon tycon ty_maybes
 919
 920
 921 -- dataConRepType returns the type of the representation of a contructor
 922 -- This may differ from the type of the contructor Id itself for two reasons:
 923 --      a) the constructor Id may be overloaded, but the dictionary isn't stored
 924 --         e.g.    data Eq a => T a = MkT a a
 925 --
 926 --      b) the constructor may store an unboxed version of a strict field.
 927 --
 928 -- Here's an example illustrating both:
 929 --      data Ord a => T a = MkT Int! a
 930 -- Here
 931 --      T :: Ord a => Int -> a -> T a
 932 -- but the rep type is
 933 --      Trep :: Int# -> a -> T a
 934 -- Actually, the unboxed part isn't implemented yet!
 935
 936 dataConRepType :: Id -> Type
 937 dataConRepType (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
 938   = mkForAllTys (tyvars++con_tyvars)
 939                 (mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
 940 dataConRepType other_id
 941   = ASSERT( isDataCon other_id )
 942     idType other_id
 943
 944 dataConFieldLabels :: DataCon -> [FieldLabel]
 945 dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
 946 dataConFieldLabels (Id _ _ _ (TupleConId _)                 _ _) = []
 947 #ifdef DEBUG
 948 dataConFieldLabels x@(Id _ _ _ idt _ _) =
 949   panic ("dataConFieldLabel: " ++
 950     (case idt of
 951       LocalId _    -> "l"
 952       SysLocalId _ -> "sl"
 953       PrimitiveId _ -> "p"
 954       SpecPragmaId _  _ -> "sp"
 955       ImportedId -> "i"
 956       RecordSelId _ -> "r"
 957       SuperDictSelId _ _ -> "sc"
 958       MethodSelId _ -> "m"
 959       DefaultMethodId _ -> "d"
 960       DictFunId _ _ -> "di"
 961       SpecId _ _ _ -> "spec"))
 962 #endif
 963
 964 dataConStrictMarks :: DataCon -> [StrictnessMark]
 965 dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
 966 dataConStrictMarks (Id _ _ _ (TupleConId arity)              _ _)
 967   = nOfThem arity NotMarkedStrict
 968
 969 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
 970 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
 971
 972 dataConArgTys :: DataCon
 973               -> [Type]         -- Instantiated at these types
 974               -> [Type]         -- Needs arguments of these types
 975 dataConArgTys con_id inst_tys
 976  = map (instantiateTy tenv) arg_tys
 977  where
 978     (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
 979     tenv                          = zipTyVarEnv tyvars inst_tys
 980 \end{code}
 981
 982 \begin{code}
 983 mkRecordSelId field_label selector_ty
 984   = addStandardIdInfo $         -- Record selectors have a standard unfolding
 985     Id (nameUnique name)
 986        name
 987        selector_ty
 988        (RecordSelId field_label)
 989        NoPragmaInfo
 990        noIdInfo
 991   where
 992     name = fieldLabelName field_label
 993
 994 recordSelectorFieldLabel :: Id -> FieldLabel
 995 recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
 996
 997 isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
 998 isRecordSelector other                            = False
 999 \end{code}
1000
1001
1002 Data type declarations are of the form:
1003 \begin{verbatim}
1004 data Foo a b = C1 ... | C2 ... | ... | Cn ...
1005 \end{verbatim}
1006 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
1007 @C1 x y z@, we want a function binding:
1008 \begin{verbatim}
1009 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1010 \end{verbatim}
1011 Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1012 2nd-order polymorphic lambda calculus with explicit types.
1013
1014 %************************************************************************
1015 %*                                                                      *
1016 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1017 %*                                                                      *
1018 %************************************************************************
1019
1020 \begin{code}
1021 getIdUnfolding :: Id -> Unfolding
1022
1023 getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1024
1025 addIdUnfolding :: Id -> Unfolding -> Id
1026 addIdUnfolding id@(Id u n ty details prag info) unfolding
1027   = Id u n ty details prag (info `addUnfoldInfo` unfolding)
1028 \end{code}
1029
1030 The inline pragma tells us to be very keen to inline this Id, but it's still
1031 OK not to if optimisation is switched off.
1032
1033 \begin{code}
1034 getInlinePragma :: Id -> PragmaInfo
1035 getInlinePragma (Id _ _ _ _ prag _) = prag
1036
1037 idWantsToBeINLINEd :: Id -> Bool
1038
1039 idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
1040 idWantsToBeINLINEd (Id _ _ _ _ IMustBeINLINEd   _) = True
1041 idWantsToBeINLINEd _                               = False
1042
1043 idMustNotBeINLINEd (Id _ _ _ _ IMustNotBeINLINEd _) = True
1044 idMustNotBeINLINEd _                                = False
1045
1046 idMustBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1047 idMustBeINLINEd _                             = False
1048
1049 addInlinePragma :: Id -> Id
1050 addInlinePragma (Id u sn ty details _ info)
1051   = Id u sn ty details IWantToBeINLINEd info
1052
1053 nukeNoInlinePragma :: Id -> Id
1054 nukeNoInlinePragma id@(Id u sn ty details IMustNotBeINLINEd info)
1055   = Id u sn ty details NoPragmaInfo info
1056 nukeNoInlinePragma id@(Id u sn ty details _ info) = id          -- Otherwise no-op
1057
1058 addNoInlinePragma :: Id -> Id
1059 addNoInlinePragma id@(Id u sn ty details _ info)
1060   = Id u sn ty details IMustNotBeINLINEd info
1061 \end{code}
1062
1063
1064
1065 %************************************************************************
1066 %*                                                                      *
1067 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1068 %*                                                                      *
1069 %************************************************************************
1070
1071 \begin{code}
1072 getIdDemandInfo :: Id -> DemandInfo
1073 getIdDemandInfo (Id _ _ _ _ _ info) = demandInfo info
1074
1075 addIdDemandInfo :: Id -> DemandInfo -> Id
1076 addIdDemandInfo (Id u n ty details prags info) demand_info
1077   = Id u n ty details prags (info `addDemandInfo` demand_info)
1078 \end{code}
1079
1080 \begin{code}
1081 getIdUpdateInfo :: Id -> UpdateInfo
1082 getIdUpdateInfo (Id _ _ _ _ _ info) = updateInfo info
1083
1084 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1085 addIdUpdateInfo (Id u n ty details prags info) upd_info
1086   = Id u n ty details prags (info `addUpdateInfo` upd_info)
1087 \end{code}
1088
1089 \begin{code}
1090 {- LATER:
1091 getIdArgUsageInfo :: Id -> ArgUsageInfo
1092 getIdArgUsageInfo (Id u n ty info details) = argUsageInfo info
1093
1094 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1095 addIdArgUsageInfo (Id u n ty info details) au_info
1096   = Id u n ty (info `addArgusageInfo` au_info) details
1097 -}
1098 \end{code}
1099
1100 \begin{code}
1101 {- LATER:
1102 getIdFBTypeInfo :: Id -> FBTypeInfo
1103 getIdFBTypeInfo (Id u n ty info details) = fbTypeInfo info
1104
1105 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1106 addIdFBTypeInfo (Id u n ty info details) upd_info
1107   = Id u n ty (info `addFBTypeInfo` upd_info) details
1108 -}
1109 \end{code}
1110
1111 \begin{code}
1112 getIdSpecialisation :: Id -> IdSpecEnv
1113 getIdSpecialisation (Id _ _ _ _ _ info) = specInfo info
1114
1115 addIdSpecialisation :: Id -> IdSpecEnv -> Id
1116 addIdSpecialisation (Id u n ty details prags info) spec_info
1117   = Id u n ty details prags (info `addSpecInfo` spec_info)
1118 \end{code}
1119
1120 Strictness: we snaffle the info out of the IdInfo.
1121
1122 \begin{code}
1123 getIdStrictness :: Id -> StrictnessInfo
1124
1125 getIdStrictness (Id _ _ _ _ _ info) = strictnessInfo info
1126
1127 addIdStrictness :: Id -> StrictnessInfo -> Id
1128 addIdStrictness (Id u n ty details prags info) strict_info
1129   = Id u n ty details prags (info `addStrictnessInfo` strict_info)
1130 \end{code}
1131
1132 %************************************************************************
1133 %*                                                                      *
1134 \subsection[Id-comparison]{Comparison functions for @Id@s}
1135 %*                                                                      *
1136 %************************************************************************
1137
1138 Comparison: equality and ordering---this stuff gets {\em hammered}.
1139
1140 \begin{code}
1141 cmpId (Id u1 _ _ _ _ _) (Id u2 _ _ _ _ _) = compare u1 u2
1142 -- short and very sweet
1143 \end{code}
1144
1145 \begin{code}
1146 instance Eq (GenId ty) where
1147     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
1148     a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
1149
1150 instance Ord (GenId ty) where
1151     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
1152     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
1153     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
1154     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
1155     compare a b = cmpId a b
1156 \end{code}
1157
1158 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1159 account when comparing two data constructors. We need to do this
1160 because a specialised data constructor has the same Unique as its
1161 unspecialised counterpart.
1162
1163 \begin{code}
1164 cmpId_withSpecDataCon :: Id -> Id -> Ordering
1165
1166 cmpId_withSpecDataCon id1 id2
1167   | eq_ids && isDataCon id1 && isDataCon id2
1168   = cmpEqDataCon id1 id2
1169
1170   | otherwise
1171   = cmp_ids
1172   where
1173     cmp_ids = cmpId id1 id2
1174     eq_ids  = case cmp_ids of { EQ -> True; other -> False }
1175
1176 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _) _ _) (Id _ _ _ (SpecId _ mtys2 _) _ _)
1177   = panic "Id.cmpEqDataCon:cmpUniTypeMaybeList mtys1 mtys2"
1178
1179 cmpEqDataCon _ (Id _ _ _ (SpecId _ _ _) _ _) = LT
1180 cmpEqDataCon (Id _ _ _ (SpecId _ _ _) _ _) _ = GT
1181 cmpEqDataCon _                             _ = EQ
1182 \end{code}
1183
1184 %************************************************************************
1185 %*                                                                      *
1186 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1187 %*                                                                      *
1188 %************************************************************************
1189
1190 \begin{code}
1191 instance Outputable ty => Outputable (GenId ty) where
1192     ppr id = pprId id
1193
1194 showId :: Id -> String
1195 showId id = showSDoc (pprId id)
1196 \end{code}
1197
1198 Default printing code (not used for interfaces):
1199 \begin{code}
1200 pprId :: Outputable ty => GenId ty -> SDoc
1201
1202 pprId (Id u n _ _ prags _)
1203   = hcat [ppr n, pp_prags]
1204   where
1205     pp_prags | opt_PprStyle_All = case prags of
1206                                      IMustNotBeINLINEd -> text "{n}"
1207                                      IWantToBeINLINEd  -> text "{i}"
1208                                      IMustBeINLINEd    -> text "{I}"
1209                                      other             -> empty
1210              | otherwise        = empty
1211
1212   -- WDP 96/05/06: We can re-elaborate this as we go along...
1213 \end{code}
1214
1215 \begin{code}
1216 idUnique (Id u _ _ _ _ _) = u
1217
1218 instance Uniquable (GenId ty) where
1219     uniqueOf = idUnique
1220
1221 instance NamedThing (GenId ty) where
1222     getName this_id@(Id u n _ details _ _) = n
1223 \end{code}
1224
1225 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
1226 the @Uniques@ out of local @Ids@ given to it.
1227
1228 %************************************************************************
1229 %*                                                                      *
1230 \subsection{@IdEnv@s and @IdSet@s}
1231 %*                                                                      *
1232 %************************************************************************
1233
1234 \begin{code}
1235 type IdEnv elt = UniqFM elt
1236
1237 nullIdEnv         :: IdEnv a
1238
1239 mkIdEnv           :: [(GenId ty, a)] -> IdEnv a
1240 unitIdEnv         :: GenId ty -> a -> IdEnv a
1241 addOneToIdEnv     :: IdEnv a -> GenId ty -> a -> IdEnv a
1242 growIdEnv         :: IdEnv a -> IdEnv a -> IdEnv a
1243 growIdEnvList     :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
1244
1245 delManyFromIdEnv  :: IdEnv a -> [GenId ty] -> IdEnv a
1246 delOneFromIdEnv   :: IdEnv a -> GenId ty -> IdEnv a
1247 combineIdEnvs     :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
1248 mapIdEnv          :: (a -> b) -> IdEnv a -> IdEnv b
1249 modifyIdEnv       :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
1250 rngIdEnv          :: IdEnv a -> [a]
1251
1252 isNullIdEnv       :: IdEnv a -> Bool
1253 lookupIdEnv       :: IdEnv a -> GenId ty -> Maybe a
1254 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
1255 \end{code}
1256
1257 \begin{code}
1258 addOneToIdEnv    = addToUFM
1259 combineIdEnvs    = plusUFM_C
1260 delManyFromIdEnv = delListFromUFM
1261 delOneFromIdEnv  = delFromUFM
1262 growIdEnv        = plusUFM
1263 lookupIdEnv      = lookupUFM
1264 mapIdEnv         = mapUFM
1265 mkIdEnv          = listToUFM
1266 nullIdEnv        = emptyUFM
1267 rngIdEnv         = eltsUFM
1268 unitIdEnv        = unitUFM
1269
1270 growIdEnvList     env pairs = plusUFM env (listToUFM pairs)
1271 isNullIdEnv       env       = sizeUFM env == 0
1272 lookupNoFailIdEnv env id    = case (lookupIdEnv env id) of { Just xx -> xx }
1273
1274 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
1275 -- modify function, and put it back.
1276
1277 modifyIdEnv mangle_fn env key
1278   = case (lookupIdEnv env key) of
1279       Nothing -> env
1280       Just xx -> addOneToIdEnv env key (mangle_fn xx)
1281
1282 modifyIdEnv_Directly mangle_fn env key
1283   = case (lookupUFM_Directly env key) of
1284       Nothing -> env
1285       Just xx -> addToUFM_Directly env key (mangle_fn xx)
1286 \end{code}
1287
1288 \begin{code}
1289 type GenIdSet ty = UniqSet (GenId ty)
1290 type IdSet       = UniqSet (GenId Type)
1291
1292 emptyIdSet      :: GenIdSet ty
1293 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1294 unionIdSets     :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1295 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
1296 idSetToList     :: GenIdSet ty -> [GenId ty]
1297 unitIdSet       :: GenId ty -> GenIdSet ty
1298 addOneToIdSet   :: GenIdSet ty -> GenId ty -> GenIdSet ty
1299 elementOfIdSet  :: GenId ty -> GenIdSet ty -> Bool
1300 minusIdSet      :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1301 isEmptyIdSet    :: GenIdSet ty -> Bool
1302 mkIdSet         :: [GenId ty] -> GenIdSet ty
1303
1304 emptyIdSet      = emptyUniqSet
1305 unitIdSet       = unitUniqSet
1306 addOneToIdSet   = addOneToUniqSet
1307 intersectIdSets = intersectUniqSets
1308 unionIdSets     = unionUniqSets
1309 unionManyIdSets = unionManyUniqSets
1310 idSetToList     = uniqSetToList
1311 elementOfIdSet  = elementOfUniqSet
1312 minusIdSet      = minusUniqSet
1313 isEmptyIdSet    = isEmptyUniqSet
1314 mkIdSet         = mkUniqSet
1315 \end{code}