ghc/compiler/basicTypes/Id.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[Id]{@Ids@: Value and constructor identifiers}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module Id (
  10         Id, -- abstract
  11         IdInfo, -- re-exporting
  12         ConTag(..), DictVar(..), DictFun(..), DataCon(..),
  13
  14         -- CONSTRUCTION
  15         mkSysLocal, mkUserLocal,
  16         mkSpecPragmaId,
  17         mkSpecId, mkSameSpecCon,
  18         mkTemplateLocals,
  19         mkImported, mkPreludeId,
  20         mkDataCon, mkTupleCon,
  21         mkIdWithNewUniq,
  22         mkClassOpId, mkSuperDictSelId, mkDefaultMethodId,
  23         mkConstMethodId, mkInstId,
  24 #ifdef DPH
  25         mkProcessorCon,
  26         mkPodId,
  27 #endif {- Data Parallel Haskell -}
  28
  29         updateIdType,
  30         mkId, mkDictFunId,
  31         mkWorkerId,
  32         localiseId,
  33
  34         -- DESTRUCTION
  35         getIdUniType,
  36         getInstNamePieces, getIdInfo, replaceIdInfo,
  37         getIdKind,
  38         getMentionedTyConsAndClassesFromId,
  39         getDataConTag,
  40         getDataConSig, getInstantiatedDataConSig,
  41         getDataConTyCon, -- UNUSED: getDataConFamily,
  42 #ifdef USE_SEMANTIQUE_STRANAL
  43         getDataConDeps,
  44 #endif
  45
  46         -- PREDICATES
  47         isDataCon, isTupleCon, isNullaryDataCon,
  48         isSpecId_maybe, isSpecPragmaId_maybe,
  49         toplevelishId, externallyVisibleId,
  50         isTopLevId, isWorkerId, isWrapperId,
  51         isImportedId, isSysLocalId,
  52         isBottomingId,
  53         isClassOpId, isConstMethodId, isDefaultMethodId,
  54         isDictFunId, isInstId_maybe, isSuperDictSelId_maybe,
  55 #ifdef DPH
  56         isInventedTopLevId,
  57         isProcessorCon,
  58 #endif {- Data Parallel Haskell -}
  59         eqId, cmpId,
  60         cmpId_withSpecDataCon,
  61         myWrapperMaybe,
  62         whatsMentionedInId,
  63         unfoldingUnfriendlyId,  -- ToDo: rm, eventually
  64         idWantsToBeINLINEd,
  65 --      dataConMentionsNonPreludeTyCon,
  66
  67         -- SUBSTITUTION
  68         applySubstToId, applyTypeEnvToId,
  69 -- not exported:        apply_to_Id, -- please don't use this, generally
  70
  71         -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
  72         getIdArity, getDataConArity, addIdArity,
  73         getIdDemandInfo, addIdDemandInfo,
  74         getIdSpecialisation, addIdSpecialisation,
  75         getIdStrictness, addIdStrictness,
  76         getIdUnfolding, addIdUnfolding, -- UNUSED? clearIdUnfolding,
  77         getIdUpdateInfo, addIdUpdateInfo,
  78         getIdArgUsageInfo, addIdArgUsageInfo,
  79         getIdFBTypeInfo, addIdFBTypeInfo,
  80         -- don't export the types, lest OptIdInfo be dragged in!
  81
  82         -- MISCELLANEOUS
  83         unlocaliseId,
  84         fIRST_TAG,
  85         showId,
  86         pprIdInUnfolding,
  87
  88         -- and to make the interface self-sufficient...
  89         Class, ClassOp, GlobalSwitch, Inst, Maybe, Name,
  90         FullName, PprStyle, PrettyRep,
  91         PrimKind, SrcLoc, Pretty(..), Subst, UnfoldingDetails,
  92         TyCon, TyVar, TyVarTemplate, TauType(..), UniType, Unique,
  93         UniqueSupply, Arity(..), ThetaType(..),
  94         TypeEnv(..), UniqFM, InstTemplate, Bag,
  95         SpecEnv, nullSpecEnv, SpecInfo,
  96
  97         -- and to make sure pragmas work...
  98         IdDetails  -- from this module, abstract
  99         IF_ATTACK_PRAGMAS(COMMA getMentionedTyConsAndClassesFromUniType)
 100         IF_ATTACK_PRAGMAS(COMMA bottomIsGuaranteed)
 101         IF_ATTACK_PRAGMAS(COMMA getInfo_UF)
 102
 103 #ifndef __GLASGOW_HASKELL__
 104         , TAG_
 105 #endif
 106     ) where
 107
 108 IMPORT_Trace            -- ToDo: rm (debugging only)
 109
 110 import AbsPrel          ( PrimOp, PrimKind, mkFunTy, nilDataCon, pRELUDE_BUILTIN
 111                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
 112                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
 113 #ifdef DPH
 114                           , mkPodNTy, mkPodizedPodNTy
 115 #endif {- Data Parallel Haskell -}
 116                         )
 117
 118 import AbsUniType
 119 import Bag
 120 import CLabelInfo       ( identToC, cSEP )
 121 import CmdLineOpts      ( GlobalSwitch(..) )
 122 import IdEnv            -- ( nullIdEnv, IdEnv )
 123 import IdInfo           -- piles of it
 124 import Inst             -- lots of things
 125 import Maybes           ( maybeToBool, Maybe(..) )
 126 import Name             ( Name(..) )
 127 import NameTypes
 128 import Outputable
 129 import Pretty           -- for pretty-printing
 130 import SrcLoc
 131 import Subst            ( applySubstToTy )      -- PRETTY GRIMY TO LOOK IN HERE
 132 import PlainCore
 133 import PrelFuns         ( pcGenerateDataSpecs ) -- PRETTY GRIMY TO LOOK IN HERE
 134 import UniqFM
 135 import UniqSet
 136 import Unique
 137 import Util
 138 #ifdef DPH
 139 IMPORT_Trace
 140 import PodizeCore       ( podizeTemplateExpr )
 141 import PodInfoTree      ( infoTypeNumToMask )
 142 #endif {- Data Parallel Haskell -}
 143 \end{code}
 144
 145 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
 146 follow.
 147
 148 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
 149 @UniType@, and an @IdInfo@ (non-essential info about it, e.g.,
 150 strictness).  The essential info about different kinds of @Ids@ is
 151 in its @IdDetails@.
 152
 153 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
 154
 155 \begin{code}
 156 data Id = Id    Unique          -- key for fast comparison
 157                 UniType         -- Id's type; used all the time;
 158                 IdInfo          -- non-essential info about this Id;
 159                 IdDetails       -- stuff about individual kinds of Ids.
 160
 161 data IdDetails
 162
 163   ---------------- Local values
 164
 165   = LocalId     ShortName       -- mentioned by the user
 166                 Bool            -- True <=> no free type vars
 167
 168   | SysLocalId  ShortName       -- made up by the compiler
 169                 Bool            -- as for LocalId
 170
 171   | SpecPragmaId ShortName      -- introduced by the compiler
 172                 (Maybe SpecInfo)-- for explicit specid in pragma
 173                 Bool            -- as for LocalId
 174
 175   ---------------- Global values
 176
 177   | ImportedId  FullName        -- Id imported from an interface
 178
 179   | PreludeId   FullName        -- things < Prelude that compiler "knows" about
 180
 181   | TopLevId    FullName        -- Top-level in the orig source pgm
 182                                 -- (not moved there by transformations).
 183
 184         -- a TopLevId's type may contain free type variables, if
 185         -- the monomorphism restriction applies.
 186
 187   ---------------- Data constructors
 188
 189   | DataConId   FullName
 190                 ConTag
 191                 -- cached pieces of the type:
 192                 [TyVarTemplate] [(Class,UniType)] [UniType] TyCon
 193                 -- the type is:
 194                 -- forall tyvars . theta_ty =>
 195                 --    unitype_1 -> ... -> unitype_n -> tycon tyvars
 196                 --
 197                 -- "type ThetaType  = [(Class, UniType)]"
 198
 199                 -- The [TyVarTemplate] is in the same order as the args of the
 200                 -- TyCon for the constructor
 201
 202   | TupleConId  Int             -- Its arity
 203
 204 #ifdef DPH
 205   | ProcessorCon Int            -- Its arity
 206 #endif {- Data Parallel Haskell -}
 207
 208   ---------------- Things to do with overloading
 209
 210   | SuperDictSelId              -- Selector for superclass dictionary
 211                 Class           -- The class (input dict)
 212                 Class           -- The superclass (result dict)
 213
 214   | ClassOpId   Class           -- An overloaded class operation, with
 215                                 -- a fully polymorphic type.  Its code
 216                                 -- just selects a method from the
 217                                 -- dictionary.  The class.
 218                 ClassOp         -- The operation
 219
 220         -- NB: The IdInfo for a ClassOpId has all the info about its
 221         -- related "constant method Ids", which are just
 222         -- specialisations of this general one.
 223
 224   | DefaultMethodId             -- Default method for a particular class op
 225                 Class           -- same class, <blah-blah> info as ClassOpId
 226                 ClassOp         -- (surprise, surprise)
 227                 Bool            -- True <=> I *know* this default method Id
 228                                 -- is a generated one that just says
 229                                 -- `error "No default method for <op>"'.
 230 \end{code}
 231
 232 DictFunIds are generated from instance decls.
 233 \begin{verbatim}
 234         class Foo a where
 235           op :: a -> a -> Bool
 236
 237         instance Foo a => Foo [a] where
 238           op = ...
 239 \end{verbatim}
 240 generates the dict fun id decl
 241 \begin{verbatim}
 242         dfun.Foo.[*] = \d -> ...
 243 \end{verbatim}
 244 The dfun id is uniquely named by the (class, type) pair.  Notice, it
 245 isn't a (class,tycon) pair any more, because we may get manually or
 246 automatically generated specialisations of the instance decl:
 247 \begin{verbatim}
 248         instance Foo [Int] where
 249           op = ...
 250 \end{verbatim}
 251 generates
 252 \begin{verbatim}
 253         dfun.Foo.[Int] = ...
 254 \end{verbatim}
 255 The type variables in the name are irrelevant; we print them as stars.
 256
 257 \begin{code}
 258   | DictFunId   Class           -- A DictFun is uniquely identified
 259                 UniType         -- by its class and type; this type has free type vars,
 260                                 -- whose identity is irrelevant.  Eg Class = Eq
 261                                 --                                   Type  = Tree a
 262                                 -- The "a" is irrelevant.  As it is too painful to
 263                                 -- actually do comparisons that way, we kindly supply
 264                                 -- a Unique for that purpose.
 265                 Bool            -- True <=> from an instance decl in this mod
 266 \end{code}
 267
 268 Constant method ids are generated from instance decls where
 269 there is no context; that is, no dictionaries are needed to
 270 construct the method.  Example
 271 \begin{verbatim}
 272         instance Foo Int where
 273           op = ...
 274 \end{verbatim}
 275 Then we get a constant method
 276 \begin{verbatim}
 277         Foo.op.Int = ...
 278 \end{verbatim}
 279
 280 It is possible, albeit unusual, to have a constant method
 281 for an instance decl which has type vars:
 282 \begin{verbatim}
 283         instance Foo [a] where
 284           op []     ys = True
 285           op (x:xs) ys = False
 286 \end{verbatim}
 287 We get the constant method
 288 \begin{verbatim}
 289         Foo.op.[*] = ...
 290 \end{verbatim}
 291 So a constant method is identified by a class/op/type triple.
 292 The type variables in the type are irrelevant.
 293
 294 \begin{code}
 295   | ConstMethodId               -- A method which depends only on the type of the
 296                                 -- instance, and not on any further dictionaries etc.
 297                 Class           -- Uniquely identified by:
 298                 UniType         -- (class, type, classop) triple
 299                 ClassOp
 300                 Bool            -- True <=> from an instance decl in this mod
 301
 302   | InstId      Inst            -- An instance of a dictionary, class operation,
 303                                 -- or overloaded value
 304
 305   | SpecId                      -- A specialisation of another Id
 306                 Id              -- Id of which this is a specialisation
 307                 [Maybe UniType] -- Types at which it is specialised;
 308                                 -- A "Nothing" says this type ain't relevant.
 309                 Bool            -- True <=> no free type vars; it's not enough
 310                                 -- to know about the unspec version, because
 311                                 -- we may specialise to a type w/ free tyvars
 312                                 -- (i.e., in one of the "Maybe UniType" dudes).
 313
 314   | WorkerId                    -- A "worker" for some other Id
 315                 Id              -- Id for which this is a worker
 316
 317 #ifdef DPH
 318   | PodId       Int             -- The dimension of the PODs context
 319                 Int             -- Which specialisation of InfoType is
 320                                 -- bind. ToDo(hilly): Int is a little messy
 321                                 -- and has a restricted range---change.
 322                 Id              -- One of the aboves Ids.
 323 #endif {- Data Parallel Haskell -}
 324
 325 type ConTag     = Int
 326 type DictVar    = Id
 327 type DictFun    = Id
 328 type DataCon    = Id
 329 \end{code}
 330
 331 For Ids whose names must be known/deducible in other modules, we have
 332 to conjure up their worker's names (and their worker's worker's
 333 names... etc) in a known systematic way.
 334
 335 %************************************************************************
 336 %*                                                                      *
 337 \subsection[Id-documentation]{Documentation}
 338 %*                                                                      *
 339 %************************************************************************
 340
 341 [A BIT DATED [WDP]]
 342
 343 The @Id@ datatype describes {\em values}.  The basic things we want to
 344 know: (1)~a value's {\em type} (@getIdUniType@ is a very common
 345 operation in the compiler); and (2)~what ``flavour'' of value it might
 346 be---for example, it can be terribly useful to know that a value is a
 347 class method.
 348
 349 \begin{description}
 350 %----------------------------------------------------------------------
 351 \item[@DataConId@:] For the data constructors declared by a @data@
 352 declaration.  Their type is kept in {\em two} forms---as a regular
 353 @UniType@ (in the usual place), and also in its constituent pieces (in
 354 the ``details''). We are frequently interested in those pieces.
 355
 356 %----------------------------------------------------------------------
 357 \item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
 358 the infinite family of tuples.
 359
 360 %----------------------------------------------------------------------
 361 \item[@ImportedId@:] These are values defined outside this module.
 362 {\em Everything} we want to know about them must be stored here (or in
 363 their @IdInfo@).
 364
 365 %----------------------------------------------------------------------
 366 \item[@PreludeId@:] ToDo
 367
 368 %----------------------------------------------------------------------
 369 \item[@TopLevId@:] These are values defined at the top-level in this
 370 module; i.e., those which {\em might} be exported (hence, a
 371 @FullName@).  It does {\em not} include those which are moved to the
 372 top-level through program transformations.
 373
 374 We also guarantee that @TopLevIds@ will {\em stay} at top-level.
 375 Theoretically, they could be floated inwards, but there's no known
 376 advantage in doing so.  This way, we can keep them with the same
 377 @Unique@ throughout (no cloning), and, in general, we don't have to be
 378 so paranoid about them.
 379
 380 In particular, we had the following problem generating an interface:
 381 We have to ``stitch together'' info (1)~from the typechecker-produced
 382 global-values list (GVE) and (2)~from the STG code [which @Ids@ have
 383 what arities].  If the @Uniques@ on the @TopLevIds@ can {\em change}
 384 between (1) and (2), you're sunk!
 385
 386 %----------------------------------------------------------------------
 387 \item[@ClassOpId@:] A selector from a dictionary; it may select either
 388 a method or a dictionary for one of the class's superclasses.
 389
 390 %----------------------------------------------------------------------
 391 \item[@DictFunId@:]
 392
 393 @mkDictFunId [a,b..] theta C T@ is the function derived from the
 394 instance declaration
 395
 396         instance theta => C (T a b ..) where
 397                 ...
 398
 399 It builds function @Id@ which maps dictionaries for theta,
 400 to a dictionary for C (T a b ..).
 401
 402 *Note* that with the ``Mark Jones optimisation'', the theta may
 403 include dictionaries for the immediate superclasses of C at the type
 404 (T a b ..).
 405
 406 %----------------------------------------------------------------------
 407 \item[@InstId@:]
 408
 409 %----------------------------------------------------------------------
 410 \item[@SpecId@:]
 411
 412 %----------------------------------------------------------------------
 413 \item[@WorkerId@:]
 414
 415 %----------------------------------------------------------------------
 416 \item[@LocalId@:] A purely-local value, e.g., a function argument,
 417 something defined in a @where@ clauses, ... --- but which appears in
 418 the original program text.
 419
 420 %----------------------------------------------------------------------
 421 \item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
 422 the original program text; these are introduced by the compiler in
 423 doing its thing.
 424
 425 %----------------------------------------------------------------------
 426 \item[@SpecPragmaId@:] Introduced by the compiler to record
 427 Specialisation pragmas. It is dead code which MUST NOT be removed
 428 before specialisation.
 429 \end{description}
 430
 431 Further remarks:
 432 \begin{enumerate}
 433 %----------------------------------------------------------------------
 434 \item
 435
 436 @DataCons@ @TupleCons@, @Importeds@, @TopLevIds@, @SuperDictSelIds@,
 437 @ClassOpIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
 438 properties:
 439 \begin{itemize}
 440 \item
 441 They have no free type variables, so if you are making a
 442 type-variable substitution you don't need to look inside them.
 443 \item
 444 They are constants, so they are not free variables.  (When the STG
 445 machine makes a closure, it puts all the free variables in the
 446 closure; the above are not required.)
 447 \end{itemize}
 448 Note that @InstIds@, @Locals@ and @SysLocals@ {\em may} have the above
 449 properties, but they may not.
 450 \end{enumerate}
 451
 452
 453 %************************************************************************
 454 %*                                                                      *
 455 \subsection[Id-general-funs]{General @Id@-related functions}
 456 %*                                                                      *
 457 %************************************************************************
 458
 459 \begin{code}
 460 isDataCon (Id _ _ _ (DataConId _ _ _ _ _ _)) = True
 461 isDataCon (Id _ _ _ (TupleConId _))          = True
 462 isDataCon (Id _ _ _ (SpecId unspec _ _))     = isDataCon unspec
 463 #ifdef DPH
 464 isDataCon (ProcessorCon _ _)          = True
 465 isDataCon (PodId _ _ id )             = isDataCon id
 466 #endif {- Data Parallel Haskell -}
 467 isDataCon other                       = False
 468
 469 isTupleCon (Id _ _ _ (TupleConId _))        = True
 470 isTupleCon (Id _ _ _ (SpecId unspec _ _))   = isTupleCon unspec
 471 #ifdef DPH
 472 isTupleCon (PodId _ _ id)       = isTupleCon id
 473 #endif {- Data Parallel Haskell -}
 474 isTupleCon other                = False
 475
 476 isNullaryDataCon data_con
 477   =  isDataCon data_con
 478   && (case arityMaybe (getIdArity data_con) of
 479         Just a -> a == 0
 480         _      -> panic "isNullaryDataCon")
 481
 482 isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _))
 483   = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
 484     Just (unspec, ty_maybes)
 485 isSpecId_maybe other_id
 486   = Nothing
 487
 488 isSpecPragmaId_maybe (Id _ _ _ (SpecPragmaId _ specinfo _))
 489   = Just specinfo
 490 isSpecPragmaId_maybe other_id
 491   = Nothing
 492
 493 #ifdef DPH
 494 isProcessorCon (ProcessorCon _ _) = True
 495 isProcessorCon (PodId _ _ id)     = isProcessorCon id
 496 isProcessorCon other              = False
 497 #endif {- Data Parallel Haskell -}
 498 \end{code}
 499
 500 @toplevelishId@ tells whether an @Id@ {\em may} be defined in a
 501 nested @let(rec)@ (returns @False@), or whether it is {\em sure} to be
 502 defined at top level (returns @True@).  This is used to decide whether
 503 the @Id@ is a candidate free variable.  NB: you are only {\em sure}
 504 about something if it returns @True@!
 505
 506 \begin{code}
 507 toplevelishId       :: Id -> Bool
 508 idHasNoFreeTyVars   :: Id -> Bool
 509
 510 toplevelishId (Id _ _ _ details)
 511   = chk details
 512   where
 513     chk (DataConId _ _ _ _ _ _) = True
 514     chk (TupleConId _)          = True
 515     chk (ImportedId _)          = True
 516     chk (PreludeId  _)          = True
 517     chk (TopLevId   _)          = True  -- NB: see notes
 518     chk (SuperDictSelId _ _)    = True
 519     chk (ClassOpId _ _)         = True
 520     chk (DefaultMethodId _ _ _) = True
 521     chk (DictFunId     _ _ _)   = True
 522     chk (ConstMethodId _ _ _ _) = True
 523     chk (SpecId unspec _ _)     = toplevelishId unspec
 524                                   -- depends what the unspecialised thing is
 525     chk (WorkerId unwrkr)       = toplevelishId unwrkr
 526     chk (InstId _)              = False -- these are local
 527     chk (LocalId      _ _)      = False
 528     chk (SysLocalId   _ _)      = False
 529     chk (SpecPragmaId _ _ _)    = False
 530 #ifdef DPH
 531     chk (ProcessorCon _ _)      = True
 532     chk (PodId _ _ id)          = toplevelishId id
 533 #endif {- Data Parallel Haskell -}
 534
 535 idHasNoFreeTyVars (Id _ _ info details)
 536   = chk details
 537   where
 538     chk (DataConId _ _ _ _ _ _) = True
 539     chk (TupleConId _)          = True
 540     chk (ImportedId _)          = True
 541     chk (PreludeId  _)          = True
 542     chk (TopLevId   _)          = True
 543     chk (SuperDictSelId _ _)    = True
 544     chk (ClassOpId _ _)         = True
 545     chk (DefaultMethodId _ _ _) = True
 546     chk (DictFunId     _ _ _)   = True
 547     chk (ConstMethodId _ _ _ _) = True
 548     chk (WorkerId unwrkr)       = idHasNoFreeTyVars unwrkr
 549     chk (InstId _)                    = False   -- these are local
 550     chk (SpecId _     _   no_free_tvs) = no_free_tvs
 551     chk (LocalId      _   no_free_tvs) = no_free_tvs
 552     chk (SysLocalId   _   no_free_tvs) = no_free_tvs
 553     chk (SpecPragmaId _ _ no_free_tvs) = no_free_tvs
 554 #ifdef DPH
 555     chk (ProcessorCon _ _)      = True
 556     chk (PodId _ _ id)          = idHasNoFreeTyVars id
 557 #endif {- Data Parallel Haskell -}
 558 \end{code}
 559
 560 \begin{code}
 561 isTopLevId (Id _ _ _ (TopLevId _)) = True
 562 #ifdef DPH
 563 isTopLevId (PodId _ _ id)       = isTopLevId id
 564 #endif {- Data Parallel Haskell -}
 565 isTopLevId other                = False
 566
 567 -- an "invented" one is a top-level Id, must be globally visible, etc.,
 568 -- but it's slightly different in that it was "conjured up".
 569 -- This handles workers fine, but may need refinement for other
 570 -- conjured-up things (e.g., specializations)
 571 -- NB: Only used in DPH now (93/08/20)
 572
 573 #ifdef DPH
 574 ToDo: DPH
 575 isInventedTopLevId (TopLevId _ n _ _)   = isInventedFullName n
 576 isInventedTopLevId (SpecId _ _ _)       = True
 577 isInventedTopLevId (WorkerId _)         = True
 578 isInventedTopLevId (PodId _ _ id)       = isInventedTopLevId id
 579 isInventedTopLevId other                = False
 580 #endif {- Data Parallel Haskell -}
 581
 582 isImportedId (Id _ _ _ (ImportedId _))   = True
 583 #ifdef DPH
 584 isImportedId (PodId _ _ id)       = isImportedId id
 585 #endif {- Data Parallel Haskell -}
 586 isImportedId other                = False
 587
 588 isBottomingId (Id _ _ info _) = bottomIsGuaranteed (getInfo info)
 589 #ifdef DPH
 590 isBottomingId (PodId _ _ id)      = isBottomingId id
 591 #endif {- Data Parallel Haskell -}
 592 --isBottomingId other             = False
 593
 594 isSysLocalId (Id _ _ _ (SysLocalId _ _)) = True
 595 #ifdef DPH
 596 isSysLocalId (PodId _ _ id)     = isSysLocalId id
 597 #endif {- Data Parallel Haskell -}
 598 isSysLocalId other              = False
 599
 600 isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _ _)) = True
 601 #ifdef DPH
 602 isSpecPragmaId (PodId _ _ id)   = isSpecPragmaId id
 603 #endif {- Data Parallel Haskell -}
 604 isSpecPragmaId other            = False
 605
 606 isClassOpId (Id _ _ _ (ClassOpId _ _)) = True
 607 isClassOpId _ = False
 608
 609 isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _)) = True
 610 #ifdef DPH
 611 isDefaultMethodId (PodId _ _ id)        = isDefaultMethodId id
 612 #endif {- Data Parallel Haskell -}
 613 isDefaultMethodId other                 = False
 614
 615 isDictFunId (Id _ _ _ (DictFunId _ _ _)) = True
 616 #ifdef DPH
 617 isDictFunId (PodId _ _ id)               = isDictFunId id
 618 #endif {- Data Parallel Haskell -}
 619 isDictFunId other                        = False
 620
 621 isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _)) = True
 622 #ifdef DPH
 623 isConstMethodId (PodId _ _ id)      = isConstMethodId id
 624 #endif {- Data Parallel Haskell -}
 625 isConstMethodId other               = False
 626
 627 isInstId_maybe (Id _ _ _ (InstId inst)) = Just inst
 628 #ifdef DPH
 629 isInstId_maybe (PodId _ _ id)           = isInstId_maybe id
 630 #endif {- Data Parallel Haskell -}
 631 isInstId_maybe other_id                 = Nothing
 632
 633 isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc)) = Just (c, sc)
 634 #ifdef DPH
 635 isSuperDictSelId_maybe (PodId _ _ id)   = isSuperDictSelId_maybe id
 636 #endif {- Data Parallel Haskell -}
 637 isSuperDictSelId_maybe other_id         = Nothing
 638
 639 isWorkerId (Id _ _ _ (WorkerId _)) = True
 640 #ifdef DPH
 641 isWorkerId (PodId _ _ id)           = isWorkerId id
 642 #endif {- Data Parallel Haskell -}
 643 isWorkerId other                    = False
 644
 645 isWrapperId id = workerExists (getIdStrictness id)
 646 \end{code}
 647
 648 \begin{code}
 649 pprIdInUnfolding :: IdSet -> Id -> Pretty
 650
 651 pprIdInUnfolding in_scopes v
 652   = let
 653         v_ty = getIdUniType v
 654     in
 655     -- local vars first:
 656     if v `elementOfUniqSet` in_scopes then
 657         pprUnique (getTheUnique v)
 658
 659     -- ubiquitous Ids with special syntax:
 660     else if v == nilDataCon then
 661         ppPStr SLIT("_NIL_")
 662     else if isTupleCon v then
 663         ppBeside (ppPStr SLIT("_TUP_")) (ppInt (getDataConArity v))
 664
 665     -- ones to think about:
 666     else
 667         let
 668             (Id _ _ _ v_details) = v
 669         in
 670         case v_details of
 671             -- these ones must have been exported by their original module
 672           ImportedId   _ -> pp_full_name
 673           PreludeId    _ -> pp_full_name
 674
 675             -- these ones' exportedness checked later...
 676           TopLevId  _ -> pp_full_name
 677           DataConId _ _ _ _ _ _ -> pp_full_name
 678
 679             -- class-ish things: class already recorded as "mentioned"
 680           SuperDictSelId c sc
 681             -> ppCat [ppPStr SLIT("_SDSEL_"), pp_class c, pp_class sc]
 682           ClassOpId c o
 683             -> ppCat [ppPStr SLIT("_METH_"), pp_class c, pp_class_op o]
 684           DefaultMethodId c o _
 685             -> ppCat [ppPStr SLIT("_DEFM_"), pp_class c, pp_class_op o]
 686
 687             -- instance-ish things: should we try to figure out
 688             -- *exactly* which extra instances have to be exported? (ToDo)
 689           DictFunId  c t _
 690             -> ppCat [ppPStr SLIT("_DFUN_"), pp_class c, pp_type t]
 691           ConstMethodId c t o _
 692             -> ppCat [ppPStr SLIT("_CONSTM_"), pp_class c, pp_class_op o, pp_type t]
 693
 694           -- specialisations and workers
 695           SpecId unspec ty_maybes _
 696             -> let
 697                   pp = pprIdInUnfolding in_scopes unspec
 698                in
 699                ppCat [ppPStr SLIT("_SPEC_"), pp, ppLbrack,
 700                         ppIntersperse pp'SP{-'-} (map pp_ty_maybe ty_maybes),
 701                         ppRbrack]
 702
 703           WorkerId unwrkr
 704             -> let
 705                   pp = pprIdInUnfolding in_scopes unwrkr
 706                in
 707                ppBeside (ppPStr SLIT("_WRKR_ ")) pp
 708
 709           -- anything else? we're nae interested
 710           other_id -> panic "pprIdInUnfolding:mystery Id"
 711   where
 712     ppr_Unfolding = PprUnfolding (panic "Id:ppr_Unfolding")
 713
 714     pp_full_name
 715       = let
 716             (m_str, n_str) = getOrigName v
 717
 718             pp_n =
 719               if isAvarop n_str || isAconop n_str then
 720                   ppBesides [ppLparen, ppPStr n_str, ppRparen]
 721               else
 722                   ppPStr n_str
 723         in
 724         if fromPreludeCore v then
 725             pp_n
 726         else
 727             ppCat [ppPStr SLIT("_ORIG_"), ppPStr m_str, pp_n]
 728
 729     pp_class :: Class -> Pretty
 730     pp_class_op :: ClassOp -> Pretty
 731     pp_type :: UniType -> Pretty
 732     pp_ty_maybe :: Maybe UniType -> Pretty
 733
 734     pp_class    clas = ppr ppr_Unfolding clas
 735     pp_class_op op   = ppr ppr_Unfolding op
 736
 737     pp_type t = ppBesides [ppLparen, ppr ppr_Unfolding t, ppRparen]
 738
 739     pp_ty_maybe Nothing  = ppPStr SLIT("_N_")
 740     pp_ty_maybe (Just t) = pp_type t
 741 \end{code}
 742
 743 @whatsMentionedInId@ ferrets out the types/classes/instances on which
 744 this @Id@ depends.  If this Id is to appear in an interface, then
 745 those entities had Jolly Well be in scope.  Someone else up the
 746 call-tree decides that.
 747
 748 \begin{code}
 749 whatsMentionedInId
 750         :: IdSet                            -- Ids known to be in scope
 751         -> Id                               -- Id being processed
 752         -> (Bag Id, Bag TyCon, Bag Class)   -- mentioned Ids/TyCons/etc.
 753
 754 whatsMentionedInId in_scopes v
 755   = let
 756         v_ty = getIdUniType v
 757
 758         (tycons, clss)
 759           = getMentionedTyConsAndClassesFromUniType v_ty
 760
 761         result0 id_bag = (id_bag, tycons, clss)
 762
 763         result1 ids tcs cs
 764           = (ids `unionBags` unitBag v, -- we add v to "mentioned"...
 765              tcs `unionBags` tycons,
 766              cs  `unionBags` clss)
 767     in
 768     -- local vars first:
 769     if v `elementOfUniqSet` in_scopes then
 770         result0 emptyBag    -- v not added to "mentioned"
 771
 772     -- ones to think about:
 773     else
 774         let
 775             (Id _ _ _ v_details) = v
 776         in
 777         case v_details of
 778           -- specialisations and workers
 779           SpecId unspec ty_maybes _
 780             -> let
 781                   (ids2, tcs2, cs2) = whatsMentionedInId in_scopes unspec
 782                in
 783                result1 ids2 tcs2 cs2
 784
 785           WorkerId unwrkr
 786             -> let
 787                   (ids2, tcs2, cs2) = whatsMentionedInId in_scopes unwrkr
 788                in
 789                result1 ids2 tcs2 cs2
 790
 791           anything_else -> result0 (unitBag v) -- v is  added to "mentioned"
 792 \end{code}
 793
 794 Tell them who my wrapper function is.
 795 \begin{code}
 796 myWrapperMaybe :: Id -> Maybe Id
 797
 798 myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper)) = Just my_wrapper
 799 myWrapperMaybe other_id                         = Nothing
 800 \end{code}
 801
 802 \begin{code}
 803 unfoldingUnfriendlyId   -- return True iff it is definitely a bad
 804         :: Id           -- idea to export an unfolding that
 805         -> Bool         -- mentions this Id.  Reason: it cannot
 806                         -- possibly be seen in another module.
 807
 808 unfoldingUnfriendlyId id
 809   | not (externallyVisibleId id) -- that settles that...
 810   = True
 811
 812 unfoldingUnfriendlyId (Id _ _ _ (WorkerId wrapper))
 813   = class_thing wrapper
 814   where
 815     -- "class thing": If we're going to use this worker Id in
 816     -- an interface, we *have* to be able to untangle the wrapper's
 817     -- strictness when reading it back in.  At the moment, this
 818     -- is not always possible: in precisely those cases where
 819     -- we pass tcGenPragmas a "Nothing" for its "ty_maybe".
 820
 821     class_thing (Id _ _ _ (SuperDictSelId _ _))    = True
 822     class_thing (Id _ _ _ (ClassOpId _ _))         = True
 823     class_thing (Id _ _ _ (DefaultMethodId _ _ _)) = True
 824     class_thing other                              = False
 825
 826 unfoldingUnfriendlyId (Id _ _ _ (SpecId d@(Id _ _ _ dfun@(DictFunId _ t _)) _ _))
 827     -- a SPEC of a DictFunId can end up w/ gratuitous
 828     -- TyVar(Templates) in the i/face; only a problem
 829     -- if -fshow-pragma-name-errs; but we can do without the pain.
 830     -- A HACK in any case (WDP 94/05/02)
 831   = --pprTrace "unfriendly1:" (ppCat [ppr PprDebug d, ppr PprDebug t]) (
 832     naughty_DictFunId dfun
 833     --)
 834
 835 unfoldingUnfriendlyId d@(Id _ _ _ dfun@(DictFunId _ t _))
 836   = --pprTrace "unfriendly2:" (ppCat [ppr PprDebug d, ppr PprDebug t]) (
 837     naughty_DictFunId dfun -- similar deal...
 838     --)
 839
 840 unfoldingUnfriendlyId other_id   = False -- is friendly in all other cases
 841
 842 naughty_DictFunId :: IdDetails -> Bool
 843     -- True <=> has a TyVar(Template) in the "type" part of its "name"
 844
 845 naughty_DictFunId (DictFunId _ _ False) = False -- came from outside; must be OK
 846 naughty_DictFunId (DictFunId _ ty _)
 847   = not (isGroundTy ty)
 848 \end{code}
 849
 850 @externallyVisibleId@: is it true that another module might be
 851 able to ``see'' this Id?
 852
 853 We need the @toplevelishId@ check as well as @isExported@ for when we
 854 compile instance declarations in the prelude.  @DictFunIds@ are
 855 ``exported'' if either their class or tycon is exported, but, in
 856 compiling the prelude, the compiler may not recognise that as true.
 857
 858 \begin{code}
 859 externallyVisibleId :: Id -> Bool
 860
 861 externallyVisibleId id@(Id _ _ _ details)
 862   = if isLocallyDefined id then
 863         toplevelishId id && isExported id && not (weird_datacon details)
 864     else
 865         not (weird_tuplecon details)
 866         -- if visible here, it must be visible elsewhere, too.
 867   where
 868     -- If it's a DataCon, it's not enough to know it (meaning
 869     -- its TyCon) is exported; we need to know that it might
 870     -- be visible outside.  Consider:
 871     --
 872     --  data Foo a = Mumble | BigFoo a WeirdLocalType
 873     --
 874     -- We can't tell the outside world *anything* about Foo, because
 875     -- of WeirdLocalType; but we need to know this when asked if
 876     -- "Mumble" is externally visible...
 877
 878     weird_datacon (DataConId _ _ _ _ _ tycon)
 879       = maybeToBool (maybePurelyLocalTyCon tycon)
 880     weird_datacon not_a_datacon_therefore_not_weird = False
 881
 882     weird_tuplecon (TupleConId arity)
 883       = arity > 32 -- sigh || isBigTupleTyCon tycon -- generated *purely* for local use
 884     weird_tuplecon _ = False
 885 \end{code}
 886
 887 \begin{code}
 888 idWantsToBeINLINEd :: Id -> Bool
 889
 890 idWantsToBeINLINEd id
 891   = case (getIdUnfolding id) of
 892       IWantToBeINLINEd _ -> True
 893       _ -> False
 894 \end{code}
 895
 896 For @unlocaliseId@: See the brief commentary in
 897 \tr{simplStg/SimplStg.lhs}.
 898
 899 \begin{code}
 900 unlocaliseId :: FAST_STRING{-modulename-} -> Id -> Maybe Id
 901
 902 unlocaliseId mod (Id u ty info (TopLevId fn))
 903   = Just (Id u ty info (TopLevId (unlocaliseFullName fn)))
 904
 905 unlocaliseId mod (Id u ty info (LocalId sn no_ftvs))
 906   = --false?: ASSERT(no_ftvs)
 907     let
 908         full_name = unlocaliseShortName mod u sn
 909     in
 910     Just (Id u ty info (TopLevId full_name))
 911
 912 unlocaliseId mod (Id u ty info (SysLocalId sn no_ftvs))
 913   = --false?: on PreludeGlaST: ASSERT(no_ftvs)
 914     let
 915         full_name = unlocaliseShortName mod u sn
 916     in
 917     Just (Id u ty info (TopLevId full_name))
 918
 919 unlocaliseId mod (Id u ty info (SpecId unspec ty_maybes no_ftvs))
 920   = case unlocalise_parent mod u unspec of
 921       Nothing -> Nothing
 922       Just xx -> Just (Id u ty info (SpecId xx ty_maybes no_ftvs))
 923
 924 unlocaliseId mod (Id u ty info (WorkerId unwrkr))
 925   = case unlocalise_parent mod u unwrkr of
 926       Nothing -> Nothing
 927       Just xx -> Just (Id u ty info (WorkerId xx))
 928
 929 unlocaliseId mod (Id u ty info (InstId inst))
 930   = Just (Id u ty info (TopLevId full_name))
 931         -- type might be wrong, but it hardly matters
 932         -- at this stage (just before printing C)  ToDo
 933   where
 934     name = let  (bit1:bits) = getInstNamePieces True inst  in
 935            _CONCAT_ (bit1 : [ _CONS_ '.'  b | b <- bits ])
 936
 937     full_name = mkFullName mod (mod _APPEND_ name) InventedInThisModule ExportAll mkGeneratedSrcLoc
 938
 939 #ifdef DPH
 940 unlocaliseId mod (PodId dim ity id)
 941   = case (unlocaliseId mod id) of
 942       Just id' -> Just (PodId dim ity id')
 943       Nothing  -> Nothing
 944 #endif {- Data Parallel Haskell -}
 945
 946 unlocaliseId mod other_id = Nothing
 947
 948 --------------------
 949 -- we have to be Very Careful for workers/specs of
 950 -- local functions!
 951
 952 unlocalise_parent mod uniq (Id _ ty info (LocalId sn no_ftvs))
 953   = --false?: ASSERT(no_ftvs)
 954     let
 955         full_name = unlocaliseShortName mod uniq sn
 956     in
 957     Just (Id uniq ty info (TopLevId full_name))
 958
 959 unlocalise_parent mod uniq (Id _ ty info (SysLocalId sn no_ftvs))
 960   = --false?: ASSERT(no_ftvs)
 961     let
 962         full_name = unlocaliseShortName mod uniq sn
 963     in
 964     Just (Id uniq ty info (TopLevId full_name))
 965
 966 unlocalise_parent mod uniq other_id = unlocaliseId mod other_id
 967   -- we're OK otherwise
 968 \end{code}
 969
 970 CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
 971 `Top-levelish Ids'' cannot have any free type variables, so applying
 972 the type-env cannot have any effect.  (NB: checked in CoreLint?)
 973
 974 The special casing is in @applyTypeEnvToId@, not @apply_to_Id@, as the
 975 former ``should be'' the usual crunch point.
 976
 977 \begin{code}
 978 applyTypeEnvToId :: TypeEnv -> Id -> Id
 979
 980 applyTypeEnvToId type_env id@(Id u ty info details)
 981   | idHasNoFreeTyVars id
 982   = id
 983   | otherwise
 984   = apply_to_Id ( \ ty ->
 985         applyTypeEnvToTy type_env ty
 986     ) id
 987 \end{code}
 988
 989 \begin{code}
 990 apply_to_Id :: (UniType -> UniType)
 991             -> Id
 992             -> Id
 993
 994 apply_to_Id ty_fn (Id u ty info details)
 995   = Id u (ty_fn ty) (apply_to_IdInfo ty_fn info) (apply_to_details details)
 996   where
 997     apply_to_details (InstId inst)
 998       = let
 999             new_inst = apply_to_Inst ty_fn inst
