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