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