1000         in
1001         InstId new_inst
1002
1003     apply_to_details (SpecId unspec ty_maybes no_ftvs)
1004       = let
1005             new_unspec = apply_to_Id ty_fn unspec
1006             new_maybes = map apply_to_maybe ty_maybes
1007         in
1008         SpecId new_unspec new_maybes no_ftvs
1009         -- ToDo: recalc no_ftvs????
1010       where
1011         apply_to_maybe Nothing   = Nothing
1012         apply_to_maybe (Just ty) = Just (ty_fn ty)
1013
1014     apply_to_details (WorkerId unwrkr)
1015       = let
1016             new_unwrkr = apply_to_Id ty_fn unwrkr
1017         in
1018         WorkerId new_unwrkr
1019
1020 #ifdef DPH
1021     apply_to_details (PodId d ity id )
1022       = PodId d ity (apply_to_Id ty_fn id)
1023 #endif {- Data Parallel Haskell -}
1024
1025     apply_to_details other = other
1026 \end{code}
1027
1028 Sadly, I don't think the one using the magic typechecker substitution
1029 can be done with @apply_to_Id@.  Here we go....
1030
1031 Strictness is very important here.  We can't leave behind thunks
1032 with pointers to the substitution: it {\em must} be single-threaded.
1033
1034 \begin{code}
1035 applySubstToId :: Subst -> Id -> (Subst, Id)
1036
1037 applySubstToId subst id@(Id u ty info details)
1038   -- *cannot* have a "idHasNoFreeTyVars" get-out clause
1039   -- because, in the typechecker, we are still
1040   -- *concocting* the types.
1041   = case (applySubstToTy     subst ty)          of { (s2, new_ty)      ->
1042     case (applySubstToIdInfo s2    info)        of { (s3, new_info)    ->
1043     case (apply_to_details   s3 new_ty details) of { (s4, new_details) ->
1044     (s4, Id u new_ty new_info new_details) }}}
1045   where
1046     apply_to_details subst _ (InstId inst)
1047       = case (applySubstToInst subst inst) of { (s2, new_inst) ->
1048         (s2, InstId new_inst) }
1049
1050     apply_to_details subst new_ty (SpecId unspec ty_maybes _)
1051       = case (applySubstToId subst unspec)           of { (s2, new_unspec) ->
1052         case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
1053         (s3, SpecId new_unspec new_maybes (no_free_tvs new_ty)) }}
1054         -- NB: recalc no_ftvs (I think it's necessary (?) WDP 95/04)
1055       where
1056         apply_to_maybe subst Nothing   = (subst, Nothing)
1057         apply_to_maybe subst (Just ty)
1058           = case (applySubstToTy subst ty) of { (s2, new_ty) ->
1059             (s2, Just new_ty) }
1060
1061     apply_to_details subst _ (WorkerId unwrkr)
1062       = case (applySubstToId subst unwrkr) of { (s2, new_unwrkr) ->
1063         (s2, WorkerId new_unwrkr) }
1064
1065     apply_to_details subst _ other = (subst, other)
1066
1067 #ifdef DPH
1068 applySubstToId (PodId d ity id )
1069   = ???? ToDo:DPH; not sure what! returnLft (PodId d ity (applySubstToId id))
1070 #endif {- Data Parallel Haskell -}
1071 \end{code}
1072
1073 \begin{code}
1074 getIdNamePieces :: Bool {-show Uniques-} -> Id -> [FAST_STRING]
1075
1076 getIdNamePieces show_uniqs (Id u ty info details)
1077   = case details of
1078       DataConId n _ _ _ _ _ ->
1079         case (getOrigName n) of { (mod, name) ->
1080         if fromPrelude mod then [name] else [mod, name] }
1081
1082       TupleConId a -> [SLIT("Tup") _APPEND_ (_PK_ (show a))]
1083
1084       ImportedId  n -> get_fullname_pieces n
1085       PreludeId   n -> get_fullname_pieces n
1086       TopLevId    n -> get_fullname_pieces n
1087
1088       SuperDictSelId c sc ->
1089         case (getOrigName c)    of { (c_mod, c_name) ->
1090         case (getOrigName sc)   of { (sc_mod, sc_name) ->
1091         let
1092             c_bits = if fromPreludeCore c
1093                      then [c_name]
1094                      else [c_mod, c_name]
1095
1096             sc_bits= if fromPreludeCore sc
1097                      then [sc_name]
1098                      else [sc_mod, sc_name]
1099         in
1100         [SLIT("sdsel")] ++ c_bits ++ sc_bits  }}
1101
1102       ClassOpId clas op ->
1103         case (getOrigName clas) of { (c_mod, c_name) ->
1104         case (getClassOpString op)      of { op_name ->
1105         if fromPreludeCore clas then [op_name] else [c_mod, c_name, op_name]
1106         } }
1107
1108       DefaultMethodId clas op _ ->
1109         case (getOrigName clas)         of { (c_mod, c_name) ->
1110         case (getClassOpString op)      of { op_name ->
1111         if fromPreludeCore clas
1112         then [SLIT("defm"), op_name]
1113         else [SLIT("defm"), c_mod, c_name, op_name] }}
1114
1115       DictFunId c ty _ ->
1116         case (getOrigName c)        of { (c_mod, c_name) ->
1117         let
1118             c_bits = if fromPreludeCore c
1119                      then [c_name]
1120                      else [c_mod, c_name]
1121
1122             ty_bits = getTypeString ty
1123         in
1124         [SLIT("dfun")] ++ c_bits ++ ty_bits }
1125
1126
1127       ConstMethodId c ty o _ ->
1128         case (getOrigName c)        of { (c_mod, c_name) ->
1129         case (getTypeString ty)     of { ty_bits ->
1130         case (getClassOpString o)   of { o_name ->
1131         case (if fromPreludeCore c
1132                 then []
1133                 else [c_mod, c_name])   of { c_bits ->
1134         [SLIT("const")] ++ c_bits ++ ty_bits ++ [o_name] }}}}
1135
1136       -- if the unspecialised equiv is "top-level",
1137       -- the name must be concocted from its name and the
1138       -- names of the types to which specialised...
1139
1140       SpecId unspec ty_maybes _ ->
1141         getIdNamePieces show_uniqs unspec ++ (
1142         if not (toplevelishId unspec)
1143         then [showUnique u]
1144         else concat (map typeMaybeString ty_maybes)
1145         )
1146
1147       WorkerId unwrkr ->
1148         getIdNamePieces show_uniqs unwrkr ++ (
1149         if not (toplevelishId unwrkr)
1150         then [showUnique u]
1151         else [SLIT("wrk")]    -- show u
1152         )
1153
1154       InstId    inst     -> getInstNamePieces show_uniqs inst
1155       LocalId      n _   -> let local = getLocalName n in
1156                             if show_uniqs then [local, showUnique u] else [local]
1157       SysLocalId   n _   -> [getLocalName n, showUnique u]
1158       SpecPragmaId n _ _ -> [getLocalName n, showUnique u]
1159
1160 #ifdef DPH
1161       ProcessorCon a _ -> ["MkProcessor" ++ (show a)]
1162       PodId n ity id   -> getIdNamePieces show_uniqs id ++
1163                            ["mapped", "POD" ++ (show n), show ity]
1164 #endif {- Data Parallel Haskell -}
1165
1166 get_fullname_pieces :: FullName -> [FAST_STRING]
1167 get_fullname_pieces n
1168   = BIND (getOrigName n) _TO_ (mod, name) ->
1169     if fromPrelude mod
1170     then [name]
1171     else [mod, name]
1172     BEND
1173 \end{code}
1174
1175 Really Inst-ish, but only used in this module...
1176 \begin{code}
1177 getInstNamePieces :: Bool -> Inst -> [FAST_STRING]
1178
1179 getInstNamePieces show_uniqs (Dict   u clas ty _)
1180   = let  (mod, nm) = getOrigName clas  in
1181     if fromPreludeCore clas
1182     then [SLIT("d"), nm, showUnique u]
1183     else [SLIT("d"), mod, nm, showUnique u]
1184
1185 getInstNamePieces show_uniqs (Method u id tys  _)
1186   = let local = getIdNamePieces show_uniqs id in
1187     if show_uniqs then local ++ [showUnique u] else local
1188
1189 getInstNamePieces show_uniqs (LitInst u _ _ _) = [SLIT("lit"), showUnique u]
1190 \end{code}
1191
1192 %************************************************************************
1193 %*                                                                      *
1194 \subsection[Id-type-funs]{Type-related @Id@ functions}
1195 %*                                                                      *
1196 %************************************************************************
1197
1198 \begin{code}
1199 getIdUniType :: Id -> UniType
1200
1201 getIdUniType (Id _ ty _ _) = ty
1202
1203 #ifdef DPH
1204 -- ToDo: DPH
1205 getIdUniType (ProcessorCon _ ty)        = ty
1206 getIdUniType (PodId d ity id)
1207   = let (foralls,rho) = splitForalls (getIdUniType id)          in
1208     let tys           = get_args rho                            in
1209     let itys_mask     = infoTypeNumToMask ity                   in
1210     let tys'          = zipWith convert tys itys_mask           in
1211     mkForallTy foralls (foldr1 mkFunTy tys')
1212   where -- ToDo(hilly) change to use getSourceType etc...
1213
1214     get_args ty = case (maybeUnpackFunTy ty) of
1215                     Nothing        -> [ty]
1216                     Just (arg,res) -> arg:get_args res
1217
1218     convert ty cond = if cond
1219                       then ty
1220                       else (coerce ty)
1221
1222     coerce ty = case (maybeUnpackFunTy ty) of
1223                   Nothing        ->mkPodizedPodNTy d ty
1224                   Just (arg,res) ->mkFunTy (coerce arg) (coerce res)
1225 #endif {- Data Parallel Haskell -}
1226 \end{code}
1227
1228 \begin{code}
1229 getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)
1230
1231 getMentionedTyConsAndClassesFromId id
1232  = getMentionedTyConsAndClassesFromUniType (getIdUniType id)
1233 \end{code}
1234
1235 \begin{code}
1236 getIdKind i = kindFromType (getIdUniType i)
1237 \end{code}
1238
1239 \begin{code}
1240 {- NOT USED
1241 getIdTauType :: Id -> TauType
1242 getIdTauType i = expandTySyn (getTauType (getIdUniType i))
1243
1244 getIdSourceTypes :: Id -> [TauType]
1245 getIdSourceTypes i = map expandTySyn (sourceTypes (getTauType (getIdUniType i)))
1246
1247 getIdTargetType :: Id -> TauType
1248 getIdTargetType i = expandTySyn (targetType (getTauType (getIdUniType i)))
1249 -}
1250 \end{code}
1251
1252 %************************************************************************
1253 %*                                                                      *
1254 \subsection[Id-overloading]{Functions related to overloading}
1255 %*                                                                      *
1256 %************************************************************************
1257
1258 \begin{code}
1259 mkSuperDictSelId  u c sc     ty info = Id u ty info (SuperDictSelId c sc)
1260 mkClassOpId       u c op     ty info = Id u ty info (ClassOpId c op)
1261 mkDefaultMethodId u c op gen ty info = Id u ty info (DefaultMethodId c op gen)
1262
1263 mkDictFunId u c ity full_ty from_here info
1264   = Id u full_ty info (DictFunId c ity from_here)
1265
1266 mkConstMethodId u c op ity full_ty from_here info
1267   = Id u full_ty info (ConstMethodId c ity op from_here)
1268
1269 mkWorkerId u unwrkr ty info = Id u ty info (WorkerId unwrkr)
1270
1271 mkInstId inst
1272   = Id u (getInstUniType inst) noIdInfo (InstId inst)
1273   where
1274     u = case inst of
1275           Dict    u c t o   -> u
1276           Method  u i ts o  -> u
1277           LitInst u l ty o  -> u
1278
1279 {- UNUSED:
1280 getSuperDictSelIdSig (Id _ _ _ (SuperDictSelId input_class result_class))
1281   = (input_class, result_class)
1282 -}
1283 \end{code}
1284
1285 %************************************************************************
1286 %*                                                                      *
1287 \subsection[local-funs]{@LocalId@-related functions}
1288 %*                                                                      *
1289 %************************************************************************
1290
1291 \begin{code}
1292 mkImported    u n ty info = Id u ty info (ImportedId   n)
1293 mkPreludeId   u n ty info = Id u ty info (PreludeId    n)
1294
1295 #ifdef DPH
1296 mkPodId d i = PodId d i
1297 #endif
1298
1299 updateIdType :: Id -> UniType -> Id
1300 updateIdType (Id u _ info details) ty = Id u ty info details
1301 \end{code}
1302
1303 \begin{code}
1304 no_free_tvs ty = null (extractTyVarsFromTy ty)
1305
1306 -- SysLocal: for an Id being created by the compiler out of thin air...
1307 -- UserLocal: an Id with a name the user might recognize...
1308 mkSysLocal, mkUserLocal :: FAST_STRING -> Unique -> UniType -> SrcLoc -> Id
1309
1310 mkSysLocal str uniq ty loc
1311   = Id uniq ty noIdInfo (SysLocalId (mkShortName str loc) (no_free_tvs ty))
1312
1313 mkUserLocal str uniq ty loc
1314   = Id uniq ty noIdInfo (LocalId (mkShortName str loc) (no_free_tvs ty))
1315
1316 -- for an SpecPragmaId being created by the compiler out of thin air...
1317 mkSpecPragmaId :: FAST_STRING -> Unique -> UniType -> Maybe SpecInfo -> SrcLoc -> Id
1318 mkSpecPragmaId str uniq ty specinfo loc
1319   = Id uniq ty noIdInfo (SpecPragmaId (mkShortName str loc) specinfo (no_free_tvs ty))
1320
1321 -- for new SpecId
1322 mkSpecId u unspec ty_maybes ty info
1323   = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
1324     Id u ty info (SpecId unspec ty_maybes (no_free_tvs ty))
1325
1326 -- Specialised version of constructor: only used in STG and code generation
1327 -- Note: The specialsied Id has the same unique as the unspeced Id
1328
1329 mkSameSpecCon ty_maybes unspec@(Id u ty info details)
1330   = ASSERT(isDataCon unspec)
1331     ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
1332     Id u new_ty info (SpecId unspec ty_maybes (no_free_tvs new_ty))
1333   where
1334     new_ty = specialiseTy ty ty_maybes 0
1335
1336     -- pprTrace "SameSpecCon:Unique:"
1337     --          (ppSep (ppr PprDebug unspec: [pprMaybeTy PprDebug ty | ty <- ty_maybes]))
1338
1339 -- mkId builds a local or top-level Id, depending on the name given
1340 mkId :: Name -> UniType -> IdInfo -> Id
1341 mkId (Short uniq short) ty info = Id uniq ty info (LocalId short (no_free_tvs ty))
1342 mkId (OtherTopId uniq full) ty info
1343   = Id uniq ty info
1344         (if isLocallyDefined full then TopLevId full else ImportedId full)
1345
1346 localiseId :: Id -> Id
1347 localiseId id@(Id u ty info details)
1348   = Id u ty info (LocalId (mkShortName name loc) (no_free_tvs ty))
1349   where
1350     name = getOccurrenceName id
1351     loc  = getSrcLoc id
1352
1353 -- this has to be one of the "local" flavours (LocalId, SysLocalId, InstId)
1354 -- ToDo: it does??? WDP
1355 mkIdWithNewUniq :: Id -> Unique -> Id
1356
1357 mkIdWithNewUniq (Id _ ty info details) uniq
1358   = let
1359         new_details
1360           = case details of
1361               InstId (Dict _ c t o)     -> InstId (Dict uniq c t o)
1362               InstId (Method _ i ts o)  -> InstId (Method uniq i ts o)
1363               InstId (LitInst _ l ty o) -> InstId (LitInst uniq l ty o)
1364               old_details               -> old_details
1365     in
1366     Id uniq ty info new_details
1367
1368 #ifdef DPH
1369 mkIdWithNewUniq (PodId d t id) uniq = PodId d t (mkIdWithNewUniq id uniq)
1370 #endif {- Data Parallel Haskell -}
1371 \end{code}
1372
1373 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
1374 @Uniques@, but that's OK because the templates are supposed to be
1375 instantiated before use.
1376 \begin{code}
1377 mkTemplateLocals :: [UniType] -> [Id]
1378 mkTemplateLocals tys
1379   = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkUnknownSrcLoc)
1380             (getBuiltinUniques (length tys))
1381             tys
1382 \end{code}
1383
1384 \begin{code}
1385 getIdInfo :: Id -> IdInfo
1386
1387 getIdInfo (Id _ _ info _) = info
1388
1389 #ifdef DPH
1390 getIdInfo (PodId _ _ id)                = getIdInfo id
1391 #endif {- Data Parallel Haskell -}
1392
1393 replaceIdInfo :: Id -> IdInfo -> Id
1394
1395 replaceIdInfo (Id u ty _ details) info = Id u ty info details
1396
1397 #ifdef DPH
1398 replaceIdInfo (PodId dim ity id) info = PodId dim ity (replaceIdInfo id info)
1399 #endif {- Data Parallel Haskell -}
1400 \end{code}
1401
1402 %************************************************************************
1403 %*                                                                      *
1404 \subsection[Id-arities]{Arity-related functions}
1405 %*                                                                      *
1406 %************************************************************************
1407
1408 For locally-defined Ids, the code generator maintains its own notion
1409 of their arities; so it should not be asking...  (but other things
1410 besides the code-generator need arity info!)
1411
1412 \begin{code}
1413 getIdArity      :: Id -> ArityInfo
1414 getDataConArity :: DataCon -> Int -- a simpler i/face; they always have arities
1415
1416 #ifdef DPH
1417 getIdArity (ProcessorCon n _)           = mkArityInfo n
1418 getIdArity (PodId _ _ id)               = getIdArity id
1419 #endif {- Data Parallel Haskell -}
1420
1421 getIdArity (Id _ _ id_info _)  = getInfo id_info
1422
1423 getDataConArity id@(Id _ _ id_info _)
1424   = ASSERT(isDataCon id)
1425     case (arityMaybe (getInfo id_info)) of
1426       Nothing -> pprPanic "getDataConArity:Nothing:" (ppr PprDebug id)
1427       Just  i -> i
1428
1429 addIdArity :: Id -> Int -> Id
1430 addIdArity (Id u ty info details) arity
1431   = Id u ty (info `addInfo` (mkArityInfo arity)) details
1432 \end{code}
1433
1434 %************************************************************************
1435 %*                                                                      *
1436 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
1437 %*                                                                      *
1438 %************************************************************************
1439
1440 \begin{code}
1441 mkDataCon :: Unique{-DataConKey-} -> FullName -> [TyVarTemplate] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
1442   -- can get the tag and all the pieces of the type from the UniType
1443
1444 mkDataCon k n tyvar_tmpls context args_tys tycon specenv = data_con
1445   where
1446     data_con  = Id k type_of_constructor datacon_info
1447                     (DataConId n
1448                         (position_within fIRST_TAG data_con_family data_con)
1449                         tyvar_tmpls context args_tys tycon)
1450
1451     -- Note data_con self-recursion;
1452     -- should be OK as tags are not looked at until
1453     -- late in the game.
1454
1455     data_con_family             = getTyConDataCons tycon
1456
1457     position_within :: Int -> [Id] -> Id -> Int
1458     position_within acc [] con
1459       = panic "mkDataCon: con not found in family"
1460
1461     position_within acc (c:cs) con
1462       = if c `eqId` con then acc else position_within (acc+(1::Int)) cs con
1463
1464     type_of_constructor = mkSigmaTy tyvar_tmpls context
1465                                 (glueTyArgs
1466                                         args_tys
1467                                         (applyTyCon tycon (map mkTyVarTemplateTy tyvar_tmpls)))
1468
1469     datacon_info = noIdInfo `addInfo_UF` unfolding
1470                             `addInfo` mkArityInfo arity
1471                             `addInfo` specenv
1472
1473     arity = length args_tys
1474
1475     unfolding
1476       = -- if arity == 0
1477         -- then noIdInfo
1478         -- else -- do some business...
1479         let
1480             (tyvars, dict_vars, vars) = mk_uf_bits tyvar_tmpls context args_tys tycon
1481             tyvar_tys = map mkTyVarTy tyvars
1482         in
1483         BIND (CoCon data_con tyvar_tys [CoVarAtom v | v <- vars]) _TO_ plain_CoCon ->
1484
1485         BIND (mkCoLam (dict_vars ++ vars) plain_CoCon) _TO_ lambdized_CoCon ->
1486
1487         mkUnfolding EssentialUnfolding -- for data constructors
1488                     (foldr CoTyLam lambdized_CoCon tyvars)
1489         BEND BEND
1490
1491     mk_uf_bits tyvar_tmpls context arg_tys tycon
1492       = let
1493             (inst_env, tyvars, tyvar_tys)
1494               = instantiateTyVarTemplates tyvar_tmpls
1495                                           (map getTheUnique tyvar_tmpls)
1496         in
1497             -- the "context" and "arg_tys" have TyVarTemplates in them, so
1498             -- we instantiate those types to have the right TyVars in them
1499             -- instead.
1500         BIND (map (instantiateTauTy inst_env) (map ctxt_ty context))
1501                                                         _TO_ inst_dict_tys ->
1502         BIND (map (instantiateTauTy inst_env) arg_tys)  _TO_ inst_arg_tys ->
1503
1504             -- We can only have **ONE** call to mkTemplateLocals here;
1505             -- otherwise, we get two blobs of locals w/ mixed-up Uniques
1506             -- (Mega-Sigh) [ToDo]
1507         BIND (mkTemplateLocals (inst_dict_tys ++ inst_arg_tys)) _TO_ all_vars ->
1508
1509         BIND (splitAt (length context) all_vars)        _TO_ (dict_vars, vars) ->
1510
1511         (tyvars, dict_vars, vars)
1512         BEND BEND BEND BEND
1513       where
1514         -- these are really dubious UniTypes, but they are only to make the
1515         -- binders for the lambdas for tossed-away dicts.
1516         ctxt_ty (clas, ty) = mkDictTy clas ty
1517 \end{code}
1518
1519 \begin{code}
1520 mkTupleCon :: Arity -> Id
1521
1522 mkTupleCon arity = data_con
1523   where
1524     data_con    = Id unique ty tuplecon_info (TupleConId arity)
1525     unique      = mkTupleDataConUnique arity
1526     ty          = mkSigmaTy tyvars [] (glueTyArgs tyvar_tys (applyTyCon tycon tyvar_tys))
1527     tycon       = mkTupleTyCon arity
1528     tyvars      = take arity alphaTyVars
1529     tyvar_tys   = map mkTyVarTemplateTy tyvars
1530
1531     tuplecon_info
1532       = noIdInfo `addInfo_UF` unfolding
1533                  `addInfo` mkArityInfo arity
1534                  `addInfo` tuplecon_specenv
1535
1536     tuplecon_specenv
1537       = if arity == 2 then
1538             pcGenerateDataSpecs ty
1539         else
1540             nullSpecEnv
1541
1542     unfolding
1543       = -- if arity == 0
1544         -- then noIdInfo
1545         -- else -- do some business...
1546         let
1547             (tyvars, dict_vars, vars) = mk_uf_bits arity
1548             tyvar_tys = map mkTyVarTy tyvars
1549         in
1550         BIND (CoCon data_con tyvar_tys [CoVarAtom v | v <- vars]) _TO_ plain_CoCon ->
1551
1552         BIND (mkCoLam (dict_vars ++ vars) plain_CoCon) _TO_ lambdized_CoCon ->
1553
1554         mkUnfolding
1555             EssentialUnfolding    -- data constructors
1556             (foldr CoTyLam lambdized_CoCon tyvars)
1557         BEND BEND
1558
1559     mk_uf_bits arity
1560       = BIND (mkTemplateLocals tyvar_tys)                _TO_ vars ->
1561         (tyvars, [], vars)
1562         BEND
1563       where
1564         tyvar_tmpls     = take arity alphaTyVars
1565         (_, tyvars, tyvar_tys) = instantiateTyVarTemplates tyvar_tmpls (map getTheUnique tyvar_tmpls)
1566
1567
1568 #ifdef DPH
1569 mkProcessorCon :: Arity -> Id
1570 mkProcessorCon arity
1571   = ProcessorCon arity ty
1572   where
1573     ty = mkSigmaTy tyvars [] (glueTyArgs tyvar_tys (applyTyCon tycon tyvar_tys))
1574     tycon       = mkProcessorTyCon arity
1575     tyvars      = take arity alphaTyVars
1576     tyvar_tys   = map mkTyVarTemplateTy tyvars
1577 #endif {- Data Parallel Haskell -}
1578
1579 fIRST_TAG :: ConTag
1580 fIRST_TAG =  1  -- Tags allocated from here for real constructors
1581
1582 -- given one data constructor in a family, return a list
1583 -- of all the data constructors in that family.
1584
1585 #ifdef DPH
1586 getDataConFamily :: DataCon -> [DataCon]
1587
1588 getDataConFamily data_con
1589   = ASSERT(isDataCon data_con)
1590     getTyConDataCons (getDataConTyCon data_con)
1591 #endif
1592 \end{code}
1593
1594 \begin{code}
1595 getDataConTag :: DataCon -> ConTag      -- will panic if not a DataCon
1596
1597 getDataConTag   (Id _ _ _ (DataConId _ tag _ _ _ _)) = tag
1598 getDataConTag   (Id _ _ _ (TupleConId _))            = fIRST_TAG
1599 getDataConTag   (Id _ _ _ (SpecId unspec _ _))       = getDataConTag unspec
1600 #ifdef DPH
1601 getDataConTag   (ProcessorCon _ _) = fIRST_TAG
1602 #endif {- Data Parallel Haskell -}
1603
1604 getDataConTyCon :: DataCon -> TyCon     -- will panic if not a DataCon
1605
1606 getDataConTyCon (Id _ _ _ (DataConId _ _ _ _ _ tycon)) = tycon
1607 getDataConTyCon (Id _ _ _ (TupleConId a))              = mkTupleTyCon a
1608 getDataConTyCon (Id _ _ _ (SpecId unspec tys _))       = mkSpecTyCon (getDataConTyCon unspec) tys
1609 #ifdef DPH
1610 getDataConTyCon (ProcessorCon a _) = mkProcessorTyCon a
1611 #endif {- Data Parallel Haskell -}
1612
1613 getDataConSig :: DataCon -> ([TyVarTemplate], ThetaType, [TauType], TyCon)
1614                                         -- will panic if not a DataCon
1615
1616 getDataConSig (Id _ _ _ (DataConId _ _ tyvars theta_ty arg_tys tycon))
1617   = (tyvars, theta_ty, arg_tys, tycon)
1618
1619 getDataConSig (Id _ _ _ (TupleConId arity))
1620   = (tyvars, [], tyvar_tys, mkTupleTyCon arity)
1621   where
1622     tyvars      = take arity alphaTyVars
1623     tyvar_tys   = map mkTyVarTemplateTy tyvars
1624
1625 getDataConSig (Id _ _ _ (SpecId unspec ty_maybes _))
1626   = (spec_tyvars, spec_theta_ty, spec_arg_tys, spec_tycon)
1627   where
1628     (tyvars, theta_ty, arg_tys, tycon) = getDataConSig unspec
1629
1630     ty_env = tyvars `zip` ty_maybes
1631
1632     spec_tyvars = foldr nothing_tyvars [] ty_env
1633     nothing_tyvars (tyvar, Nothing) l = tyvar : l
1634     nothing_tyvars (tyvar, Just ty) l = l
1635
1636     spec_env = foldr just_env [] ty_env
1637     just_env (tyvar, Nothing) l = l
1638     just_env (tyvar, Just ty) l = (tyvar, ty) : l
1639     spec_arg_tys = map (instantiateTauTy spec_env) arg_tys
1640
1641     spec_theta_ty = if null theta_ty then []
1642                     else panic "getDataConSig:ThetaTy:SpecDataCon"
1643     spec_tycon    = mkSpecTyCon tycon ty_maybes
1644
1645 #ifdef DPH
1646 getDataConSig (ProcessorCon arity _)
1647   = (tyvars, [], tyvar_tys, mkProcessorTyCon arity)
1648   where
1649     tyvars      = take arity alphaTyVars
1650     tyvar_tys   = map mkTyVarTemplateTy tyvars
1651 #endif {- Data Parallel Haskell -}
1652 \end{code}
1653
1654 @getInstantiatedDataConSig@ takes a constructor and some types to which
1655 it is applied; it returns its signature instantiated to these types.
1656
1657 \begin{code}
1658 getInstantiatedDataConSig ::
1659            DataCon      -- The data constructor
1660                         --   Not a specialised data constructor
1661         -> [TauType]    -- Types to which applied
1662                         --   Must be fully applied i.e. contain all types of tycon
1663         -> ([TauType],  -- Types of dict args
1664             [TauType],  -- Types of regular args
1665             TauType     -- Type of result
1666            )
1667
1668 getInstantiatedDataConSig data_con tycon_arg_tys
1669   = ASSERT(isDataCon data_con)
1670     --false?? WDP 95/06: ASSERT(not (maybeToBool (isSpecId_maybe data_con)))
1671     let
1672         (tv_tmpls, theta, cmpnt_ty_tmpls, tycon) = getDataConSig data_con
1673
1674         inst_env = --ASSERT(length tv_tmpls == length tycon_arg_tys)
1675 {-                 if (length tv_tmpls /= length tycon_arg_tys) then
1676                         pprPanic "Id:1666:" (ppCat [ppr PprShowAll data_con, ppr PprDebug tycon_arg_tys])
1677                    else
1678 -}                 tv_tmpls `zip` tycon_arg_tys
1679
1680         theta_tys = [ instantiateTauTy inst_env (mkDictTy c t) | (c,t) <- theta ]
1681         cmpnt_tys = map (instantiateTauTy inst_env) cmpnt_ty_tmpls
1682         result_ty = instantiateTauTy inst_env (applyTyCon tycon tycon_arg_tys)
1683     in
1684     -- Are the first/third results ever used?
1685     (theta_tys, cmpnt_tys, result_ty)
1686
1687 {- UNUSED: allows a specilaised constructor to be instantiated
1688            (with all argument types of the unspecialsied tycon)
1689
1690 getInstantiatedDataConSig data_con tycon_arg_tys
1691   = ASSERT(isDataCon data_con)
1692     if is_speccon && arg_tys_match_error then
1693         pprPanic "getInstantiatedDataConSig:SpecId:"
1694                  (ppHang (ppr PprDebug data_con) 4 pp_match_error)
1695     else
1696         (theta_tys, cmpnt_tys, result_ty)  -- Are the first/third results ever used?
1697   where
1698     is_speccon       = maybeToBool is_speccon_maybe
1699     is_speccon_maybe = isSpecId_maybe data_con
1700     Just (unspec_con, spec_tys) = is_speccon_maybe
1701
1702     arg_tys_match_error = maybeToBool match_error_maybe
1703     match_error_maybe   = ASSERT(length spec_tys == length tycon_arg_tys)
1704                           argTysMatchSpecTys spec_tys tycon_arg_tys
1705     (Just pp_match_error) = match_error_maybe
1706
1707     (tv_tmpls, theta, cmpnt_ty_tmpls, tycon)
1708       = if is_speccon
1709         then getDataConSig unspec_con
1710         else getDataConSig data_con
1711
1712     inst_env = ASSERT(length tv_tmpls == length tycon_arg_tys)
1713                tv_tmpls `zip` tycon_arg_tys
1714
1715     theta_tys = [ instantiateTauTy inst_env (mkDictTy c t) | (c,t) <- theta ]
1716     cmpnt_tys = map (instantiateTauTy inst_env) cmpnt_ty_tmpls
1717     result_ty = instantiateTauTy inst_env (applyTyCon tycon tycon_arg_tys)
1718 -}
1719 \end{code}
1720
1721 The function @getDataConDeps@ is passed an @Id@ representing a data
1722 constructor of some type. We look at the source types of the
1723 constructor and create the set of all @TyCons@ referred to directly
1724 from the source types.
1725
1726 \begin{code}
1727 #ifdef USE_SEMANTIQUE_STRANAL
1728 getDataConDeps :: Id -> [TyCon]
1729
1730 getDataConDeps (Id _ _ _ (DataConId _ _ _ _ arg_tys _))
1731   = concat (map getReferredToTyCons arg_tys)
1732 getDataConDeps (Id _ _ _ (TupleConId _)) = []
1733 getDataConDeps (Id _ _ _ (SpecId unspec ty_maybes _))
1734   = getDataConDeps unspec ++ concat (map getReferredToTyCons (catMaybes ty_maybes))
1735 #ifdef DPH
1736 getDataConDeps (ProcessorCon _ _) = []
1737 #endif {- Data Parallel Haskell -}
1738 #endif {- Semantique strictness analyser -}
1739 \end{code}
1740
1741 Data type declarations are of the form:
1742 \begin{verbatim}
1743 data Foo a b = C1 ... | C2 ... | ... | Cn ...
1744 \end{verbatim}
1745 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
1746 @C1 x y z@, we want a function binding:
1747 \begin{verbatim}
1748 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> CoCon C1 [a, b] [x, y, z]
1749 \end{verbatim}
1750 Notice the ``big lambdas'' and type arguments to @CoCon@---we are producing
1751 2nd-order polymorphic lambda calculus with explicit types.
1752
1753 %************************************************************************
1754 %*                                                                      *
1755 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1756 %*                                                                      *
1757 %************************************************************************
1758
1759 @getIdUnfolding@ takes a @Id@ (we are discussing the @DataCon@ case)
1760 and generates an @UnfoldingDetails@ for its unfolding.  The @Ids@ and
1761 @TyVars@ don't really have to be new, because we are only producing a
1762 template.
1763
1764 ToDo: what if @DataConId@'s type has a context (haven't thought about it
1765 --WDP)?
1766
1767 Note: @getDataConUnfolding@ is a ``poor man's'' version---it is NOT
1768 EXPORTED.  It just returns the binders (@TyVars@ and @Ids@) [in the
1769 example above: a, b, and x, y, z], which is enough (in the important
1770 \tr{DsExpr} case).  (The middle set of @Ids@ is binders for any
1771 dictionaries, in the even of an overloaded data-constructor---none at
1772 present.)
1773
1774 \begin{code}
1775 getIdUnfolding      :: Id -> UnfoldingDetails
1776
1777 #ifdef DPH
1778 getIdUnfolding dcon@(ProcessorCon arity _)
1779   = let
1780         (tyvars, dict_vars, vars) = getDataConUnfolding dcon
1781         tyvar_tys = map mkTyVarTy tyvars
1782     in
1783     BIND (CoCon dcon tyvar_tys [CoVarAtom v | v <- vars]) _TO_ plain_CoCon ->
1784     BIND (mkCoLam vars plain_CoCon)              _TO_ lambdized_CoCon ->
1785     mkUnfoldTemplate (\x->False){-ToDo-} EssentialUnfolding{-ToDo???DPH-} (foldr CoTyLam lambdized_CoCon tyvars)
1786     BEND BEND
1787
1788 -- If we have a PodId whose ``id'' has an unfolding, then we need to
1789 -- parallelize the unfolded expression for the d^th dimension.
1790 {-
1791 getIdUnfolding (PodId d _ id)
1792    = case (unfoldingMaybe (getIdUnfolding id)) of
1793         Nothing   -> noInfo
1794         Just expr -> trace ("getIdUnfolding ("++
1795                             ppShow 80 (ppr PprDebug id) ++
1796                             ") for " ++ show d ++ "D pod")
1797                            (podizeTemplateExpr d expr)
1798 -}
1799 #endif {- Data Parallel Haskell -}
1800
1801 getIdUnfolding (Id _ _ id_info _) = getInfo_UF id_info
1802
1803 addIdUnfolding :: Id -> UnfoldingDetails -> Id
1804 addIdUnfolding id@(Id u ty info details) unfold_details
1805   = ASSERT(
1806         case (isLocallyDefined id, unfold_details) of
1807         (_,     NoUnfoldingDetails) -> True
1808         (True,  IWantToBeINLINEd _) -> True
1809         (False, IWantToBeINLINEd _) -> False -- v bad
1810         (False, _)                  -> True
1811         _                           -> False -- v bad
1812     )
1813     Id u ty (info `addInfo_UF` unfold_details) details
1814
1815 {- UNUSED:
1816 clearIdUnfolding :: Id -> Id
1817 clearIdUnfolding (Id u ty info details) = Id u ty (clearInfo_UF info) details
1818 -}
1819 \end{code}
1820
1821 In generating selector functions (take a dictionary, give back one
1822 component...), we need to what out for the nothing-to-select cases (in
1823 which case the ``selector'' is just an identity function):
1824 \begin{verbatim}
1825 class Eq a => Foo a { }     # the superdict selector for "Eq"
1826
1827 class Foo a { op :: Complex b => c -> b -> a }
1828                             # the method selector for "op";
1829                             # note local polymorphism...
1830 \end{verbatim}
1831
1832 For data constructors, we make an unfolding which has a bunch of
1833 lambdas to bind the arguments, with a (saturated) @CoCon@ inside.  In
1834 the case of overloaded constructors, the dictionaries are just thrown
1835 away; they were only required in the first place to ensure that the
1836 type was indeed an instance of the required class.
1837 \begin{code}
1838 #ifdef DPH
1839 getDataConUnfolding :: Id -> ([TyVar], [Id], [Id])
1840
1841 getDataConUnfolding dcon@(ProcessorCon arity _)
1842   = BIND (mkTemplateLocals tyvar_tys)            _TO_ vars ->
1843     (tyvars, [], vars)
1844     BEND
1845   where
1846     tyvar_tmpls = take arity alphaTyVars
1847     (_, tyvars, tyvar_tys) = instantiateTyVarTemplates tyvar_tmpls (map getTheUnique tyvar_tmpls)
1848 #endif {- Data Parallel Haskell -}
1849 \end{code}
1850
1851 %************************************************************************
1852 %*                                                                      *
1853 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1854 %*                                                                      *
1855 %************************************************************************
1856
1857 \begin{code}
1858 getIdDemandInfo :: Id -> DemandInfo
1859 getIdDemandInfo (Id _ _ info _) = getInfo info
1860
1861 addIdDemandInfo :: Id -> DemandInfo -> Id
1862 addIdDemandInfo (Id u ty info details) demand_info
1863   = Id u ty (info `addInfo` demand_info) details
1864 \end{code}
1865
1866 \begin{code}
1867 getIdUpdateInfo :: Id -> UpdateInfo
1868 getIdUpdateInfo (Id u ty info details) = getInfo info
1869
1870 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1871 addIdUpdateInfo (Id u ty info details) upd_info
1872   = Id u ty (info `addInfo` upd_info) details
1873 \end{code}
1874
1875 \begin{code}
1876 getIdArgUsageInfo :: Id -> ArgUsageInfo
1877 getIdArgUsageInfo (Id u ty info details) = getInfo info
1878
1879 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1880 addIdArgUsageInfo (Id u ty info details) au_info
1881   = Id u ty (info `addInfo` au_info) details
1882 \end{code}
1883
1884 \begin{code}
1885 getIdFBTypeInfo :: Id -> FBTypeInfo
1886 getIdFBTypeInfo (Id u ty info details) = getInfo info
1887
1888 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1889 addIdFBTypeInfo (Id u ty info details) upd_info
1890   = Id u ty (info `addInfo` upd_info) details
1891 \end{code}
1892
1893 \begin{code}
1894 getIdSpecialisation :: Id -> SpecEnv
1895 getIdSpecialisation (Id _ _ info _) = getInfo info
1896
1897 addIdSpecialisation :: Id -> SpecEnv -> Id
1898 addIdSpecialisation (Id u ty info details) spec_info
1899   = Id u ty (info `addInfo` spec_info) details
1900 \end{code}
1901
1902 Strictness: we snaffle the info out of the IdInfo.
1903
1904 \begin{code}
1905 getIdStrictness :: Id -> StrictnessInfo
1906
1907 getIdStrictness (Id _ _ id_info _) = getInfo id_info
1908
1909 addIdStrictness :: Id -> StrictnessInfo -> Id
1910
1911 addIdStrictness (Id u ty info details) strict_info
1912   = Id u ty (info `addInfo` strict_info) details
1913 \end{code}
1914
1915 %************************************************************************
1916 %*                                                                      *
1917 \subsection[Id-comparison]{Comparison functions for @Id@s}
1918 %*                                                                      *
1919 %************************************************************************
1920
1921 Comparison: equality and ordering---this stuff gets {\em hammered}.
1922
1923 \begin{code}
1924 cmpId (Id u1 _ _ _) (Id u2 _ _ _) = cmpUnique u1 u2
1925 -- short and very sweet
1926 \end{code}
1927
1928 \begin{code}
1929 eqId :: Id -> Id -> Bool
1930
1931 eqId a b = case cmpId a b of { EQ_ -> True;  _   -> False }
1932
1933 instance Eq Id where
1934     a == b = case cmpId a b of { EQ_ -> True;  _ -> False }
1935     a /= b = case cmpId a b of { EQ_ -> False; _ -> True  }
1936
1937 instance Ord Id where
1938     a <= b = case cmpId a b of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
1939     a <  b = case cmpId a b of { LT_ -> True;  EQ_ -> False; GT__ -> False }
1940     a >= b = case cmpId a b of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
1941     a >  b = case cmpId a b of { LT_ -> False; EQ_ -> False; GT__ -> True  }
1942 #ifdef __GLASGOW_HASKELL__
1943     _tagCmp a b = case cmpId a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
1944 #endif
1945 \end{code}
1946
1947 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1948 account when comparing two data constructors. We need to do this
1949 because a specialsied data constructor has the same unique as its
1950 unspeciailsed counterpart.
1951
1952 \begin{code}
1953 cmpId_withSpecDataCon :: Id -> Id -> TAG_
1954
1955 cmpId_withSpecDataCon id1 id2
1956   | eq_ids && isDataCon id1 && isDataCon id2
1957   = cmpEqDataCon id1 id2
1958
1959   | otherwise
1960   = cmp_ids
1961   where
1962     cmp_ids = cmpId id1 id2
1963     eq_ids  = case cmp_ids of { EQ_ -> True; other -> False }
1964
1965 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _)) (Id _ _ _ (SpecId _ mtys2 _))
1966   = cmpUniTypeMaybeList mtys1 mtys2
1967
1968 cmpEqDataCon unspec1 (Id _ _ _ (SpecId _ _ _))
1969   = LT_
1970
1971 cmpEqDataCon (Id _ _ _ (SpecId _ _ _)) unspec2
1972   = GT_
1973
1974 cmpEqDataCon unspec1 unspec2
1975   = EQ_
1976
1977 \end{code}
1978
1979 %************************************************************************
1980 %*                                                                      *
1981 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1982 %*                                                                      *
1983 %************************************************************************
1984
1985 \begin{code}
1986 instance Outputable Id where
1987     ppr sty id = pprId sty id
1988
1989 showId :: PprStyle -> Id -> String
1990 showId sty id = ppShow 80 (pprId sty id)
1991
1992 -- [used below]
1993 -- for DictFuns (instances) and const methods (instance code bits we
1994 -- can call directly): exported (a) if *either* the class or
1995 -- ***OUTERMOST*** tycon [arbitrary...] is exported; or (b) *both*
1996 -- class and tycon are from PreludeCore [non-std, but convenient]
1997 -- *and* the thing was defined in this module.
1998
1999 instance_export_flag :: Class -> UniType -> Bool -> ExportFlag
2000
2001 instance_export_flag clas inst_ty from_here
2002   = if instanceIsExported clas inst_ty from_here
2003     then ExportAll
2004     else NotExported
2005 \end{code}
2006
2007 Do we consider an ``instance type'' (as on a @DictFunId@) to be ``from
2008 PreludeCore''?  True if the outermost TyCon is fromPreludeCore.
2009 \begin{code}
2010 is_prelude_core_ty :: UniType -> Bool
2011
2012 is_prelude_core_ty inst_ty
2013   = case getUniDataTyCon_maybe inst_ty of
2014       Just (tycon,_,_) -> fromPreludeCore tycon
2015       Nothing          -> panic "Id: is_prelude_core_ty"
2016 \end{code}
2017
2018 Default printing code (not used for interfaces):
2019 \begin{code}
2020 pprId :: PprStyle -> Id -> Pretty
2021
2022 pprId other_sty id
2023   = let
2024         pieces = getIdNamePieces (case other_sty of {PprForUser -> False; _ -> True}) id
2025
2026         for_code
2027           = let
2028                 pieces_to_print -- maybe use Unique only
2029                   = if isSysLocalId id then tail pieces else pieces
2030             in
2031             ppIntersperse (ppPStr cSEP) (map identToC pieces_to_print)
2032     in
2033     case other_sty of
2034       PprForC _       -> for_code
2035       PprForAsm _ _ _ -> for_code
2036       PprInterface _  -> ppPStr occur_name
2037       PprForUser      -> ppPStr occur_name
2038       PprUnfolding _  -> qualified_name pieces
2039       PprDebug        -> qualified_name pieces
2040       PprShowAll      -> ppBesides [qualified_name pieces,
2041                             (ppCat [pp_uniq id,
2042                                     ppPStr SLIT("{-"),
2043                                     ppr other_sty (getIdUniType id),
2044                                     ppIdInfo other_sty id True (\x->x) nullIdEnv (getIdInfo id),
2045                                     ppPStr SLIT("-}") ])]
2046   where
2047     occur_name = getOccurrenceName id _APPEND_
2048                  ( _PK_ (if not (isSysLocalId id)
2049                          then ""
2050                          else "." ++ (_UNPK_ (showUnique (getTheUnique id)))))
2051
2052     qualified_name pieces
2053       = ppBeside (pp_ubxd (ppIntersperse (ppChar '.') (map ppPStr pieces))) (pp_uniq id)
2054
2055     pp_uniq (Id _ _ _ (PreludeId _))    = ppNil -- No uniq to add
2056     pp_uniq (Id _ _ _ (DataConId _ _ _ _ _ _)) = ppNil  -- No uniq to add
2057     pp_uniq (Id _ _ _ (TupleConId _))       = ppNil -- No uniq to add
2058     pp_uniq (Id _ _ _ (LocalId      _ _))   = ppNil -- uniq printed elsewhere
2059     pp_uniq (Id _ _ _ (SysLocalId   _ _))   = ppNil -- ditto
2060     pp_uniq (Id _ _ _ (SpecPragmaId _ _ _)) = ppNil -- ditto
2061     pp_uniq (Id _ _ _ (InstId _))           = ppNil -- ditto
2062     pp_uniq other_id = ppBesides [ppPStr SLIT("{-"), pprUnique (getTheUnique other_id),  ppPStr SLIT("-}")]
2063
2064     -- For Robin Popplestone: print PprDebug Ids with # afterwards
2065     -- if they are of primitive type.
2066     pp_ubxd pretty = if isPrimType (getIdUniType id)
2067                      then ppBeside pretty (ppChar '#')
2068                      else pretty
2069 \end{code}
2070
2071 \begin{code}
2072 instance NamedThing Id where
2073     getExportFlag (Id _ _ _ details)
2074       = get details
2075       where
2076         get (DataConId _ _ _ _ _ tc)= getExportFlag tc -- NB: don't use the FullName
2077         get (TupleConId _)          = NotExported
2078         get (ImportedId  n)         = getExportFlag n
2079         get (PreludeId   n)         = getExportFlag n
2080         get (TopLevId    n)         = getExportFlag n
2081         get (SuperDictSelId c _)    = getExportFlag c
2082         get (ClassOpId  c _)        = getExportFlag c
2083         get (DefaultMethodId c _ _) = getExportFlag c
2084         get (DictFunId  c ty from_here) = instance_export_flag c ty from_here
2085         get (ConstMethodId c ty _ from_here) = instance_export_flag c ty from_here
2086         get (SpecId unspec _ _)     = getExportFlag unspec
2087         get (WorkerId unwrkr)       = getExportFlag unwrkr
2088         get (InstId _)              = NotExported
2089         get (LocalId      _ _)      = NotExported
2090         get (SysLocalId   _ _)      = NotExported
2091         get (SpecPragmaId _ _ _)    = NotExported
2092 #ifdef DPH
2093         get (ProcessorCon _ _)      = NotExported
2094         get (PodId _ _ i)           = getExportFlag i
2095 #endif {- Data Parallel Haskell -}
2096
2097     isLocallyDefined this_id@(Id _ _ _ details)
2098       = get details
2099       where
2100         get (DataConId _ _ _ _ _ tc)= isLocallyDefined tc -- NB: don't use the FullName
2101         get (TupleConId _)          = False
2102         get (ImportedId _)          = False
2103         get (PreludeId  _)          = False
2104         get (TopLevId   n)          = isLocallyDefined n
2105         get (SuperDictSelId c _)    = isLocallyDefined c
2106         get (ClassOpId c _)         = isLocallyDefined c
2107         get (DefaultMethodId c _ _) = isLocallyDefined c
2108         get (DictFunId c tyc from_here) = from_here
2109             -- For DictFunId and ConstMethodId things, you really have to
2110             -- know whether it came from an imported instance or one
2111             -- really here; no matter where the tycon and class came from.
2112
2113         get (ConstMethodId c tyc _ from_here) = from_here
2114         get (SpecId unspec _ _)     = isLocallyDefined unspec
2115         get (WorkerId unwrkr)       = isLocallyDefined unwrkr
2116         get (InstId  _)             = True
2117         get (LocalId      _ _)      = True
2118         get (SysLocalId   _ _)      = True
2119         get (SpecPragmaId _ _ _)    = True
2120 #ifdef DPH
2121         get (ProcessorCon _ _)      = False
2122         get (PodId _ _ i)           = isLocallyDefined i
2123 #endif {- Data Parallel Haskell -}
2124
2125     getOrigName this_id@(Id u _ _ details)
2126       = get details
2127       where
2128         get (DataConId n _ _ _ _ _) = getOrigName n
2129         get (TupleConId a)          = (pRELUDE_BUILTIN, SLIT("Tup") _APPEND_ _PK_ (show a))
2130         get (ImportedId   n)        = getOrigName n
2131         get (PreludeId    n)        = getOrigName n
2132         get (TopLevId     n)        = getOrigName n
2133
2134         get (ClassOpId c op)        = case (getOrigName c) of -- ToDo; better ???
2135                                         (mod, _) -> (mod, getClassOpString op)
2136
2137         get (SpecId unspec ty_maybes _)
2138           = BIND getOrigName unspec           _TO_ (mod, unspec_nm) ->
2139             BIND specMaybeTysSuffix ty_maybes _TO_ tys_suffix ->
2140             (mod,
2141              unspec_nm _APPEND_
2142                 (if not (toplevelishId unspec)
2143                  then showUnique u
2144                  else tys_suffix)
2145             )
2146             BEND BEND
2147
2148         get (WorkerId unwrkr)
2149           = BIND getOrigName unwrkr     _TO_ (mod, unwrkr_nm) ->
2150             (mod,
2151              unwrkr_nm _APPEND_
2152                 (if not (toplevelishId unwrkr)
2153                  then showUnique u
2154                  else SLIT(".wrk"))
2155             )
2156             BEND
2157
2158         get (InstId inst)
2159           = (panic "NamedThing.Id.getOrigName (InstId)",
2160              BIND (getInstNamePieces True inst)   _TO_ (piece1:pieces) ->
2161              BIND [ _CONS_ '.' p | p <- pieces ]  _TO_ dotted_pieces ->
2162              _CONCAT_ (piece1 : dotted_pieces)
2163              BEND BEND )
2164
2165         get (LocalId      n _) = (panic "NamedThing.Id.getOrigName (LocalId)",
2166                                   getLocalName n)
2167         get (SysLocalId   n _) = (panic "NamedThing.Id.getOrigName (SysLocal)",
2168                                   getLocalName n)
2169         get (SpecPragmaId n _ _)=(panic "NamedThing.Id.getOrigName (SpecPragmaId)",
2170                                   getLocalName n)
2171 #ifdef DPH
2172         get (ProcessorCon a _)      = ("PreludeBuiltin",
2173                                                    "MkProcessor" ++ (show a))
2174         get (PodId d ity id)
2175           = BIND (getOrigName id) _TO_ (m,n) ->
2176             (m,n ++ ".mapped.POD"++ show d ++ "." ++ show ity)
2177             BEND
2178     -- ToDo(hilly): should the above be using getIdNamePieces???
2179 #endif {- Data Parallel Haskell -}
2180
2181         get other_details
2182             -- the remaining internally-generated flavours of
2183             -- Ids really do not have meaningful "original name" stuff,
2184             -- but we need to make up something (usually for debugging output)
2185
2186           = BIND (getIdNamePieces True this_id)  _TO_ (piece1:pieces) ->
2187             BIND [ _CONS_ '.' p | p <- pieces ]  _TO_ dotted_pieces ->
2188             (_NIL_, _CONCAT_ (piece1 : dotted_pieces))
2189             BEND BEND
2190
2191     getOccurrenceName this_id@(Id _ _ _ details)
2192       = get details
2193       where
2194         get (DataConId  n _ _ _ _ _) = getOccurrenceName n
2195         get (TupleConId a)      = SLIT("Tup") _APPEND_ (_PK_ (show a))
2196         get (ImportedId  n)     = getOccurrenceName n
2197         get (PreludeId   n)     = getOccurrenceName n
2198         get (TopLevId    n)     = getOccurrenceName n
2199         get (ClassOpId _ op)    = getClassOpString op
2200 #ifdef DPH
2201         get (ProcessorCon a _)  = "MkProcessor" ++ (show a)
2202         get (PodId _ _ id)      = getOccurrenceName id
2203 #endif {- Data Parallel Haskell -}
2204         get _                   = snd (getOrigName this_id)
2205
2206     getInformingModules id = panic "getInformingModule:Id"
2207
2208     getSrcLoc (Id _ _ id_info details)
2209       = get details
2210       where
2211         get (DataConId  n _ _ _ _ _) = getSrcLoc n
2212         get (TupleConId _)      = mkBuiltinSrcLoc
2213         get (ImportedId  n)     = getSrcLoc n
2214         get (PreludeId   n)     = getSrcLoc n
2215         get (TopLevId    n)     = getSrcLoc n
2216         get (SuperDictSelId c _)= getSrcLoc c
2217         get (ClassOpId c _)     = getSrcLoc c
2218         get (SpecId unspec _ _) = getSrcLoc unspec
2219         get (WorkerId unwrkr)   = getSrcLoc unwrkr
2220         get (InstId     i)      = let (loc,_) = getInstOrigin i
2221                                   in  loc
2222         get (LocalId      n _)  = getSrcLoc n
2223         get (SysLocalId   n _)  = getSrcLoc n
2224         get (SpecPragmaId n _ _)= getSrcLoc n
2225 #ifdef DPH
2226         get (ProcessorCon _ _)  = mkBuiltinSrcLoc
2227         get (PodId _ _ n)               = getSrcLoc n
2228 #endif {- Data Parallel Haskell -}
2229         -- well, try the IdInfo
2230         get something_else = getSrcLocIdInfo id_info
2231
2232     getTheUnique (Id u _ _ _) = u
2233
2234     fromPreludeCore (Id _ _ _ details)
2235       = get details
2236       where
2237         get (DataConId _ _ _ _ _ tc)= fromPreludeCore tc -- NB: not from the FullName
2238         get (TupleConId _)          = True
2239         get (ImportedId  n)         = fromPreludeCore n
2240         get (PreludeId   n)         = fromPreludeCore n
2241         get (TopLevId    n)         = fromPreludeCore n
2242         get (SuperDictSelId c _)    = fromPreludeCore c
2243         get (ClassOpId c _)         = fromPreludeCore c
2244         get (DefaultMethodId c _ _) = fromPreludeCore c
2245         get (DictFunId  c t _)      = fromPreludeCore c && is_prelude_core_ty t
2246         get (ConstMethodId c t _ _) = fromPreludeCore c && is_prelude_core_ty t
2247         get (SpecId unspec _ _)     = fromPreludeCore unspec
2248         get (WorkerId unwrkr)       = fromPreludeCore unwrkr
2249         get (InstId   _)            = False
2250         get (LocalId      _ _)      = False
2251         get (SysLocalId   _ _)      = False
2252         get (SpecPragmaId _ _ _)    = False
2253 #ifdef DPH
2254         get (ProcessorCon _ _)      = True
2255         get (PodId _ _ id)          = fromPreludeCore id
2256 #endif {- Data Parallel Haskell -}
2257
2258     hasType id  = True
2259     getType id  = getIdUniType id
2260 \end{code}
2261
2262 Reason for @getTheUnique@: The code generator doesn't carry a
2263 @UniqueSupply@, so it wants to use the @Uniques@ out of local @Ids@
2264 given to it.