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         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[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
 850 %*                                                                      *
 851 %************************************************************************
 852
 853 \begin{code}
 854 mkDataCon :: Name
 855           -> [StrictnessMark] -> [FieldLabel]
 856           -> [TyVar] -> ThetaType
 857           -> [TyVar] -> ThetaType
 858           -> [TauType] -> TyCon
 859           -> Id
 860   -- can get the tag and all the pieces of the type from the Type
 861
 862 mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
 863   = ASSERT(length stricts == length args_tys)
 864     addStandardIdInfo data_con
 865   where
 866     -- NB: data_con self-recursion; should be OK as tags are not
 867     -- looked at until late in the game.
 868     data_con
 869       = Id (nameUnique n)
 870            n
 871            data_con_ty
 872            (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
 873            IWantToBeINLINEd     -- Always inline constructors if possible
 874            noIdInfo
 875
 876     data_con_tag    = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
 877     data_con_family = tyConDataCons tycon
 878
 879     data_con_ty
 880       = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
 881         (mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
 882
 883
 884 mkTupleCon :: Arity -> Name -> Type -> Id
 885 mkTupleCon arity name ty
 886   = addStandardIdInfo tuple_id
 887   where
 888     tuple_id = Id (nameUnique name) name ty
 889                   (TupleConId arity)
 890                   IWantToBeINLINEd              -- Always inline constructors if possible
 891                   noIdInfo
 892
 893 fIRST_TAG :: ConTag
 894 fIRST_TAG =  1  -- Tags allocated from here for real constructors
 895 \end{code}
 896
 897 dataConNumFields gives the number of actual fields in the
 898 {\em representation} of the data constructor.  This may be more than appear
 899 in the source code; the extra ones are the existentially quantified
 900 dictionaries
 901
 902 \begin{code}
 903 dataConNumFields id
 904   = ASSERT(isDataCon id)
 905     case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
 906     length con_theta + length arg_tys }
 907
 908 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
 909
 910 \end{code}
 911
 912
 913 \begin{code}
 914 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
 915 dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
 916 dataConTag (Id _ _ _ (TupleConId _) _ _)              = fIRST_TAG
 917 dataConTag (Id _ _ _ (SpecId unspec _ _) _ _)         = dataConTag unspec
 918
 919 dataConTyCon :: DataCon -> TyCon        -- will panic if not a DataCon
 920 dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
 921 dataConTyCon (Id _ _ _ (TupleConId a) _ _)                = tupleTyCon a
 922
 923 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
 924                                         -- will panic if not a DataCon
 925
 926 dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
 927   = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
 928
 929 dataConSig (Id _ _ _ (TupleConId arity) _ _)
 930   = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
 931   where
 932     tyvars      = take arity alphaTyVars
 933     tyvar_tys   = mkTyVarTys tyvars
 934 dataConSig (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
 935   = (spec_tyvars, spec_theta_ty, spec_con_tyvars, spec_con_theta, spec_arg_tys, spec_tycon)
 936   where
 937     (tyvars, theta_ty, con_tyvars, con_theta, arg_tys, tycon) = dataConSig unspec
 938
 939     ty_env = tyvars `zip` ty_maybes
 940
 941     spec_tyvars     = foldr nothing_tyvars [] ty_env
 942     spec_con_tyvars = foldr nothing_tyvars [] (con_tyvars `zip` ty_maybes) -- Hmm..
 943
 944     nothing_tyvars (tyvar, Nothing) l = tyvar : l
 945     nothing_tyvars (tyvar, Just ty) l = l
 946
 947     spec_env = foldr just_env [] ty_env
 948     just_env (tyvar, Nothing) l = l
 949     just_env (tyvar, Just ty) l = (tyvar, ty) : l
 950     spec_arg_tys = map (instantiateTauTy spec_env) arg_tys
 951
 952     spec_theta_ty  = if null theta_ty then []
 953                      else panic "dataConSig:ThetaTy:SpecDataCon1"
 954     spec_con_theta = if null con_theta then []
 955                      else panic "dataConSig:ThetaTy:SpecDataCon2"
 956     spec_tycon     = mkSpecTyCon tycon ty_maybes
 957
 958
 959 -- dataConRepType returns the type of the representation of a contructor
 960 -- This may differ from the type of the contructor Id itself for two reasons:
 961 --      a) the constructor Id may be overloaded, but the dictionary isn't stored
 962 --      b) the constructor may store an unboxed version of a strict field.
 963 -- Here's an example illustrating both:
 964 --      data Ord a => T a = MkT Int! a
 965 -- Here
 966 --      T :: Ord a => Int -> a -> T a
 967 -- but the rep type is
 968 --      Trep :: Int# -> a -> T a
 969 -- Actually, the unboxed part isn't implemented yet!
 970
 971 dataConRepType :: GenId (GenType tv u) -> GenType tv u
 972 dataConRepType con
 973   = mkForAllTys tyvars tau
 974   where
 975     (tyvars, theta, tau) = splitSigmaTy (idType con)
 976
 977 dataConFieldLabels :: DataCon -> [FieldLabel]
 978 dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
 979 dataConFieldLabels (Id _ _ _ (TupleConId _)                 _ _) = []
 980 #ifdef DEBUG
 981 dataConFieldLabels x@(Id _ _ _ idt _ _) =
 982   panic ("dataConFieldLabel: " ++
 983     (case idt of
 984       LocalId _    -> "l"
 985       SysLocalId _ -> "sl"
 986       PrimitiveId _ -> "p"
 987       SpecPragmaId _  _ -> "sp"
 988       ImportedId -> "i"
 989       RecordSelId _ -> "r"
 990       SuperDictSelId _ _ -> "sc"
 991       MethodSelId _ -> "m"
 992       DefaultMethodId _ -> "d"
 993       DictFunId _ _ -> "di"
 994       InstId _ -> "in"
 995       SpecId _ _ _ -> "spec"))
 996 #endif
 997
 998 dataConStrictMarks :: DataCon -> [StrictnessMark]
 999 dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
1000 dataConStrictMarks (Id _ _ _ (TupleConId arity)              _ _)
1001   = nOfThem arity NotMarkedStrict
1002
1003 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
1004 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
1005
1006 dataConArgTys :: DataCon
1007               -> [Type]         -- Instantiated at these types
1008               -> [Type]         -- Needs arguments of these types
1009 dataConArgTys con_id inst_tys
1010  = map (instantiateTy tenv) arg_tys
1011  where
1012     (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
1013     tenv                          = zipEqual "dataConArgTys" tyvars inst_tys
1014 \end{code}
1015
1016 \begin{code}
1017 mkRecordSelId field_label selector_ty
1018   = addStandardIdInfo $         -- Record selectors have a standard unfolding
1019     Id (nameUnique name)
1020        name
1021        selector_ty
1022        (RecordSelId field_label)
1023        NoPragmaInfo
1024        noIdInfo
1025   where
1026     name = fieldLabelName field_label
1027
1028 recordSelectorFieldLabel :: Id -> FieldLabel
1029 recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1030
1031 isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
1032 isRecordSelector other                            = False
1033 \end{code}
1034
1035
1036 Data type declarations are of the form:
1037 \begin{verbatim}
1038 data Foo a b = C1 ... | C2 ... | ... | Cn ...
1039 \end{verbatim}
1040 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
1041 @C1 x y z@, we want a function binding:
1042 \begin{verbatim}
1043 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1044 \end{verbatim}
1045 Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1046 2nd-order polymorphic lambda calculus with explicit types.
1047
1048 %************************************************************************
1049 %*                                                                      *
1050 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1051 %*                                                                      *
1052 %************************************************************************
1053
1054 \begin{code}
1055 getIdUnfolding :: Id -> Unfolding
1056
1057 getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1058
1059 addIdUnfolding :: Id -> Unfolding -> Id
1060 addIdUnfolding id@(Id u n ty details prag info) unfolding
1061   = Id u n ty details prag (info `addUnfoldInfo` unfolding)
1062 \end{code}
1063
1064 The inline pragma tells us to be very keen to inline this Id, but it's still
1065 OK not to if optimisation is switched off.
1066
1067 \begin{code}
1068 getInlinePragma :: Id -> PragmaInfo
1069 getInlinePragma (Id _ _ _ _ prag _) = prag
1070
1071 idWantsToBeINLINEd :: Id -> Bool
1072
1073 idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
1074 idWantsToBeINLINEd (Id _ _ _ _ IMustBeINLINEd   _) = True
1075 idWantsToBeINLINEd _                               = False
1076
1077 idMustNotBeINLINEd (Id _ _ _ _ IMustNotBeINLINEd _) = True
1078 idMustNotBeINLINEd _                                = False
1079
1080 idMustBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1081 idMustBeINLINEd _                             = False
1082
1083 addInlinePragma :: Id -> Id
1084 addInlinePragma (Id u sn ty details _ info)
1085   = Id u sn ty details IWantToBeINLINEd info
1086
1087 nukeNoInlinePragma :: Id -> Id
1088 nukeNoInlinePragma id@(Id u sn ty details IMustNotBeINLINEd info)
1089   = Id u sn ty details NoPragmaInfo info
1090 nukeNoInlinePragma id@(Id u sn ty details _ info) = id          -- Otherwise no-op
1091
1092 addNoInlinePragma :: Id -> Id
1093 addNoInlinePragma id@(Id u sn ty details _ info)
1094   = Id u sn ty details IMustNotBeINLINEd info
1095 \end{code}
1096
1097
1098
1099 %************************************************************************
1100 %*                                                                      *
1101 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1102 %*                                                                      *
1103 %************************************************************************
1104
1105 \begin{code}
1106 getIdDemandInfo :: Id -> DemandInfo
1107 getIdDemandInfo (Id _ _ _ _ _ info) = demandInfo info
1108
1109 addIdDemandInfo :: Id -> DemandInfo -> Id
1110 addIdDemandInfo (Id u n ty details prags info) demand_info
1111   = Id u n ty details prags (info `addDemandInfo` demand_info)
1112 \end{code}
1113
1114 \begin{code}
1115 getIdUpdateInfo :: Id -> UpdateInfo
1116 getIdUpdateInfo (Id _ _ _ _ _ info) = updateInfo info
1117
1118 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1119 addIdUpdateInfo (Id u n ty details prags info) upd_info
1120   = Id u n ty details prags (info `addUpdateInfo` upd_info)
1121 \end{code}
1122
1123 \begin{code}
1124 {- LATER:
1125 getIdArgUsageInfo :: Id -> ArgUsageInfo
1126 getIdArgUsageInfo (Id u n ty info details) = argUsageInfo info
1127
1128 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1129 addIdArgUsageInfo (Id u n ty info details) au_info
1130   = Id u n ty (info `addArgusageInfo` au_info) details
1131 -}
1132 \end{code}
1133
1134 \begin{code}
1135 {- LATER:
1136 getIdFBTypeInfo :: Id -> FBTypeInfo
1137 getIdFBTypeInfo (Id u n ty info details) = fbTypeInfo info
1138
1139 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1140 addIdFBTypeInfo (Id u n ty info details) upd_info
1141   = Id u n ty (info `addFBTypeInfo` upd_info) details
1142 -}
1143 \end{code}
1144
1145 \begin{code}
1146 getIdSpecialisation :: Id -> SpecEnv
1147 getIdSpecialisation (Id _ _ _ _ _ info) = specInfo info
1148
1149 addIdSpecialisation :: Id -> SpecEnv -> Id
1150 addIdSpecialisation (Id u n ty details prags info) spec_info
1151   = Id u n ty details prags (info `addSpecInfo` spec_info)
1152 \end{code}
1153
1154 Strictness: we snaffle the info out of the IdInfo.
1155
1156 \begin{code}
1157 getIdStrictness :: Id -> StrictnessInfo
1158
1159 getIdStrictness (Id _ _ _ _ _ info) = strictnessInfo info
1160
1161 addIdStrictness :: Id -> StrictnessInfo -> Id
1162 addIdStrictness (Id u n ty details prags info) strict_info
1163   = Id u n ty details prags (info `addStrictnessInfo` strict_info)
1164 \end{code}
1165
1166 %************************************************************************
1167 %*                                                                      *
1168 \subsection[Id-comparison]{Comparison functions for @Id@s}
1169 %*                                                                      *
1170 %************************************************************************
1171
1172 Comparison: equality and ordering---this stuff gets {\em hammered}.
1173
1174 \begin{code}
1175 cmpId (Id u1 _ _ _ _ _) (Id u2 _ _ _ _ _) = cmp u1 u2
1176 -- short and very sweet
1177 \end{code}
1178
1179 \begin{code}
1180 instance Ord3 (GenId ty) where
1181     cmp = cmpId
1182
1183 instance Eq (GenId ty) where
1184     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
1185     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True  }
1186
1187 instance Ord (GenId ty) where
1188     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
1189     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
1190     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
1191     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
1192     _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
1193 \end{code}
1194
1195 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1196 account when comparing two data constructors. We need to do this
1197 because a specialised data constructor has the same Unique as its
1198 unspecialised counterpart.
1199
1200 \begin{code}
1201 cmpId_withSpecDataCon :: Id -> Id -> TAG_
1202
1203 cmpId_withSpecDataCon id1 id2
1204   | eq_ids && isDataCon id1 && isDataCon id2
1205   = cmpEqDataCon id1 id2
1206
1207   | otherwise
1208   = cmp_ids
1209   where
1210     cmp_ids = cmpId id1 id2
1211     eq_ids  = case cmp_ids of { EQ_ -> True; other -> False }
1212
1213 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _) _ _) (Id _ _ _ (SpecId _ mtys2 _) _ _)
1214   = panic# "Id.cmpEqDataCon:cmpUniTypeMaybeList mtys1 mtys2"
1215
1216 cmpEqDataCon _ (Id _ _ _ (SpecId _ _ _) _ _) = LT_
1217 cmpEqDataCon (Id _ _ _ (SpecId _ _ _) _ _) _ = GT_
1218 cmpEqDataCon _                             _ = EQ_
1219 \end{code}
1220
1221 %************************************************************************
1222 %*                                                                      *
1223 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1224 %*                                                                      *
1225 %************************************************************************
1226
1227 \begin{code}
1228 instance Outputable ty => Outputable (GenId ty) where
1229     ppr sty id = pprId sty id
1230
1231 -- and a SPECIALIZEd one:
1232 instance Outputable {-Id, i.e.:-}(GenId Type) where
1233     ppr sty id = pprId sty id
1234
1235 showId :: PprStyle -> Id -> String
1236 showId sty id = show (pprId sty id)
1237 \end{code}
1238
1239 Default printing code (not used for interfaces):
1240 \begin{code}
1241 pprId :: Outputable ty => PprStyle -> GenId ty -> Doc
1242
1243 pprId sty (Id u n _ _ prags _)
1244   = hcat [ppr sty n, pp_prags]
1245   where
1246     pp_prags = ifPprDebug sty (case prags of
1247                                 IMustNotBeINLINEd -> text "{n}"
1248                                 IWantToBeINLINEd  -> text "{i}"
1249                                 IMustBeINLINEd    -> text "{I}"
1250                                 other             -> empty)
1251
1252   -- WDP 96/05/06: We can re-elaborate this as we go along...
1253 \end{code}
1254
1255 \begin{code}
1256 idUnique (Id u _ _ _ _ _) = u
1257
1258 instance Uniquable (GenId ty) where
1259     uniqueOf = idUnique
1260
1261 instance NamedThing (GenId ty) where
1262     getName this_id@(Id u n _ details _ _) = n
1263 \end{code}
1264
1265 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
1266 the @Uniques@ out of local @Ids@ given to it.
1267
1268 %************************************************************************
1269 %*                                                                      *
1270 \subsection{@IdEnv@s and @IdSet@s}
1271 %*                                                                      *
1272 %************************************************************************
1273
1274 \begin{code}
1275 type IdEnv elt = UniqFM elt
1276
1277 nullIdEnv         :: IdEnv a
1278
1279 mkIdEnv           :: [(GenId ty, a)] -> IdEnv a
1280 unitIdEnv         :: GenId ty -> a -> IdEnv a
1281 addOneToIdEnv     :: IdEnv a -> GenId ty -> a -> IdEnv a
1282 growIdEnv         :: IdEnv a -> IdEnv a -> IdEnv a
1283 growIdEnvList     :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
1284
1285 delManyFromIdEnv  :: IdEnv a -> [GenId ty] -> IdEnv a
1286 delOneFromIdEnv   :: IdEnv a -> GenId ty -> IdEnv a
1287 combineIdEnvs     :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
1288 mapIdEnv          :: (a -> b) -> IdEnv a -> IdEnv b
1289 modifyIdEnv       :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
1290 rngIdEnv          :: IdEnv a -> [a]
1291
1292 isNullIdEnv       :: IdEnv a -> Bool
1293 lookupIdEnv       :: IdEnv a -> GenId ty -> Maybe a
1294 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
1295 \end{code}
1296
1297 \begin{code}
1298 addOneToIdEnv    = addToUFM
1299 combineIdEnvs    = plusUFM_C
1300 delManyFromIdEnv = delListFromUFM
1301 delOneFromIdEnv  = delFromUFM
1302 growIdEnv        = plusUFM
1303 lookupIdEnv      = lookupUFM
1304 mapIdEnv         = mapUFM
1305 mkIdEnv          = listToUFM
1306 nullIdEnv        = emptyUFM
1307 rngIdEnv         = eltsUFM
1308 unitIdEnv        = unitUFM
1309
1310 growIdEnvList     env pairs = plusUFM env (listToUFM pairs)
1311 isNullIdEnv       env       = sizeUFM env == 0
1312 lookupNoFailIdEnv env id    = case (lookupIdEnv env id) of { Just xx -> xx }
1313
1314 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
1315 -- modify function, and put it back.
1316
1317 modifyIdEnv mangle_fn env key
1318   = case (lookupIdEnv env key) of
1319       Nothing -> env
1320       Just xx -> addOneToIdEnv env key (mangle_fn xx)
1321
1322 modifyIdEnv_Directly mangle_fn env key
1323   = case (lookupUFM_Directly env key) of
1324       Nothing -> env
1325       Just xx -> addToUFM_Directly env key (mangle_fn xx)
1326 \end{code}
1327
1328 \begin{code}
1329 type GenIdSet ty = UniqSet (GenId ty)
1330 type IdSet       = UniqSet (GenId Type)
1331
1332 emptyIdSet      :: GenIdSet ty
1333 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1334 unionIdSets     :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1335 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
1336 idSetToList     :: GenIdSet ty -> [GenId ty]
1337 unitIdSet       :: GenId ty -> GenIdSet ty
1338 addOneToIdSet   :: GenIdSet ty -> GenId ty -> GenIdSet ty
1339 elementOfIdSet  :: GenId ty -> GenIdSet ty -> Bool
1340 minusIdSet      :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1341 isEmptyIdSet    :: GenIdSet ty -> Bool
1342 mkIdSet         :: [GenId ty] -> GenIdSet ty
1343
1344 emptyIdSet      = emptyUniqSet
1345 unitIdSet       = unitUniqSet
1346 addOneToIdSet   = addOneToUniqSet
1347 intersectIdSets = intersectUniqSets
1348 unionIdSets     = unionUniqSets
1349 unionManyIdSets = unionManyUniqSets
1350 idSetToList     = uniqSetToList
1351 elementOfIdSet  = elementOfUniqSet
1352 minusIdSet      = minusUniqSet
1353 isEmptyIdSet    = isEmptyUniqSet
1354 mkIdSet         = mkUniqSet
1355 \end{code}