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