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         mkConstMethodId,
  19         mkDataCon,
  20         mkDefaultMethodId,
  21         mkDictFunId,
  22         mkIdWithNewUniq,
  23         mkImported,
  24         mkInstId,
  25         mkMethodSelId,
  26         mkRecordSelId,
  27         mkSuperDictSelId,
  28         mkSysLocal,
  29         mkTemplateLocals,
  30         mkTupleCon,
  31         mkUserId,
  32         mkUserLocal,
  33         mkWorkerId,
  34
  35         -- MANGLING
  36         unsafeGenId2Id,
  37
  38         -- DESTRUCTION (excluding pragmatic info)
  39         idPrimRep,
  40         idType,
  41         idUnique,
  42
  43         dataConArgTys,
  44         dataConArity,
  45         dataConNumFields,
  46         dataConFieldLabels,
  47         dataConRawArgTys,
  48         dataConSig,
  49         dataConStrictMarks,
  50         dataConTag,
  51         dataConTyCon,
  52
  53         recordSelectorFieldLabel,
  54
  55         -- PREDICATES
  56         cmpEqDataCon,
  57         cmpId,
  58         cmpId_withSpecDataCon,
  59         externallyVisibleId,
  60         idHasNoFreeTyVars,
  61         idWantsToBeINLINEd,
  62         isBottomingId,
  63         isConstMethodId,
  64         isConstMethodId_maybe,
  65         isDataCon,
  66         isDefaultMethodId,
  67         isDefaultMethodId_maybe,
  68         isDictFunId,
  69         isImportedId,
  70         isMethodSelId,
  71         isNullaryDataCon,
  72         isSpecPragmaId,
  73         isSuperDictSelId_maybe,
  74         isSysLocalId,
  75         isTopLevId,
  76         isTupleCon,
  77         isWorkerId,
  78         toplevelishId,
  79         unfoldingUnfriendlyId,
  80
  81         -- SUBSTITUTION
  82         applyTypeEnvToId,
  83         apply_to_Id,
  84
  85         -- PRINTING and RENUMBERING
  86         addId,
  87         nmbrDataCon,
  88         nmbrId,
  89         pprId,
  90         showId,
  91
  92         -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
  93         addIdArity,
  94         addIdDemandInfo,
  95         addIdStrictness,
  96         addIdUpdateInfo,
  97         getIdArity,
  98         getIdDemandInfo,
  99         getIdInfo,
 100         getIdStrictness,
 101         getIdUnfolding,
 102         getIdUpdateInfo,
 103         getPragmaInfo,
 104
 105         -- IdEnvs AND IdSets
 106         SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
 107         addOneToIdEnv,
 108         addOneToIdSet,
 109         combineIdEnvs,
 110         delManyFromIdEnv,
 111         delOneFromIdEnv,
 112         elementOfIdSet,
 113         emptyIdSet,
 114         growIdEnv,
 115         growIdEnvList,
 116         idSetToList,
 117         intersectIdSets,
 118         isEmptyIdSet,
 119         isNullIdEnv,
 120         lookupIdEnv,
 121         lookupNoFailIdEnv,
 122         mapIdEnv,
 123         minusIdSet,
 124         mkIdEnv,
 125         mkIdSet,
 126         modifyIdEnv,
 127         nullIdEnv,
 128         rngIdEnv,
 129         unionIdSets,
 130         unionManyIdSets,
 131         unitIdEnv,
 132         unitIdSet
 133     ) where
 134
 135 IMP_Ubiq()
 136 IMPORT_DELOOPER(IdLoop)   -- for paranoia checking
 137 IMPORT_DELOOPER(TyLoop)   -- for paranoia checking
 138
 139 import Bag
 140 import Class            ( classOpString, SYN_IE(Class), GenClass, SYN_IE(ClassOp), GenClassOp )
 141 import IdInfo
 142 import Maybes           ( maybeToBool )
 143 import Name             ( appendRdr, nameUnique, mkLocalName, isLocalName,
 144                           isLocallyDefinedName,
 145                           mkTupleDataConName, mkCompoundName, mkCompoundName2,
 146                           isLexSym, isLexSpecialSym,
 147                           isLocallyDefined, changeUnique,
 148                           getOccName, origName, moduleOf,
 149                           isExported, ExportFlag(..),
 150                           RdrName(..), Name
 151                         )
 152 import FieldLabel       ( fieldLabelName, FieldLabel(..){-instances-} )
 153 import PragmaInfo       ( PragmaInfo(..) )
 154 import PprEnv           -- ( SYN_IE(NmbrM), NmbrEnv(..) )
 155 import PprType          ( getTypeString, typeMaybeString, specMaybeTysSuffix,
 156                           nmbrType, nmbrTyVar,
 157                           GenType, GenTyVar
 158                         )
 159 import PprStyle
 160 import Pretty
 161 import SrcLoc           ( mkBuiltinSrcLoc )
 162 import TyCon            ( TyCon, mkTupleTyCon, tyConDataCons )
 163 import Type             ( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
 164                           applyTyCon, instantiateTy,
 165                           tyVarsOfType, applyTypeEnvToTy, typePrimRep,
 166                           GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
 167                         )
 168 import TyVar            ( alphaTyVars, isEmptyTyVarSet, SYN_IE(TyVarEnv) )
 169 import UniqFM
 170 import UniqSet          -- practically all of it
 171 import Unique           ( getBuiltinUniques, pprUnique, showUnique,
 172                           incrUnique,
 173                           Unique{-instance Ord3-}
 174                         )
 175 import Util             ( mapAccumL, nOfThem, zipEqual,
 176                           panic, panic#, pprPanic, assertPanic
 177                         )
 178 \end{code}
 179
 180 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
 181 follow.
 182
 183 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
 184 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
 185 strictness).  The essential info about different kinds of @Ids@ is
 186 in its @IdDetails@.
 187
 188 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
 189
 190 \begin{code}
 191 data GenId ty = Id
 192         Unique          -- Key for fast comparison
 193         Name
 194         ty              -- Id's type; used all the time;
 195         IdDetails       -- Stuff about individual kinds of Ids.
 196         PragmaInfo      -- Properties of this Id requested by programmer
 197                         -- eg specialise-me, inline-me
 198         IdInfo          -- Properties of this Id deduced by compiler
 199
 200 type Id = GenId Type
 201
 202 data StrictnessMark = MarkedStrict | NotMarkedStrict
 203
 204 data IdDetails
 205
 206   ---------------- Local values
 207
 208   = LocalId     Bool            -- Local name; mentioned by the user
 209                                 -- True <=> no free type vars
 210
 211   | SysLocalId  Bool            -- Local name; made up by the compiler
 212                                 -- as for LocalId
 213
 214   | SpecPragmaId                -- Local name; introduced by the compiler
 215                  (Maybe Id)     -- for explicit specid in pragma
 216                  Bool           -- as for LocalId
 217
 218   ---------------- Global values
 219
 220   | ImportedId                  -- Global name (Imported or Implicit); Id imported from an interface
 221
 222   | TopLevId                    -- Global name (LocalDef); Top-level in the orig source pgm
 223                                 -- (not moved there by transformations).
 224
 225         -- a TopLevId's type may contain free type variables, if
 226         -- the monomorphism restriction applies.
 227
 228   ---------------- Data constructors
 229
 230   | DataConId   ConTag
 231                 [StrictnessMark] -- Strict args; length = arity
 232                 [FieldLabel]    -- Field labels for this constructor
 233
 234                 [TyVar] [(Class,Type)] [Type] TyCon
 235                                 -- the type is:
 236                                 -- forall tyvars . theta_ty =>
 237                                 --    unitype_1 -> ... -> unitype_n -> tycon tyvars
 238
 239   | TupleConId  Int             -- Its arity
 240
 241   | RecordSelId FieldLabel
 242
 243   ---------------- Things to do with overloading
 244
 245   | SuperDictSelId              -- Selector for superclass dictionary
 246                 Class           -- The class (input dict)
 247                 Class           -- The superclass (result dict)
 248
 249   | MethodSelId Class           -- An overloaded class operation, with
 250                                 -- a fully polymorphic type.  Its code
 251                                 -- just selects a method from the
 252                                 -- dictionary.  The class.
 253                 ClassOp         -- The operation
 254
 255         -- NB: The IdInfo for a MethodSelId has all the info about its
 256         -- related "constant method Ids", which are just
 257         -- specialisations of this general one.
 258
 259   | DefaultMethodId             -- Default method for a particular class op
 260                 Class           -- same class, <blah-blah> info as MethodSelId
 261                 ClassOp         -- (surprise, surprise)
 262                 Bool            -- True <=> I *know* this default method Id
 263                                 -- is a generated one that just says
 264                                 -- `error "No default method for <op>"'.
 265
 266                                 -- see below
 267   | DictFunId   Class           -- A DictFun is uniquely identified
 268                 Type            -- by its class and type; this type has free type vars,
 269                                 -- whose identity is irrelevant.  Eg Class = Eq
 270                                 --                                   Type  = Tree a
 271                                 -- The "a" is irrelevant.  As it is too painful to
 272                                 -- actually do comparisons that way, we kindly supply
 273                                 -- a Unique for that purpose.
 274                 Module          -- module where instance came from
 275
 276                                 -- see below
 277   | ConstMethodId               -- A method which depends only on the type of the
 278                                 -- instance, and not on any further dictionaries etc.
 279                 Class           -- Uniquely identified by:
 280                 Type            -- (class, type, classop) triple
 281                 ClassOp
 282                 Module          -- module where instance came from
 283
 284   | InstId                      -- An instance of a dictionary, class operation,
 285                                 -- or overloaded value (Local name)
 286                 Bool            -- as for LocalId
 287
 288   | SpecId                      -- A specialisation of another Id
 289                 Id              -- Id of which this is a specialisation
 290                 [Maybe Type]    -- Types at which it is specialised;
 291                                 -- A "Nothing" says this type ain't relevant.
 292                 Bool            -- True <=> no free type vars; it's not enough
 293                                 -- to know about the unspec version, because
 294                                 -- we may specialise to a type w/ free tyvars
 295                                 -- (i.e., in one of the "Maybe Type" dudes).
 296
 297   | WorkerId                    -- A "worker" for some other Id
 298                 Id              -- Id for which this is a worker
 299
 300 type ConTag     = Int
 301 type DictVar    = Id
 302 type DictFun    = Id
 303 type DataCon    = Id
 304 \end{code}
 305
 306 DictFunIds are generated from instance decls.
 307 \begin{verbatim}
 308         class Foo a where
 309           op :: a -> a -> Bool
 310
 311         instance Foo a => Foo [a] where
 312           op = ...
 313 \end{verbatim}
 314 generates the dict fun id decl
 315 \begin{verbatim}
 316         dfun.Foo.[*] = \d -> ...
 317 \end{verbatim}
 318 The dfun id is uniquely named by the (class, type) pair.  Notice, it
 319 isn't a (class,tycon) pair any more, because we may get manually or
 320 automatically generated specialisations of the instance decl:
 321 \begin{verbatim}
 322         instance Foo [Int] where
 323           op = ...
 324 \end{verbatim}
 325 generates
 326 \begin{verbatim}
 327         dfun.Foo.[Int] = ...
 328 \end{verbatim}
 329 The type variables in the name are irrelevant; we print them as stars.
 330
 331
 332 Constant method ids are generated from instance decls where
 333 there is no context; that is, no dictionaries are needed to
 334 construct the method.  Example
 335 \begin{verbatim}
 336         instance Foo Int where
 337           op = ...
 338 \end{verbatim}
 339 Then we get a constant method
 340 \begin{verbatim}
 341         Foo.op.Int = ...
 342 \end{verbatim}
 343
 344 It is possible, albeit unusual, to have a constant method
 345 for an instance decl which has type vars:
 346 \begin{verbatim}
 347         instance Foo [a] where
 348           op []     ys = True
 349           op (x:xs) ys = False
 350 \end{verbatim}
 351 We get the constant method
 352 \begin{verbatim}
 353         Foo.op.[*] = ...
 354 \end{verbatim}
 355 So a constant method is identified by a class/op/type triple.
 356 The type variables in the type are irrelevant.
 357
 358
 359 For Ids whose names must be known/deducible in other modules, we have
 360 to conjure up their worker's names (and their worker's worker's
 361 names... etc) in a known systematic way.
 362
 363
 364 %************************************************************************
 365 %*                                                                      *
 366 \subsection[Id-documentation]{Documentation}
 367 %*                                                                      *
 368 %************************************************************************
 369
 370 [A BIT DATED [WDP]]
 371
 372 The @Id@ datatype describes {\em values}.  The basic things we want to
 373 know: (1)~a value's {\em type} (@idType@ is a very common
 374 operation in the compiler); and (2)~what ``flavour'' of value it might
 375 be---for example, it can be terribly useful to know that a value is a
 376 class method.
 377
 378 \begin{description}
 379 %----------------------------------------------------------------------
 380 \item[@DataConId@:] For the data constructors declared by a @data@
 381 declaration.  Their type is kept in {\em two} forms---as a regular
 382 @Type@ (in the usual place), and also in its constituent pieces (in
 383 the ``details''). We are frequently interested in those pieces.
 384
 385 %----------------------------------------------------------------------
 386 \item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
 387 the infinite family of tuples.
 388
 389 %----------------------------------------------------------------------
 390 \item[@ImportedId@:] These are values defined outside this module.
 391 {\em Everything} we want to know about them must be stored here (or in
 392 their @IdInfo@).
 393
 394 %----------------------------------------------------------------------
 395 \item[@TopLevId@:] These are values defined at the top-level in this
 396 module; i.e., those which {\em might} be exported (hence, a
 397 @Name@).  It does {\em not} include those which are moved to the
 398 top-level through program transformations.
 399
 400 We also guarantee that @TopLevIds@ will {\em stay} at top-level.
 401 Theoretically, they could be floated inwards, but there's no known
 402 advantage in doing so.  This way, we can keep them with the same
 403 @Unique@ throughout (no cloning), and, in general, we don't have to be
 404 so paranoid about them.
 405
 406 In particular, we had the following problem generating an interface:
 407 We have to ``stitch together'' info (1)~from the typechecker-produced
 408 global-values list (GVE) and (2)~from the STG code [which @Ids@ have
 409 what arities].  If the @Uniques@ on the @TopLevIds@ can {\em change}
 410 between (1) and (2), you're sunk!
 411
 412 %----------------------------------------------------------------------
 413 \item[@MethodSelId@:] A selector from a dictionary; it may select either
 414 a method or a dictionary for one of the class's superclasses.
 415
 416 %----------------------------------------------------------------------
 417 \item[@DictFunId@:]
 418
 419 @mkDictFunId [a,b..] theta C T@ is the function derived from the
 420 instance declaration
 421
 422         instance theta => C (T a b ..) where
 423                 ...
 424
 425 It builds function @Id@ which maps dictionaries for theta,
 426 to a dictionary for C (T a b ..).
 427
 428 *Note* that with the ``Mark Jones optimisation'', the theta may
 429 include dictionaries for the immediate superclasses of C at the type
 430 (T a b ..).
 431
 432 %----------------------------------------------------------------------
 433 \item[@InstId@:]
 434
 435 %----------------------------------------------------------------------
 436 \item[@SpecId@:]
 437
 438 %----------------------------------------------------------------------
 439 \item[@WorkerId@:]
 440
 441 %----------------------------------------------------------------------
 442 \item[@LocalId@:] A purely-local value, e.g., a function argument,
 443 something defined in a @where@ clauses, ... --- but which appears in
 444 the original program text.
 445
 446 %----------------------------------------------------------------------
 447 \item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
 448 the original program text; these are introduced by the compiler in
 449 doing its thing.
 450
 451 %----------------------------------------------------------------------
 452 \item[@SpecPragmaId@:] Introduced by the compiler to record
 453 Specialisation pragmas. It is dead code which MUST NOT be removed
 454 before specialisation.
 455 \end{description}
 456
 457 Further remarks:
 458 \begin{enumerate}
 459 %----------------------------------------------------------------------
 460 \item
 461
 462 @DataCons@ @TupleCons@, @Importeds@, @TopLevIds@, @SuperDictSelIds@,
 463 @MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
 464 properties:
 465 \begin{itemize}
 466 \item
 467 They have no free type variables, so if you are making a
 468 type-variable substitution you don't need to look inside them.
 469 \item
 470 They are constants, so they are not free variables.  (When the STG
 471 machine makes a closure, it puts all the free variables in the
 472 closure; the above are not required.)
 473 \end{itemize}
 474 Note that @InstIds@, @Locals@ and @SysLocals@ {\em may} have the above
 475 properties, but they may not.
 476 \end{enumerate}
 477
 478 %************************************************************************
 479 %*                                                                      *
 480 \subsection[Id-general-funs]{General @Id@-related functions}
 481 %*                                                                      *
 482 %************************************************************************
 483
 484 \begin{code}
 485 unsafeGenId2Id :: GenId ty -> Id
 486 unsafeGenId2Id (Id u n ty d p i) = Id u n (panic "unsafeGenId2Id:ty") d p i
 487
 488 isDataCon id = is_data (unsafeGenId2Id id)
 489  where
 490   is_data (Id _ _ _ (DataConId _ _ _ _ _ _ _) _ _) = True
 491   is_data (Id _ _ _ (TupleConId _) _ _)            = True
 492   is_data (Id _ _ _ (SpecId unspec _ _) _ _)       = is_data unspec
 493   is_data other                                    = False
 494
 495
 496 isTupleCon id = is_tuple (unsafeGenId2Id id)
 497  where
 498   is_tuple (Id _ _ _ (TupleConId _) _ _)         = True
 499   is_tuple (Id _ _ _ (SpecId unspec _ _) _ _)    = is_tuple unspec
 500   is_tuple other                                 = False
 501
 502 {-LATER:
 503 isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
 504   = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
 505     Just (unspec, ty_maybes)
 506 isSpecId_maybe other_id
 507   = Nothing
 508
 509 isSpecPragmaId_maybe (Id _ _ _ (SpecPragmaId specid _) _ _)
 510   = Just specid
 511 isSpecPragmaId_maybe other_id
 512   = Nothing
 513 -}
 514 \end{code}
 515
 516 @toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
 517 @let(rec)@ (returns @False@), or whether it is {\em sure} to be
 518 defined at top level (returns @True@). This is used to decide whether
 519 the @Id@ is a candidate free variable. NB: you are only {\em sure}
 520 about something if it returns @True@!
 521
 522 \begin{code}
 523 toplevelishId     :: Id -> Bool
 524 idHasNoFreeTyVars :: Id -> Bool
 525
 526 toplevelishId (Id _ _ _ details _ _)
 527   = chk details
 528   where
 529     chk (DataConId _ _ _ _ _ _ _)   = True
 530     chk (TupleConId _)              = True
 531     chk (RecordSelId _)             = True
 532     chk ImportedId                  = True
 533     chk TopLevId                    = True      -- NB: see notes
 534     chk (SuperDictSelId _ _)        = True
 535     chk (MethodSelId _ _)           = True
 536     chk (DefaultMethodId _ _ _)     = True
 537     chk (DictFunId     _ _ _)       = True
 538     chk (ConstMethodId _ _ _ _)     = True
 539     chk (SpecId unspec _ _)         = toplevelishId unspec
 540                                     -- depends what the unspecialised thing is
 541     chk (WorkerId unwrkr)           = toplevelishId unwrkr
 542     chk (InstId       _)            = False     -- these are local
 543     chk (LocalId      _)            = False
 544     chk (SysLocalId   _)            = False
 545     chk (SpecPragmaId _ _)          = False
 546
 547 idHasNoFreeTyVars (Id _ _ _ details _ info)
 548   = chk details
 549   where
 550     chk (DataConId _ _ _ _ _ _ _) = True
 551     chk (TupleConId _)            = True
 552     chk (RecordSelId _)           = True
 553     chk ImportedId                = True
 554     chk TopLevId                  = True
 555     chk (SuperDictSelId _ _)      = True
 556     chk (MethodSelId _ _)         = True
 557     chk (DefaultMethodId _ _ _)   = True
 558     chk (DictFunId     _ _ _)     = True
 559     chk (ConstMethodId _ _ _ _)   = True
 560     chk (WorkerId unwrkr)         = idHasNoFreeTyVars unwrkr
 561     chk (SpecId _     _   no_free_tvs) = no_free_tvs
 562     chk (InstId         no_free_tvs) = no_free_tvs
 563     chk (LocalId        no_free_tvs) = no_free_tvs
 564     chk (SysLocalId     no_free_tvs) = no_free_tvs
 565     chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
 566 \end{code}
 567
 568 \begin{code}
 569 isTopLevId (Id _ _ _ TopLevId _ _) = True
 570 isTopLevId other                   = False
 571
 572 isImportedId (Id _ _ _ ImportedId _ _) = True
 573 isImportedId other                     = False
 574
 575 isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (getInfo info)
 576
 577 isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
 578 isSysLocalId other                         = False
 579
 580 isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
 581 isSpecPragmaId other                             = False
 582
 583 isMethodSelId (Id _ _ _ (MethodSelId _ _) _ _) = True
 584 isMethodSelId _                                = False
 585
 586 isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
 587 isDefaultMethodId other                                  = False
 588
 589 isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls clsop err) _ _)
 590   = Just (cls, clsop, err)
 591 isDefaultMethodId_maybe other = Nothing
 592
 593 isDictFunId (Id _ _ _ (DictFunId _ _ _) _ _) = True
 594 isDictFunId other                            = False
 595
 596 isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _) _ _) = True
 597 isConstMethodId other                                  = False
 598
 599 isConstMethodId_maybe (Id _ _ _ (ConstMethodId cls ty clsop _) _ _)
 600   = Just (cls, ty, clsop)
 601 isConstMethodId_maybe other = Nothing
 602
 603 isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
 604 isSuperDictSelId_maybe other_id                           = Nothing
 605
 606 isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
 607 isWorkerId other                     = False
 608
 609 {-LATER:
 610 isWrapperId id = workerExists (getIdStrictness id)
 611 -}
 612 \end{code}
 613
 614 \begin{code}
 615 {-LATER:
 616 pprIdInUnfolding :: IdSet -> Id -> Pretty
 617
 618 pprIdInUnfolding in_scopes v
 619   = let
 620         v_ty = idType v
 621     in
 622     -- local vars first:
 623     if v `elementOfUniqSet` in_scopes then
 624         pprUnique (idUnique v)
 625
 626     -- ubiquitous Ids with special syntax:
 627     else if v == nilDataCon then
 628         ppPStr SLIT("_NIL_")
 629     else if isTupleCon v then
 630         ppBeside (ppPStr SLIT("_TUP_")) (ppInt (dataConArity v))
 631
 632     -- ones to think about:
 633     else
 634         let
 635             (Id _ _ _ v_details _ _) = v
 636         in
 637         case v_details of
 638             -- these ones must have been exported by their original module
 639           ImportedId   -> pp_full_name
 640
 641             -- these ones' exportedness checked later...
 642           TopLevId  -> pp_full_name
 643           DataConId _ _ _ _ _ _ _ -> pp_full_name
 644
 645           RecordSelId lbl -> ppr sty lbl
 646
 647             -- class-ish things: class already recorded as "mentioned"
 648           SuperDictSelId c sc
 649             -> ppCat [ppPStr SLIT("_SDSEL_"), pp_class c, pp_class sc]
 650           MethodSelId c o
 651             -> ppCat [ppPStr SLIT("_METH_"), pp_class c, pp_class_op o]
 652           DefaultMethodId c o _
 653             -> ppCat [ppPStr SLIT("_DEFM_"), pp_class c, pp_class_op o]
 654
 655             -- instance-ish things: should we try to figure out
 656             -- *exactly* which extra instances have to be exported? (ToDo)
 657           DictFunId  c t _
 658             -> ppCat [ppPStr SLIT("_DFUN_"), pp_class c, pp_type t]
 659           ConstMethodId c t o _
 660             -> ppCat [ppPStr SLIT("_CONSTM_"), pp_class c, pp_class_op o, pp_type t]
 661
 662           -- specialisations and workers
 663           SpecId unspec ty_maybes _
 664             -> let
 665                   pp = pprIdInUnfolding in_scopes unspec
 666                in
 667                ppCat [ppPStr SLIT("_SPEC_"), pp, ppLbrack,
 668                         ppIntersperse pp'SP{-'-} (map pp_ty_maybe ty_maybes),
 669                         ppRbrack]
 670
 671           WorkerId unwrkr
 672             -> let
 673                   pp = pprIdInUnfolding in_scopes unwrkr
 674                in
 675                ppBeside (ppPStr SLIT("_WRKR_ ")) pp
 676
 677           -- anything else? we're nae interested
 678           other_id -> panic "pprIdInUnfolding:mystery Id"
 679   where
 680     ppr_Unfolding = PprUnfolding (panic "Id:ppr_Unfolding")
 681
 682     pp_full_name
 683       = let
 684             (OrigName m_str n_str) = origName "Id:ppr_Unfolding" v
 685
 686             pp_n =
 687               if isLexSym n_str && not (isLexSpecialSym n_str) then
 688                   ppBesides [ppLparen, ppPStr n_str, ppRparen]
 689               else
 690                   ppPStr n_str
 691         in
 692         if isPreludeDefined v then
 693             pp_n
 694         else
 695             ppCat [ppPStr SLIT("_ORIG_"), ppPStr m_str, pp_n]
 696
 697     pp_class :: Class -> Pretty
 698     pp_class_op :: ClassOp -> Pretty
 699     pp_type :: Type -> Pretty
 700     pp_ty_maybe :: Maybe Type -> Pretty
 701
 702     pp_class    clas = ppr ppr_Unfolding clas
 703     pp_class_op op   = ppr ppr_Unfolding op
 704
 705     pp_type t = ppBesides [ppLparen, ppr ppr_Unfolding t, ppRparen]
 706
 707     pp_ty_maybe Nothing  = ppPStr SLIT("_N_")
 708     pp_ty_maybe (Just t) = pp_type t
 709 -}
 710 \end{code}
 711
 712 @whatsMentionedInId@ ferrets out the types/classes/instances on which
 713 this @Id@ depends.  If this Id is to appear in an interface, then
 714 those entities had Jolly Well be in scope.  Someone else up the
 715 call-tree decides that.
 716
 717 \begin{code}
 718 {-LATER:
 719 whatsMentionedInId
 720         :: IdSet                            -- Ids known to be in scope
 721         -> Id                               -- Id being processed
 722         -> (Bag Id, Bag TyCon, Bag Class)   -- mentioned Ids/TyCons/etc.
 723
 724 whatsMentionedInId in_scopes v
 725   = let
 726         v_ty = idType v
 727
 728         (tycons, clss)
 729           = getMentionedTyConsAndClassesFromType v_ty
 730
 731         result0 id_bag = (id_bag, tycons, clss)
 732
 733         result1 ids tcs cs
 734           = (ids `unionBags` unitBag v, -- we add v to "mentioned"...
 735              tcs `unionBags` tycons,
 736              cs  `unionBags` clss)
 737     in
 738     -- local vars first:
 739     if v `elementOfUniqSet` in_scopes then
 740         result0 emptyBag    -- v not added to "mentioned"
 741
 742     -- ones to think about:
 743     else
 744         let
 745             (Id _ _ _ v_details _ _) = v
 746         in
 747         case v_details of
 748           -- specialisations and workers
 749           SpecId unspec ty_maybes _
 750             -> let
 751                   (ids2, tcs2, cs2) = whatsMentionedInId in_scopes unspec
 752                in
 753                result1 ids2 tcs2 cs2
 754
 755           WorkerId unwrkr
 756             -> let
 757                   (ids2, tcs2, cs2) = whatsMentionedInId in_scopes unwrkr
 758                in
 759                result1 ids2 tcs2 cs2
 760
 761           anything_else -> result0 (unitBag v) -- v is  added to "mentioned"
 762 -}
 763 \end{code}
 764
 765 Tell them who my wrapper function is.
 766 \begin{code}
 767 {-LATER:
 768 myWrapperMaybe :: Id -> Maybe Id
 769
 770 myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper) _ _) = Just my_wrapper
 771 myWrapperMaybe other_id                           = Nothing
 772 -}
 773 \end{code}
 774
 775 \begin{code}
 776 unfoldingUnfriendlyId   -- return True iff it is definitely a bad
 777         :: Id           -- idea to export an unfolding that
 778         -> Bool         -- mentions this Id.  Reason: it cannot
 779                         -- possibly be seen in another module.
 780
 781 unfoldingUnfriendlyId id = panic "Id.unfoldingUnfriendlyId"
 782 {-LATER:
 783
 784 unfoldingUnfriendlyId id
 785   | not (externallyVisibleId id) -- that settles that...
 786   = True
 787
 788 unfoldingUnfriendlyId (Id _ _ _ (WorkerId wrapper) _ _)
 789   = class_thing wrapper
 790   where
 791     -- "class thing": If we're going to use this worker Id in
 792     -- an interface, we *have* to be able to untangle the wrapper's
 793     -- strictness when reading it back in.  At the moment, this
 794     -- is not always possible: in precisely those cases where
 795     -- we pass tcGenPragmas a "Nothing" for its "ty_maybe".
 796
 797     class_thing (Id _ _ _ (SuperDictSelId _ _) _ _)    = True
 798     class_thing (Id _ _ _ (MethodSelId _ _) _ _)           = True
 799     class_thing (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
 800     class_thing other                              = False
 801
 802 unfoldingUnfriendlyId (Id _ _ _ (SpecId d@(Id _ _ _ dfun@(DictFunId _ t _)) _ _) _ _)
 803     -- a SPEC of a DictFunId can end up w/ gratuitous
 804     -- TyVar(Templates) in the i/face; only a problem
 805     -- if -fshow-pragma-name-errs; but we can do without the pain.
 806     -- A HACK in any case (WDP 94/05/02)
 807   = naughty_DictFunId dfun
 808
 809 unfoldingUnfriendlyId d@(Id _ _ _ dfun@(DictFunId _ t _) _ _)
 810   = naughty_DictFunId dfun -- similar deal...
 811
 812 unfoldingUnfriendlyId other_id   = False -- is friendly in all other cases
 813
 814 naughty_DictFunId :: IdDetails -> Bool
 815     -- True <=> has a TyVar(Template) in the "type" part of its "name"
 816
 817 naughty_DictFunId (DictFunId _ _ _) = panic "False" -- came from outside; must be OK
 818 naughty_DictFunId (DictFunId _ ty _)
 819   = not (isGroundTy ty)
 820 -}
 821 \end{code}
 822
 823 @externallyVisibleId@: is it true that another module might be
 824 able to ``see'' this Id?
 825
 826 We need the @toplevelishId@ check as well as @isExported@ for when we
 827 compile instance declarations in the prelude.  @DictFunIds@ are
 828 ``exported'' if either their class or tycon is exported, but, in
 829 compiling the prelude, the compiler may not recognise that as true.
 830
 831 \begin{code}
 832 externallyVisibleId :: Id -> Bool
 833
 834 externallyVisibleId id@(Id _ _ _ details _ _)
 835   = if isLocallyDefined id then
 836         toplevelishId id && (isExported id || isDataCon id)
 837         -- NB: the use of "isExported" is most dodgy;
 838         -- We may eventually move to a situation where
 839         -- every Id is "externallyVisible", even if the
 840         -- module system's namespace control renders it
 841         -- "not exported".
 842     else
 843         True
 844         -- if visible here, it must be visible elsewhere, too.
 845 \end{code}
 846
 847 \begin{code}
 848 idWantsToBeINLINEd :: Id -> Bool
 849
 850 idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
 851 idWantsToBeINLINEd _                               = False
 852 \end{code}
 853
 854 For @unlocaliseId@: See the brief commentary in
 855 \tr{simplStg/SimplStg.lhs}.
 856
 857 \begin{code}
 858 {-LATER:
 859 unlocaliseId :: FAST_STRING{-modulename-} -> Id -> Maybe Id
 860
 861 unlocaliseId mod (Id u fn ty info TopLevId)
 862   = Just (Id u (unlocaliseFullName fn) ty info TopLevId)
 863
 864 unlocaliseId mod (Id u sn ty info (LocalId no_ftvs))
 865   = --false?: ASSERT(no_ftvs)
 866     let
 867         full_name = unlocaliseShortName mod u sn
 868     in
 869     Just (Id u full_name ty info TopLevId)
 870
 871 unlocaliseId mod (Id u sn ty info (SysLocalId no_ftvs))
 872   = --false?: on PreludeGlaST: ASSERT(no_ftvs)
 873     let
 874         full_name = unlocaliseShortName mod u sn
 875     in
 876     Just (Id u full_name ty info TopLevId)
 877
 878 unlocaliseId mod (Id u n ty info (SpecId unspec ty_maybes no_ftvs))
 879   = case unlocalise_parent mod u unspec of
 880       Nothing -> Nothing
 881       Just xx -> Just (Id u n ty info (SpecId xx ty_maybes no_ftvs))
 882
 883 unlocaliseId mod (Id u n ty info (WorkerId unwrkr))
 884   = case unlocalise_parent mod u unwrkr of
 885       Nothing -> Nothing
 886       Just xx -> Just (Id u n ty info (WorkerId xx))
 887
 888 unlocaliseId mod (Id u name ty info (InstId no_ftvs))
 889   = Just (Id u full_name ty info TopLevId)
 890         -- type might be wrong, but it hardly matters
 891         -- at this stage (just before printing C)  ToDo
 892   where
 893     name = nameOf (origName "Id.unlocaliseId" name)
 894     full_name = mkFullName mod name InventedInThisModule ExportAll mkGeneratedSrcLoc
 895
 896 unlocaliseId mod other_id = Nothing
 897
 898 --------------------
 899 -- we have to be Very Careful for workers/specs of
 900 -- local functions!
 901
 902 unlocalise_parent mod uniq (Id _ sn ty info (LocalId no_ftvs))
 903   = --false?: ASSERT(no_ftvs)
 904     let
 905         full_name = unlocaliseShortName mod uniq sn
 906     in
 907     Just (Id uniq full_name ty info TopLevId)
 908
 909 unlocalise_parent mod uniq (Id _ sn ty info (SysLocalId no_ftvs))
 910   = --false?: ASSERT(no_ftvs)
 911     let
 912         full_name = unlocaliseShortName mod uniq sn
 913     in
 914     Just (Id uniq full_name ty info TopLevId)
 915
 916 unlocalise_parent mod uniq other_id = unlocaliseId mod other_id
 917   -- we're OK otherwise
 918 -}
 919 \end{code}
 920
 921 CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
 922 `Top-levelish Ids'' cannot have any free type variables, so applying
 923 the type-env cannot have any effect.  (NB: checked in CoreLint?)
 924
 925 The special casing is in @applyTypeEnvToId@, not @apply_to_Id@, as the
 926 former ``should be'' the usual crunch point.
 927
 928 \begin{code}
 929 type TypeEnv = TyVarEnv Type
 930
 931 applyTypeEnvToId :: TypeEnv -> Id -> Id
 932
 933 applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
 934   | idHasNoFreeTyVars id
 935   = id
 936   | otherwise
 937   = apply_to_Id ( \ ty ->
 938         applyTypeEnvToTy type_env ty
 939     ) id
 940 \end{code}
 941
 942 \begin{code}
 943 apply_to_Id :: (Type -> Type) -> Id -> Id
 944
 945 apply_to_Id ty_fn (Id u n ty details prag info)
 946   = let
 947         new_ty = ty_fn ty
 948     in
 949     Id u n new_ty (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
 950   where
 951     apply_to_details (SpecId unspec ty_maybes no_ftvs)
 952       = let
 953             new_unspec = apply_to_Id ty_fn unspec
 954             new_maybes = map apply_to_maybe ty_maybes
 955         in
 956         SpecId new_unspec new_maybes (no_free_tvs ty)
 957         -- ToDo: gratuitous recalc no_ftvs???? (also InstId)
 958       where
 959         apply_to_maybe Nothing   = Nothing
 960         apply_to_maybe (Just ty) = Just (ty_fn ty)
 961
 962     apply_to_details (WorkerId unwrkr)
 963       = let
 964             new_unwrkr = apply_to_Id ty_fn unwrkr
 965         in
 966         WorkerId new_unwrkr
 967
 968     apply_to_details other = other
 969 \end{code}
 970
 971 Sadly, I don't think the one using the magic typechecker substitution
 972 can be done with @apply_to_Id@.  Here we go....
 973
 974 Strictness is very important here.  We can't leave behind thunks
 975 with pointers to the substitution: it {\em must} be single-threaded.
 976
 977 \begin{code}
 978 {-LATER:
 979 applySubstToId :: Subst -> Id -> (Subst, Id)
 980
 981 applySubstToId subst id@(Id u n ty info details)
 982   -- *cannot* have a "idHasNoFreeTyVars" get-out clause
 983   -- because, in the typechecker, we are still
 984   -- *concocting* the types.
 985   = case (applySubstToTy     subst ty)          of { (s2, new_ty)      ->
 986     case (applySubstToIdInfo s2    info)        of { (s3, new_info)    ->
 987     case (apply_to_details   s3 new_ty details) of { (s4, new_details) ->
 988     (s4, Id u n new_ty new_info new_details) }}}
 989   where
 990     apply_to_details subst _ (InstId inst no_ftvs)
 991       = case (applySubstToInst subst inst) of { (s2, new_inst) ->
 992         (s2, InstId new_inst no_ftvs{-ToDo:right???-}) }
 993
 994     apply_to_details subst new_ty (SpecId unspec ty_maybes _)
 995       = case (applySubstToId subst unspec)           of { (s2, new_unspec) ->
 996         case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
 997         (s3, SpecId new_unspec new_maybes (no_free_tvs new_ty)) }}
 998         -- NB: recalc no_ftvs (I think it's necessary (?) WDP 95/04)
 999       where
1000         apply_to_maybe subst Nothing   = (subst, Nothing)
1001         apply_to_maybe subst (Just ty)
1002           = case (applySubstToTy subst ty) of { (s2, new_ty) ->
1003             (s2, Just new_ty) }
1004
1005     apply_to_details subst _ (WorkerId unwrkr)
1006       = case (applySubstToId subst unwrkr) of { (s2, new_unwrkr) ->
1007         (s2, WorkerId new_unwrkr) }
1008
1009     apply_to_details subst _ other = (subst, other)
1010 -}
1011 \end{code}
1012
1013 %************************************************************************
1014 %*                                                                      *
1015 \subsection[Id-type-funs]{Type-related @Id@ functions}
1016 %*                                                                      *
1017 %************************************************************************
1018
1019 \begin{code}
1020 idType :: GenId ty -> ty
1021
1022 idType (Id _ _ ty _ _ _) = ty
1023 \end{code}
1024
1025 \begin{code}
1026 {-LATER:
1027 getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)
1028
1029 getMentionedTyConsAndClassesFromId id
1030  = getMentionedTyConsAndClassesFromType (idType id)
1031 -}
1032 \end{code}
1033
1034 \begin{code}
1035 idPrimRep i = typePrimRep (idType i)
1036 \end{code}
1037
1038 \begin{code}
1039 {-LATER:
1040 getInstIdModule (Id _ _ _ (DictFunId _ _ mod)) = mod
1041 getInstIdModule (Id _ _ _ (ConstMethodId _ _ _ mod)) = mod
1042 getInstIdModule other = panic "Id:getInstIdModule"
1043 -}
1044 \end{code}
1045
1046 %************************************************************************
1047 %*                                                                      *
1048 \subsection[Id-overloading]{Functions related to overloading}
1049 %*                                                                      *
1050 %************************************************************************
1051
1052 \begin{code}
1053 mkSuperDictSelId u c sc ty info
1054   = mk_classy_id (SuperDictSelId c sc) SLIT("sdsel") (Left (origName "mkSuperDictSelId" sc)) u c ty info
1055
1056 mkMethodSelId u rec_c op ty info
1057   = mk_classy_id (MethodSelId rec_c op) SLIT("meth") (Right (classOpString op)) u rec_c ty info
1058
1059 mkDefaultMethodId u rec_c op gen ty info
1060   = mk_classy_id (DefaultMethodId rec_c op gen) SLIT("defm") (Right (classOpString op)) u rec_c ty info
1061
1062 mk_classy_id details str op_str u rec_c ty info
1063   = Id u n ty details NoPragmaInfo info
1064   where
1065     cname = getName rec_c -- we get other info out of here
1066     cname_orig = origName "mk_classy_id" cname
1067     cmod = moduleOf cname_orig
1068
1069     n = mkCompoundName u cmod str [Left cname_orig, op_str] cname
1070
1071 mkDictFunId u c ity full_ty from_here locn mod info
1072   = Id u n full_ty (DictFunId c ity mod) NoPragmaInfo info
1073   where
1074     n = mkCompoundName2 u mod SLIT("dfun") (Left (origName "mkDictFunId" c) : renum_type_string full_ty ity) from_here locn
1075
1076 mkConstMethodId u c op ity full_ty from_here locn mod info
1077   = Id u n full_ty (ConstMethodId c ity op mod) NoPragmaInfo info
1078   where
1079     n = mkCompoundName2 u mod SLIT("const") (Left (origName "mkConstMethodId" c) : Right (classOpString op) : renum_type_string full_ty ity) from_here locn
1080
1081 renum_type_string full_ty ity
1082   = initNmbr (
1083         nmbrType full_ty    `thenNmbr` \ _ -> -- so all the tyvars get added to renumbering...
1084         nmbrType ity        `thenNmbr` \ rn_ity ->
1085         returnNmbr (getTypeString rn_ity)
1086     )
1087
1088 mkWorkerId u unwrkr ty info
1089   = Id u n ty (WorkerId unwrkr) NoPragmaInfo info
1090   where
1091     unwrkr_name = getName unwrkr
1092     unwrkr_orig = trace "mkWorkerId:origName:" $ origName "mkWorkerId" unwrkr_name
1093     umod = moduleOf unwrkr_orig
1094
1095     n = mkCompoundName u umod SLIT("wrk") [Left unwrkr_orig] unwrkr_name
1096
1097 mkInstId u ty name = Id u (changeUnique name u) ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
1098
1099 {-LATER:
1100 getConstMethodId clas op ty
1101   = -- constant-method info is hidden in the IdInfo of
1102     -- the class-op id (as mentioned up above).
1103     let
1104         sel_id = getMethodSelId clas op
1105     in
1106     case (lookupConstMethodId (getIdSpecialisation sel_id) ty) of
1107       Just xx -> xx
1108       Nothing -> pprError "ERROR: getConstMethodId:" (ppAboves [
1109         ppCat [ppr PprDebug ty, ppr PprDebug ops, ppr PprDebug op_ids,
1110                ppr PprDebug sel_id],
1111         ppStr "(This can arise if an interface pragma refers to an instance",
1112         ppStr "but there is no imported interface which *defines* that instance.",
1113         ppStr "The info above, however ugly, should indicate what else you need to import."
1114         ])
1115 -}
1116 \end{code}
1117
1118 %************************************************************************
1119 %*                                                                      *
1120 \subsection[local-funs]{@LocalId@-related functions}
1121 %*                                                                      *
1122 %************************************************************************
1123
1124 \begin{code}
1125 mkImported  n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
1126
1127 {-LATER:
1128 updateIdType :: Id -> Type -> Id
1129 updateIdType (Id u n _ info details) ty = Id u n ty info details
1130 -}
1131 \end{code}
1132
1133 \begin{code}
1134 type MyTy a b = GenType (GenTyVar a) b
1135 type MyId a b = GenId (MyTy a b)
1136
1137 no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
1138
1139 -- SysLocal: for an Id being created by the compiler out of thin air...
1140 -- UserLocal: an Id with a name the user might recognize...
1141 mkSysLocal, mkUserLocal :: FAST_STRING -> Unique -> MyTy a b -> SrcLoc -> MyId a b
1142
1143 mkSysLocal str uniq ty loc
1144   = Id uniq (mkLocalName uniq str True{-emph uniq-} loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
1145
1146 mkUserLocal str uniq ty loc
1147   = Id uniq (mkLocalName uniq str False{-emph name-} loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
1148
1149 -- mkUserId builds a local or top-level Id, depending on the name given
1150 mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
1151 mkUserId name ty pragma_info
1152   | isLocalName name
1153   = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
1154   | otherwise
1155   = Id (nameUnique name) name ty
1156         (if isLocallyDefinedName name then TopLevId else ImportedId)
1157         pragma_info noIdInfo
1158 \end{code}
1159
1160
1161 \begin{code}
1162 {-LATER:
1163
1164 -- for a SpecPragmaId being created by the compiler out of thin air...
1165 mkSpecPragmaId :: FAST_STRING -> Unique -> Type -> Maybe Id -> SrcLoc -> Id
1166 mkSpecPragmaId str uniq ty specid loc
1167   = Id uniq (mkShortName str loc) ty noIdInfo (SpecPragmaId specid (no_free_tvs ty))
1168
1169 -- for new SpecId
1170 mkSpecId u unspec ty_maybes ty info
1171   = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
1172     Id u n ty info (SpecId unspec ty_maybes (no_free_tvs ty))
1173
1174 -- Specialised version of constructor: only used in STG and code generation
1175 -- Note: The specialsied Id has the same unique as the unspeced Id
1176
1177 mkSameSpecCon ty_maybes unspec@(Id u n ty info details)
1178   = ASSERT(isDataCon unspec)
1179     ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
1180     Id u n new_ty info (SpecId unspec ty_maybes (no_free_tvs new_ty))
1181   where
1182     new_ty = specialiseTy ty ty_maybes 0
1183
1184 localiseId :: Id -> Id
1185 localiseId id@(Id u n ty info details)
1186   = Id u (mkShortName name loc) ty info (LocalId (no_free_tvs ty))
1187   where
1188     name = getOccName id
1189     loc  = getSrcLoc id
1190 -}
1191
1192 mkIdWithNewUniq :: Id -> Unique -> Id
1193
1194 mkIdWithNewUniq (Id _ n ty details prag info) u
1195   = Id u (changeUnique n u) ty details prag info
1196 \end{code}
1197
1198 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
1199 @Uniques@, but that's OK because the templates are supposed to be
1200 instantiated before use.
1201 \begin{code}
1202 mkTemplateLocals :: [Type] -> [Id]
1203 mkTemplateLocals tys
1204   = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
1205             (getBuiltinUniques (length tys))
1206             tys
1207 \end{code}
1208
1209 \begin{code}
1210 getIdInfo     :: GenId ty -> IdInfo
1211 getPragmaInfo :: GenId ty -> PragmaInfo
1212
1213 getIdInfo     (Id _ _ _ _ _ info) = info
1214 getPragmaInfo (Id _ _ _ _ info _) = info
1215
1216 {-LATER:
1217 replaceIdInfo :: Id -> IdInfo -> Id
1218
1219 replaceIdInfo (Id u n ty _ details) info = Id u n ty info details
1220
1221 selectIdInfoForSpecId :: Id -> IdInfo
1222 selectIdInfoForSpecId unspec
1223   = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
1224     noIdInfo `addInfo_UF` getIdUnfolding unspec
1225 -}
1226 \end{code}
1227
1228 %************************************************************************
1229 %*                                                                      *
1230 \subsection[Id-arities]{Arity-related functions}
1231 %*                                                                      *
1232 %************************************************************************
1233
1234 For locally-defined Ids, the code generator maintains its own notion
1235 of their arities; so it should not be asking...  (but other things
1236 besides the code-generator need arity info!)
1237
1238 \begin{code}
1239 getIdArity :: Id -> ArityInfo
1240 getIdArity id@(Id _ _ _ _ _ id_info)
1241   = --ASSERT( not (isDataCon id))
1242     getInfo id_info
1243
1244 dataConArity, dataConNumFields :: DataCon -> Int
1245
1246 dataConArity id@(Id _ _ _ _ _ id_info)
1247   = ASSERT(isDataCon id)
1248     case (arityMaybe (getInfo id_info)) of
1249       Just  i -> i
1250       Nothing -> pprPanic "dataConArity:Nothing:" (pprId PprDebug id)
1251
1252 dataConNumFields id
1253   = ASSERT(isDataCon id)
1254     case (dataConSig id) of { (_, _, arg_tys, _) ->
1255     length arg_tys }
1256
1257 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
1258
1259 addIdArity :: Id -> Int -> Id
1260 addIdArity (Id u n ty details pinfo info) arity
1261   = Id u n ty details pinfo (info `addInfo` (mkArityInfo arity))
1262 \end{code}
1263
1264 %************************************************************************
1265 %*                                                                      *
1266 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
1267 %*                                                                      *
1268 %************************************************************************
1269
1270 \begin{code}
1271 mkDataCon :: Name
1272           -> [StrictnessMark] -> [FieldLabel]
1273           -> [TyVar] -> ThetaType -> [TauType] -> TyCon
1274 --ToDo:   -> SpecEnv
1275           -> Id
1276   -- can get the tag and all the pieces of the type from the Type
1277
1278 mkDataCon n stricts fields tvs ctxt args_tys tycon
1279   = ASSERT(length stricts == length args_tys)
1280     data_con
1281   where
1282     -- NB: data_con self-recursion; should be OK as tags are not
1283     -- looked at until late in the game.
1284     data_con
1285       = Id (nameUnique n)
1286            n
1287            type_of_constructor
1288            (DataConId data_con_tag stricts fields tvs ctxt args_tys tycon)
1289            IWantToBeINLINEd     -- Always inline constructors if possible
1290            datacon_info
1291
1292     data_con_tag    = position_within fIRST_TAG data_con_family
1293
1294     data_con_family = tyConDataCons tycon
1295
1296     position_within :: Int -> [Id] -> Int
1297
1298     position_within acc (c:cs)
1299       = if c == data_con then acc else position_within (acc+1) cs
1300 #ifdef DEBUG
1301     position_within acc []
1302       = panic "mkDataCon: con not found in family"
1303 #endif
1304
1305     type_of_constructor
1306       = mkSigmaTy tvs ctxt
1307         (mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
1308
1309     datacon_info = noIdInfo `addInfo_UF` unfolding
1310                             `addInfo` mkArityInfo arity
1311 --ToDo:                     `addInfo` specenv
1312
1313     arity = length ctxt + length args_tys
1314
1315     unfolding
1316       = noInfo_UF
1317 {- LATER:
1318       = -- if arity == 0
1319         -- then noIdInfo
1320         -- else -- do some business...
1321         let
1322             (tyvars, dict_vars, vars) = mk_uf_bits tvs ctxt args_tys tycon
1323             tyvar_tys = mkTyVarTys tyvars
1324         in
1325         case (Con data_con tyvar_tys [VarArg v | v <- vars]) of { plain_Con ->
1326
1327         mkUnfolding EssentialUnfolding -- for data constructors
1328                     (mkLam tyvars (dict_vars ++ vars) plain_Con)
1329         }
1330
1331     mk_uf_bits tvs ctxt arg_tys tycon
1332       = let
1333             (inst_env, tyvars, tyvar_tys)
1334               = instantiateTyVarTemplates tvs
1335                                           (map uniqueOf tvs)
1336         in
1337             -- the "context" and "arg_tys" have TyVarTemplates in them, so
1338             -- we instantiate those types to have the right TyVars in them
1339             -- instead.
1340         case (map (instantiateTauTy inst_env) (map ctxt_ty ctxt))
1341                                                         of { inst_dict_tys ->
1342         case (map (instantiateTauTy inst_env) arg_tys)  of { inst_arg_tys ->
1343
1344             -- We can only have **ONE** call to mkTemplateLocals here;
1345             -- otherwise, we get two blobs of locals w/ mixed-up Uniques
1346             -- (Mega-Sigh) [ToDo]
1347         case (mkTemplateLocals (inst_dict_tys ++ inst_arg_tys)) of { all_vars ->
1348
1349         case (splitAt (length ctxt) all_vars)   of { (dict_vars, vars) ->
1350
1351         (tyvars, dict_vars, vars)
1352         }}}}
1353       where
1354         -- these are really dubious Types, but they are only to make the
1355         -- binders for the lambdas for tossed-away dicts.
1356         ctxt_ty (clas, ty) = mkDictTy clas ty
1357 -}
1358 \end{code}
1359
1360 \begin{code}
1361 mkTupleCon :: Arity -> Id
1362
1363 mkTupleCon arity
1364   = Id unique n ty (TupleConId arity) NoPragmaInfo tuplecon_info
1365   where
1366     n           = mkTupleDataConName arity
1367     unique      = uniqueOf n
1368     ty          = mkSigmaTy tyvars []
1369                    (mkFunTys tyvar_tys (applyTyCon tycon tyvar_tys))
1370     tycon       = mkTupleTyCon arity
1371     tyvars      = take arity alphaTyVars
1372     tyvar_tys   = mkTyVarTys tyvars
1373
1374     tuplecon_info
1375       = noIdInfo `addInfo_UF` unfolding
1376                  `addInfo` mkArityInfo arity
1377 --LATER:?        `addInfo` panic "Id:mkTupleCon:pcGenerateTupleSpecs arity ty"
1378
1379     unfolding
1380       = noInfo_UF
1381 {- LATER:
1382       = -- if arity == 0
1383         -- then noIdInfo
1384         -- else -- do some business...
1385         let
1386             (tyvars, dict_vars, vars) = mk_uf_bits arity
1387             tyvar_tys = mkTyVarTys tyvars
1388         in
1389         case (Con data_con tyvar_tys [VarArg v | v <- vars]) of { plain_Con ->
1390         mkUnfolding
1391             EssentialUnfolding    -- data constructors
1392             (mkLam tyvars (dict_vars ++ vars) plain_Con) }
1393
1394     mk_uf_bits arity
1395       = case (mkTemplateLocals tyvar_tys) of { vars ->
1396         (tyvars, [], vars) }
1397       where
1398         tyvar_tmpls     = take arity alphaTyVars
1399         (_, tyvars, tyvar_tys) = instantiateTyVarTemplates tyvar_tmpls (map uniqueOf tyvar_tmpls)
1400 -}
1401
1402 fIRST_TAG :: ConTag
1403 fIRST_TAG =  1  -- Tags allocated from here for real constructors
1404 \end{code}
1405
1406 \begin{code}
1407 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
1408 dataConTag (Id _ _ _ (DataConId tag _ _ _ _ _ _) _ _) = tag
1409 dataConTag (Id _ _ _ (TupleConId _) _ _)              = fIRST_TAG
1410 dataConTag (Id _ _ _ (SpecId unspec _ _) _ _)         = dataConTag unspec
1411
1412 dataConTyCon :: DataCon -> TyCon        -- will panic if not a DataCon
1413 dataConTyCon (Id _ _ _ (DataConId _ _ _ _ _ _ tycon) _ _) = tycon
1414 dataConTyCon (Id _ _ _ (TupleConId a) _ _)                = mkTupleTyCon a
1415
1416 dataConSig :: DataCon -> ([TyVar], ThetaType, [TauType], TyCon)
1417                                         -- will panic if not a DataCon
1418
1419 dataConSig (Id _ _ _ (DataConId _ _ _ tyvars theta_ty arg_tys tycon) _ _)
1420   = (tyvars, theta_ty, arg_tys, tycon)
1421
1422 dataConSig (Id _ _ _ (TupleConId arity) _ _)
1423   = (tyvars, [], tyvar_tys, mkTupleTyCon arity)
1424   where
1425     tyvars      = take arity alphaTyVars
1426     tyvar_tys   = mkTyVarTys tyvars
1427
1428 dataConFieldLabels :: DataCon -> [FieldLabel]
1429 dataConFieldLabels (Id _ _ _ (DataConId _ _ fields _ _ _ _) _ _) = fields
1430 dataConFieldLabels (Id _ _ _ (TupleConId _)                 _ _) = []
1431
1432 dataConStrictMarks :: DataCon -> [StrictnessMark]
1433 dataConStrictMarks (Id _ _ _ (DataConId _ stricts _ _ _ _ _) _ _) = stricts
1434 dataConStrictMarks (Id _ _ _ (TupleConId arity)              _ _)
1435   = nOfThem arity NotMarkedStrict
1436
1437 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
1438 dataConRawArgTys con = case (dataConSig con) of { (_,_, arg_tys,_) -> arg_tys }
1439
1440 dataConArgTys :: DataCon
1441               -> [Type]         -- Instantiated at these types
1442               -> [Type]         -- Needs arguments of these types
1443 dataConArgTys con_id inst_tys
1444  = map (instantiateTy tenv) arg_tys
1445  where
1446     (tyvars, _, arg_tys, _) = dataConSig con_id
1447     tenv                    = zipEqual "dataConArgTys" tyvars inst_tys
1448 \end{code}
1449
1450 \begin{code}
1451 mkRecordSelId field_label selector_ty
1452   = Id (nameUnique name)
1453        name
1454        selector_ty
1455        (RecordSelId field_label)
1456        NoPragmaInfo
1457        noIdInfo
1458   where
1459     name = fieldLabelName field_label
1460
1461 recordSelectorFieldLabel :: Id -> FieldLabel
1462 recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1463 \end{code}
1464
1465
1466 Data type declarations are of the form:
1467 \begin{verbatim}
1468 data Foo a b = C1 ... | C2 ... | ... | Cn ...
1469 \end{verbatim}
1470 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
1471 @C1 x y z@, we want a function binding:
1472 \begin{verbatim}
1473 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1474 \end{verbatim}
1475 Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1476 2nd-order polymorphic lambda calculus with explicit types.
1477
1478 %************************************************************************
1479 %*                                                                      *
1480 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1481 %*                                                                      *
1482 %************************************************************************
1483
1484 @getIdUnfolding@ takes a @Id@ (we are discussing the @DataCon@ case)
1485 and generates an @UnfoldingDetails@ for its unfolding.  The @Ids@ and
1486 @TyVars@ don't really have to be new, because we are only producing a
1487 template.
1488
1489 ToDo: what if @DataConId@'s type has a context (haven't thought about it
1490 --WDP)?
1491
1492 Note: @getDataConUnfolding@ is a ``poor man's'' version---it is NOT
1493 EXPORTED.  It just returns the binders (@TyVars@ and @Ids@) [in the
1494 example above: a, b, and x, y, z], which is enough (in the important
1495 \tr{DsExpr} case).  (The middle set of @Ids@ is binders for any
1496 dictionaries, in the even of an overloaded data-constructor---none at
1497 present.)
1498
1499 \begin{code}
1500 getIdUnfolding :: Id -> UnfoldingDetails
1501
1502 getIdUnfolding (Id _ _ _ _ _ info) = getInfo_UF info
1503
1504 {-LATER:
1505 addIdUnfolding :: Id -> UnfoldingDetails -> Id
1506 addIdUnfolding id@(Id u n ty info details) unfold_details
1507   = ASSERT(
1508         case (isLocallyDefined id, unfold_details) of
1509         (_,     NoUnfoldingDetails) -> True
1510         (True,  IWantToBeINLINEd _) -> True
1511         (False, IWantToBeINLINEd _) -> False -- v bad
1512         (False, _)                  -> True
1513         _                           -> False -- v bad
1514     )
1515     Id u n ty (info `addInfo_UF` unfold_details) details
1516 -}
1517 \end{code}
1518
1519 In generating selector functions (take a dictionary, give back one
1520 component...), we need to what out for the nothing-to-select cases (in
1521 which case the ``selector'' is just an identity function):
1522 \begin{verbatim}
1523 class Eq a => Foo a { }     # the superdict selector for "Eq"
1524
1525 class Foo a { op :: Complex b => c -> b -> a }
1526                             # the method selector for "op";
1527                             # note local polymorphism...
1528 \end{verbatim}
1529
1530 %************************************************************************
1531 %*                                                                      *
1532 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1533 %*                                                                      *
1534 %************************************************************************
1535
1536 \begin{code}
1537 getIdDemandInfo :: Id -> DemandInfo
1538 getIdDemandInfo (Id _ _ _ _ _ info) = getInfo info
1539
1540 addIdDemandInfo :: Id -> DemandInfo -> Id
1541 addIdDemandInfo (Id u n ty details prags info) demand_info
1542   = Id u n ty details prags (info `addInfo` demand_info)
1543 \end{code}
1544
1545 \begin{code}
1546 getIdUpdateInfo :: Id -> UpdateInfo
1547 getIdUpdateInfo (Id _ _ _ _ _ info) = getInfo info
1548
1549 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1550 addIdUpdateInfo (Id u n ty details prags info) upd_info
1551   = Id u n ty details prags (info `addInfo` upd_info)
1552 \end{code}
1553
1554 \begin{code}
1555 {- LATER:
1556 getIdArgUsageInfo :: Id -> ArgUsageInfo
1557 getIdArgUsageInfo (Id u n ty info details) = getInfo info
1558
1559 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1560 addIdArgUsageInfo (Id u n ty info details) au_info
1561   = Id u n ty (info `addInfo` au_info) details
1562 -}
1563 \end{code}
1564
1565 \begin{code}
1566 {- LATER:
1567 getIdFBTypeInfo :: Id -> FBTypeInfo
1568 getIdFBTypeInfo (Id u n ty info details) = getInfo info
1569
1570 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1571 addIdFBTypeInfo (Id u n ty info details) upd_info
1572   = Id u n ty (info `addInfo` upd_info) details
1573 -}
1574 \end{code}
1575
1576 \begin{code}
1577 {- LATER:
1578 getIdSpecialisation :: Id -> SpecEnv
1579 getIdSpecialisation (Id _ _ _ _ _ info) = getInfo info
1580
1581 addIdSpecialisation :: Id -> SpecEnv -> Id
1582 addIdSpecialisation (Id u n ty details prags info) spec_info
1583   = Id u n ty details prags (info `addInfo` spec_info)
1584 -}
1585 \end{code}
1586
1587 Strictness: we snaffle the info out of the IdInfo.
1588
1589 \begin{code}
1590 getIdStrictness :: Id -> StrictnessInfo
1591
1592 getIdStrictness (Id _ _ _ _ _ info) = getInfo info
1593
1594 addIdStrictness :: Id -> StrictnessInfo -> Id
1595
1596 addIdStrictness (Id u n ty details prags info) strict_info
1597   = Id u n ty details prags (info `addInfo` strict_info)
1598 \end{code}
1599
1600 %************************************************************************
1601 %*                                                                      *
1602 \subsection[Id-comparison]{Comparison functions for @Id@s}
1603 %*                                                                      *
1604 %************************************************************************
1605
1606 Comparison: equality and ordering---this stuff gets {\em hammered}.
1607
1608 \begin{code}
1609 cmpId (Id u1 _ _ _ _ _) (Id u2 _ _ _ _ _) = cmp u1 u2
1610 -- short and very sweet
1611 \end{code}
1612
1613 \begin{code}
1614 instance Ord3 (GenId ty) where
1615     cmp = cmpId
1616
1617 instance Eq (GenId ty) where
1618     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
1619     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True  }
1620
1621 instance Ord (GenId ty) where
1622     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
1623     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
1624     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
1625     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
1626     _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
1627 \end{code}
1628
1629 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1630 account when comparing two data constructors. We need to do this
1631 because a specialised data constructor has the same Unique as its
1632 unspecialised counterpart.
1633
1634 \begin{code}
1635 cmpId_withSpecDataCon :: Id -> Id -> TAG_
1636
1637 cmpId_withSpecDataCon id1 id2
1638   | eq_ids && isDataCon id1 && isDataCon id2
1639   = cmpEqDataCon id1 id2
1640
1641   | otherwise
1642   = cmp_ids
1643   where
1644     cmp_ids = cmpId id1 id2
1645     eq_ids  = case cmp_ids of { EQ_ -> True; other -> False }
1646
1647 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _) _ _) (Id _ _ _ (SpecId _ mtys2 _) _ _)
1648   = panic# "Id.cmpEqDataCon:cmpUniTypeMaybeList mtys1 mtys2"
1649
1650 cmpEqDataCon _ (Id _ _ _ (SpecId _ _ _) _ _) = LT_
1651 cmpEqDataCon (Id _ _ _ (SpecId _ _ _) _ _) _ = GT_
1652 cmpEqDataCon _                             _ = EQ_
1653 \end{code}
1654
1655 %************************************************************************
1656 %*                                                                      *
1657 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1658 %*                                                                      *
1659 %************************************************************************
1660
1661 \begin{code}
1662 instance Outputable ty => Outputable (GenId ty) where
1663     ppr sty id = pprId sty id
1664
1665 -- and a SPECIALIZEd one:
1666 instance Outputable {-Id, i.e.:-}(GenId Type) where
1667     ppr sty id = pprId sty id
1668
1669 showId :: PprStyle -> Id -> String
1670 showId sty id = ppShow 80 (pprId sty id)
1671 \end{code}
1672
1673 Default printing code (not used for interfaces):
1674 \begin{code}
1675 pprId :: Outputable ty => PprStyle -> GenId ty -> Pretty
1676
1677 pprId sty (Id u n _ _ _ _) = ppr sty n
1678   -- WDP 96/05/06: We can re-elaborate this as we go along...
1679 \end{code}
1680
1681 \begin{code}
1682 idUnique (Id u _ _ _ _ _) = u
1683
1684 instance Uniquable (GenId ty) where
1685     uniqueOf = idUnique
1686
1687 instance NamedThing (GenId ty) where
1688     getName this_id@(Id u n _ details _ _) = n
1689 \end{code}
1690
1691 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
1692 the @Uniques@ out of local @Ids@ given to it.
1693
1694 %************************************************************************
1695 %*                                                                      *
1696 \subsection{@IdEnv@s and @IdSet@s}
1697 %*                                                                      *
1698 %************************************************************************
1699
1700 \begin{code}
1701 type IdEnv elt = UniqFM elt
1702
1703 nullIdEnv         :: IdEnv a
1704
1705 mkIdEnv           :: [(GenId ty, a)] -> IdEnv a
1706 unitIdEnv         :: GenId ty -> a -> IdEnv a
1707 addOneToIdEnv     :: IdEnv a -> GenId ty -> a -> IdEnv a
1708 growIdEnv         :: IdEnv a -> IdEnv a -> IdEnv a
1709 growIdEnvList     :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
1710
1711 delManyFromIdEnv  :: IdEnv a -> [GenId ty] -> IdEnv a
1712 delOneFromIdEnv   :: IdEnv a -> GenId ty -> IdEnv a
1713 combineIdEnvs     :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
1714 mapIdEnv          :: (a -> b) -> IdEnv a -> IdEnv b
1715 modifyIdEnv       :: IdEnv a -> (a -> a) -> GenId ty -> IdEnv a
1716 rngIdEnv          :: IdEnv a -> [a]
1717
1718 isNullIdEnv       :: IdEnv a -> Bool
1719 lookupIdEnv       :: IdEnv a -> GenId ty -> Maybe a
1720 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
1721 \end{code}
1722
1723 \begin{code}
1724 addOneToIdEnv    = addToUFM
1725 combineIdEnvs    = plusUFM_C
1726 delManyFromIdEnv = delListFromUFM
1727 delOneFromIdEnv  = delFromUFM
1728 growIdEnv        = plusUFM
1729 lookupIdEnv      = lookupUFM
1730 mapIdEnv         = mapUFM
1731 mkIdEnv          = listToUFM
1732 nullIdEnv        = emptyUFM
1733 rngIdEnv         = eltsUFM
1734 unitIdEnv        = unitUFM
1735
1736 growIdEnvList     env pairs = plusUFM env (listToUFM pairs)
1737 isNullIdEnv       env       = sizeUFM env == 0
1738 lookupNoFailIdEnv env id    = case (lookupIdEnv env id) of { Just xx -> xx }
1739
1740 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
1741 -- modify function, and put it back.
1742
1743 modifyIdEnv env mangle_fn key
1744   = case (lookupIdEnv env key) of
1745       Nothing -> env
1746       Just xx -> addOneToIdEnv env key (mangle_fn xx)
1747 \end{code}
1748
1749 \begin{code}
1750 type GenIdSet ty = UniqSet (GenId ty)
1751 type IdSet       = UniqSet (GenId Type)
1752
1753 emptyIdSet      :: GenIdSet ty
1754 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1755 unionIdSets     :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1756 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
1757 idSetToList     :: GenIdSet ty -> [GenId ty]
1758 unitIdSet       :: GenId ty -> GenIdSet ty
1759 addOneToIdSet   :: GenIdSet ty -> GenId ty -> GenIdSet ty
1760 elementOfIdSet  :: GenId ty -> GenIdSet ty -> Bool
1761 minusIdSet      :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1762 isEmptyIdSet    :: GenIdSet ty -> Bool
1763 mkIdSet         :: [GenId ty] -> GenIdSet ty
1764
1765 emptyIdSet      = emptyUniqSet
1766 unitIdSet       = unitUniqSet
1767 addOneToIdSet   = addOneToUniqSet
1768 intersectIdSets = intersectUniqSets
1769 unionIdSets     = unionUniqSets
1770 unionManyIdSets = unionManyUniqSets
1771 idSetToList     = uniqSetToList
1772 elementOfIdSet  = elementOfUniqSet
1773 minusIdSet      = minusUniqSet
1774 isEmptyIdSet    = isEmptyUniqSet
1775 mkIdSet         = mkUniqSet
1776 \end{code}
1777
1778 \begin{code}
1779 addId, nmbrId, nmbrDataCon :: Id -> NmbrM Id
1780
1781 addId id@(Id u n ty det prag info) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
1782   = case (lookupUFM_Directly idenv u) of
1783       Just xx -> trace "addId: already in map!" $
1784                  (nenv, xx)
1785       Nothing ->
1786         if toplevelishId id then
1787             trace "addId: can't add toplevelish!" $
1788             (nenv, id)
1789         else -- alloc a new unique for this guy
1790              -- and add an entry in the idenv
1791              -- NB: *** KNOT-TYING ***
1792             let
1793                 nenv_plus_id    = NmbrEnv (incrUnique ui) ut uu
1794                                           (addToUFM_Directly idenv u new_id)
1795                                           tvenv uvenv
1796
1797                 (nenv2, new_ty)  = nmbrType     ty  nenv_plus_id
1798                 (nenv3, new_det) = nmbr_details det nenv2
1799
1800                 new_id = Id ui n new_ty new_det prag info
1801             in
1802             (nenv3, new_id)
1803
1804 nmbrId id@(Id u n ty det prag info) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
1805   = case (lookupUFM_Directly idenv u) of
1806       Just xx -> (nenv, xx)
1807       Nothing ->
1808         if not (toplevelishId id) then
1809             trace "nmbrId: lookup failed" $
1810             (nenv, id)
1811         else
1812             let
1813                 (nenv2, new_ty)  = nmbrType     ty  nenv
1814                 (nenv3, new_det) = nmbr_details det nenv2
1815
1816                 new_id = Id u n new_ty new_det prag info
1817             in
1818             (nenv3, new_id)
1819
1820     -- used when renumbering TyCons to produce data decls...
1821 nmbrDataCon id@(Id _ _ _ (TupleConId _) _ _) nenv
1822   = (nenv, id) -- nothing to do for tuples
1823
1824 nmbrDataCon id@(Id u n ty (DataConId tag marks fields tvs theta arg_tys tc) prag info) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
1825   = case (lookupUFM_Directly idenv u) of
1826       Just xx -> trace "nmbrDataCon: in env???\n" (nenv, xx)
1827       Nothing ->
1828         let
1829             (nenv2, new_fields)  = (mapNmbr nmbrField  fields)  nenv
1830             (nenv3, new_arg_tys) = (mapNmbr nmbrType   arg_tys) nenv2
1831
1832             new_det = DataConId tag marks new_fields (bottom "tvs") (bottom "theta") new_arg_tys tc
1833             new_id  = Id u n (bottom "ty") new_det prag info
1834         in
1835         (nenv3, new_id)
1836   where
1837     bottom msg = panic ("nmbrDataCon"++msg)
1838
1839 ------------
1840 nmbr_details :: IdDetails -> NmbrM IdDetails
1841
1842 nmbr_details (DataConId tag marks fields tvs theta arg_tys tc)
1843   = mapNmbr nmbrTyVar  tvs      `thenNmbr` \ new_tvs ->
1844     mapNmbr nmbrField  fields   `thenNmbr` \ new_fields ->
1845     mapNmbr nmbr_theta theta    `thenNmbr` \ new_theta ->
1846     mapNmbr nmbrType   arg_tys  `thenNmbr` \ new_arg_tys ->
1847     returnNmbr (DataConId tag marks new_fields new_tvs new_theta new_arg_tys tc)
1848   where
1849     nmbr_theta (c,t)
1850       = --nmbrClass c   `thenNmbr` \ new_c ->
1851         nmbrType  t     `thenNmbr` \ new_t ->
1852         returnNmbr (c, new_t)
1853
1854     -- ToDo:add more cases as needed
1855 nmbr_details other_details = returnNmbr other_details
1856
1857 ------------
1858 nmbrField (FieldLabel n ty tag)
1859   = nmbrType ty `thenNmbr` \ new_ty ->
1860     returnNmbr (FieldLabel n new_ty tag)
1861 \end{code}