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