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