Id.lhs 55.6 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
3 4 5 6 7 8
%
\section[Id]{@Ids@: Value and constructor identifiers}

\begin{code}
#include "HsVersions.h"

9 10 11 12 13 14 15
module Id (
	-- TYPES
	GenId(..), -- *naughtily* used in some places (e.g., TcHsSyn)
	SYN_IE(Id), IdDetails,
	StrictnessMark(..),
	SYN_IE(ConTag), fIRST_TAG,
	SYN_IE(DataCon), SYN_IE(DictFun), SYN_IE(DictVar),
16 17

	-- CONSTRUCTION
18 19 20 21
	mkConstMethodId,
	mkDataCon,
	mkDefaultMethodId,
	mkDictFunId,
22
	mkIdWithNewUniq,
23 24 25 26 27 28 29 30 31 32
	mkImported,
	mkInstId,
	mkMethodSelId,
	mkRecordSelId,
	mkSuperDictSelId,
	mkSysLocal,
	mkTemplateLocals,
	mkTupleCon,
	mkUserId,
	mkUserLocal,
33 34
	mkWorkerId,

35 36 37 38 39
	-- MANGLING
	unsafeGenId2Id,

	-- DESTRUCTION (excluding pragmatic info)
	idPrimRep,
40
	idType,
41
	idUnique,
42

43
	dataConRepType,
44 45 46
	dataConArgTys,
	dataConArity,
	dataConNumFields,
47
	dataConFieldLabels,
48 49 50 51 52
	dataConRawArgTys,
	dataConSig,
	dataConStrictMarks,
	dataConTag,
	dataConTyCon,
53 54

	recordSelectorFieldLabel,
55 56

	-- PREDICATES
57 58
	cmpEqDataCon,
	cmpId,
59
	cmpId_withSpecDataCon,
60 61
	externallyVisibleId,
	idHasNoFreeTyVars,
62
	idWantsToBeINLINEd,
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
	isBottomingId,
	isConstMethodId,
	isConstMethodId_maybe,
	isDataCon,
	isDefaultMethodId,
	isDefaultMethodId_maybe,
	isDictFunId,
	isImportedId,
	isMethodSelId,
	isNullaryDataCon,
	isSpecPragmaId,
	isSuperDictSelId_maybe,
	isSysLocalId,
	isTopLevId,
	isTupleCon,
	isWorkerId,
79
	isWrapperId,
80 81
	toplevelishId,
	unfoldingUnfriendlyId,
82 83

	-- SUBSTITUTION
84 85 86 87 88 89
	applyTypeEnvToId,
	apply_to_Id,
	
	-- PRINTING and RENUMBERING
	addId,
	nmbrDataCon,
90
	nmbrId,
91 92
	pprId,
	showId,
93

94 95 96 97
	-- Specialialisation
	getIdSpecialisation,
	addIdSpecialisation,

98 99 100 101 102 103 104 105 106 107 108 109
	-- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
	addIdArity,
	addIdDemandInfo,
	addIdStrictness,
	addIdUpdateInfo,
	getIdArity,
	getIdDemandInfo,
	getIdInfo,
	getIdStrictness,
	getIdUnfolding,
	getIdUpdateInfo,
	getPragmaInfo,
110
	replaceIdInfo,
111
	addInlinePragma,
112

113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
	-- IdEnvs AND IdSets
	SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
	addOneToIdEnv,
	addOneToIdSet,
	combineIdEnvs,
	delManyFromIdEnv,
	delOneFromIdEnv,
	elementOfIdSet,
	emptyIdSet,
	growIdEnv,
	growIdEnvList,
	idSetToList,
	intersectIdSets,
	isEmptyIdSet,
	isNullIdEnv,
	lookupIdEnv,
	lookupNoFailIdEnv,
	mapIdEnv,
	minusIdSet,
	mkIdEnv,
	mkIdSet,
	modifyIdEnv,
135
	modifyIdEnv_Directly,
136 137 138 139 140 141 142
	nullIdEnv,
	rngIdEnv,
	unionIdSets,
	unionManyIdSets,
	unitIdEnv,
	unitIdSet
    ) where
143

144 145 146
IMP_Ubiq()
IMPORT_DELOOPER(IdLoop)   -- for paranoia checking
IMPORT_DELOOPER(TyLoop)   -- for paranoia checking
147 148

import Bag
149
import Class		( classOpString, SYN_IE(Class), GenClass, SYN_IE(ClassOp), GenClassOp )
150 151
import IdInfo
import Maybes		( maybeToBool )
152
import Name		( appendRdr, nameUnique, mkLocalName, isLocalName,
153
			  isLocallyDefinedName,
154
			  mkTupleDataConName, mkCompoundName, mkCompoundName2,
155 156 157
			  isLexSym, isLexSpecialSym,
			  isLocallyDefined, changeUnique,
			  getOccName, origName, moduleOf,
158 159
			  isExported, ExportFlag(..),
			  RdrName(..), Name
160
			)
161
import FieldLabel	( fieldLabelName, FieldLabel(..){-instances-} )
162
import PragmaInfo	( PragmaInfo(..) )
163
import PprEnv		-- ( SYN_IE(NmbrM), NmbrEnv(..) )
164
import PprType		( getTypeString, typeMaybeString, specMaybeTysSuffix,
165
			  nmbrType, nmbrTyVar,
166 167
			  GenType, GenTyVar
			)
168 169
import PprStyle
import Pretty
170
import MatchEnv		( MatchEnv )
171
import SrcLoc		( mkBuiltinSrcLoc )
172
import TyCon		( TyCon, mkTupleTyCon, tyConDataCons )
173
import Type		( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
174
			  applyTyCon, instantiateTy, mkForAllTys,
175
			  tyVarsOfType, applyTypeEnvToTy, typePrimRep,
176
			  GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
177
			)
178
import TyVar		( alphaTyVars, isEmptyTyVarSet, SYN_IE(TyVarEnv) )
179
import UniqFM
180
import UniqSet		-- practically all of it
181 182
import Unique		( getBuiltinUniques, pprUnique, showUnique,
			  incrUnique,
183 184
			  Unique{-instance Ord3-}
			)
185
import Util		( mapAccumL, nOfThem, zipEqual,
186 187
			  panic, panic#, pprPanic, assertPanic
			)
188 189 190 191 192 193
\end{code}

Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
follow.

Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
194
@Type@, and an @IdInfo@ (non-essential info about it, e.g.,
195 196 197 198 199 200
strictness).  The essential info about different kinds of @Ids@ is
in its @IdDetails@.

ToDo: possibly cache other stuff in the single-constructor @Id@ type.

\begin{code}
201 202
data GenId ty = Id
	Unique		-- Key for fast comparison
203
	Name
204 205 206 207 208 209 210 211 212
	ty		-- Id's type; used all the time;
	IdDetails	-- Stuff about individual kinds of Ids.
	PragmaInfo	-- Properties of this Id requested by programmer
			-- eg specialise-me, inline-me
	IdInfo		-- Properties of this Id deduced by compiler
				   
type Id = GenId Type

data StrictnessMark = MarkedStrict | NotMarkedStrict
213 214 215 216 217

data IdDetails

  ---------------- Local values

218 219
  = LocalId	Bool		-- Local name; mentioned by the user
				-- True <=> no free type vars
220

221 222
  | SysLocalId	Bool	        -- Local name; made up by the compiler
				-- as for LocalId
223

224
  | SpecPragmaId 		-- Local name; introduced by the compiler
225 226
		 (Maybe Id)	-- for explicit specid in pragma
		 Bool		-- as for LocalId
227 228 229

  ---------------- Global values

230
  | ImportedId			-- Global name (Imported or Implicit); Id imported from an interface
231

232
  | TopLevId			-- Global name (LocalDef); Top-level in the orig source pgm
233 234 235 236 237 238 239
				-- (not moved there by transformations).

	-- a TopLevId's type may contain free type variables, if
	-- the monomorphism restriction applies.

  ---------------- Data constructors

240
  | DataConId	ConTag
241
		[StrictnessMark] -- Strict args; length = arity
242
		[FieldLabel]	-- Field labels for this constructor
243

244 245 246 247
		[TyVar] [(Class,Type)] [Type] TyCon
				-- the type is:
				-- forall tyvars . theta_ty =>
				--    unitype_1 -> ... -> unitype_n -> tycon tyvars
248

249
  | TupleConId	Int		-- Its arity
250

251
  | RecordSelId FieldLabel
252

253 254 255 256 257 258
  ---------------- Things to do with overloading

  | SuperDictSelId		-- Selector for superclass dictionary
		Class		-- The class (input dict)
		Class		-- The superclass (result dict)

259
  | MethodSelId	Class		-- An overloaded class operation, with
260 261 262 263 264
				-- a fully polymorphic type.  Its code
				-- just selects a method from the
				-- dictionary.  The class.
		ClassOp		-- The operation

265
	-- NB: The IdInfo for a MethodSelId has all the info about its
266 267 268 269
	-- related "constant method Ids", which are just
	-- specialisations of this general one.

  | DefaultMethodId		-- Default method for a particular class op
270
		Class		-- same class, <blah-blah> info as MethodSelId
271 272 273 274
		ClassOp		-- (surprise, surprise)
		Bool		-- True <=> I *know* this default method Id
				-- is a generated one that just says
				-- `error "No default method for <op>"'.
275 276 277 278 279 280 281 282 283

				-- see below
  | DictFunId	Class		-- A DictFun is uniquely identified
		Type		-- by its class and type; this type has free type vars,
				-- whose identity is irrelevant.  Eg Class = Eq
				--				     Type  = Tree a
				-- The "a" is irrelevant.  As it is too painful to
				-- actually do comparisons that way, we kindly supply
				-- a Unique for that purpose.
284
		Module		-- module where instance came from
285 286 287 288 289 290 291

				-- see below
  | ConstMethodId		-- A method which depends only on the type of the
				-- instance, and not on any further dictionaries etc.
		Class		-- Uniquely identified by:
		Type		-- (class, type, classop) triple
		ClassOp
292
		Module		-- module where instance came from
293

294
  | InstId			-- An instance of a dictionary, class operation,
295
				-- or overloaded value (Local name)
296
		Bool		-- as for LocalId
297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313

  | SpecId			-- A specialisation of another Id
		Id		-- Id of which this is a specialisation
		[Maybe Type]	-- Types at which it is specialised;
				-- A "Nothing" says this type ain't relevant.
		Bool		-- True <=> no free type vars; it's not enough
				-- to know about the unspec version, because
				-- we may specialise to a type w/ free tyvars
				-- (i.e., in one of the "Maybe Type" dudes).

  | WorkerId			-- A "worker" for some other Id
		Id		-- Id for which this is a worker

type ConTag	= Int
type DictVar	= Id
type DictFun	= Id
type DataCon	= Id
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336
\end{code}

DictFunIds are generated from instance decls.
\begin{verbatim}
	class Foo a where
	  op :: a -> a -> Bool

	instance Foo a => Foo [a] where
	  op = ...
\end{verbatim}
generates the dict fun id decl
\begin{verbatim}
	dfun.Foo.[*] = \d -> ...
\end{verbatim}
The dfun id is uniquely named by the (class, type) pair.  Notice, it
isn't a (class,tycon) pair any more, because we may get manually or
automatically generated specialisations of the instance decl:
\begin{verbatim}
	instance Foo [Int] where
	  op = ...
\end{verbatim}
generates
\begin{verbatim}
337
	dfun.Foo.[Int] = ...
338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
\end{verbatim}
The type variables in the name are irrelevant; we print them as stars.


Constant method ids are generated from instance decls where
there is no context; that is, no dictionaries are needed to
construct the method.  Example
\begin{verbatim}
	instance Foo Int where
	  op = ...
\end{verbatim}
Then we get a constant method
\begin{verbatim}
	Foo.op.Int = ...
\end{verbatim}

It is possible, albeit unusual, to have a constant method
for an instance decl which has type vars:
\begin{verbatim}
	instance Foo [a] where
	  op []     ys = True
	  op (x:xs) ys = False
\end{verbatim}
We get the constant method
\begin{verbatim}
	Foo.op.[*] = ...
\end{verbatim}
So a constant method is identified by a class/op/type triple.
The type variables in the type are irrelevant.


For Ids whose names must be known/deducible in other modules, we have
to conjure up their worker's names (and their worker's worker's
names... etc) in a known systematic way.

373

374 375 376 377 378 379 380 381 382
%************************************************************************
%*									*
\subsection[Id-documentation]{Documentation}
%*									*
%************************************************************************

[A BIT DATED [WDP]]

The @Id@ datatype describes {\em values}.  The basic things we want to
383
know: (1)~a value's {\em type} (@idType@ is a very common
384 385 386 387 388 389 390 391
operation in the compiler); and (2)~what ``flavour'' of value it might
be---for example, it can be terribly useful to know that a value is a
class method.

\begin{description}
%----------------------------------------------------------------------
\item[@DataConId@:] For the data constructors declared by a @data@
declaration.  Their type is kept in {\em two} forms---as a regular
392
@Type@ (in the usual place), and also in its constituent pieces (in
393 394 395 396 397 398 399 400 401 402 403 404 405 406
the ``details''). We are frequently interested in those pieces.

%----------------------------------------------------------------------
\item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
the infinite family of tuples.

%----------------------------------------------------------------------
\item[@ImportedId@:] These are values defined outside this module.
{\em Everything} we want to know about them must be stored here (or in
their @IdInfo@).

%----------------------------------------------------------------------
\item[@TopLevId@:] These are values defined at the top-level in this
module; i.e., those which {\em might} be exported (hence, a
407
@Name@).  It does {\em not} include those which are moved to the
408 409 410 411 412 413 414 415 416 417 418 419 420 421 422
top-level through program transformations.

We also guarantee that @TopLevIds@ will {\em stay} at top-level.
Theoretically, they could be floated inwards, but there's no known
advantage in doing so.	This way, we can keep them with the same
@Unique@ throughout (no cloning), and, in general, we don't have to be
so paranoid about them.

In particular, we had the following problem generating an interface:
We have to ``stitch together'' info (1)~from the typechecker-produced
global-values list (GVE) and (2)~from the STG code [which @Ids@ have
what arities].	If the @Uniques@ on the @TopLevIds@ can {\em change}
between (1) and (2), you're sunk!

%----------------------------------------------------------------------
423
\item[@MethodSelId@:] A selector from a dictionary; it may select either
424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472
a method or a dictionary for one of the class's superclasses.

%----------------------------------------------------------------------
\item[@DictFunId@:]

@mkDictFunId [a,b..] theta C T@ is the function derived from the
instance declaration

	instance theta => C (T a b ..) where
		...

It builds function @Id@ which maps dictionaries for theta,
to a dictionary for C (T a b ..).

*Note* that with the ``Mark Jones optimisation'', the theta may
include dictionaries for the immediate superclasses of C at the type
(T a b ..).

%----------------------------------------------------------------------
\item[@InstId@:]

%----------------------------------------------------------------------
\item[@SpecId@:]

%----------------------------------------------------------------------
\item[@WorkerId@:]

%----------------------------------------------------------------------
\item[@LocalId@:] A purely-local value, e.g., a function argument,
something defined in a @where@ clauses, ... --- but which appears in
the original program text.

%----------------------------------------------------------------------
\item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
the original program text; these are introduced by the compiler in
doing its thing.

%----------------------------------------------------------------------
\item[@SpecPragmaId@:] Introduced by the compiler to record
Specialisation pragmas. It is dead code which MUST NOT be removed
before specialisation.
\end{description}

Further remarks:
\begin{enumerate}
%----------------------------------------------------------------------
\item

@DataCons@ @TupleCons@, @Importeds@, @TopLevIds@, @SuperDictSelIds@,
473
@MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494
properties:
\begin{itemize}
\item
They have no free type variables, so if you are making a
type-variable substitution you don't need to look inside them.
\item
They are constants, so they are not free variables.  (When the STG
machine makes a closure, it puts all the free variables in the
closure; the above are not required.)
\end{itemize}
Note that @InstIds@, @Locals@ and @SysLocals@ {\em may} have the above
properties, but they may not.
\end{enumerate}

%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

\begin{code}
495
unsafeGenId2Id :: GenId ty -> Id
496
unsafeGenId2Id (Id u n ty d p i) = Id u n (panic "unsafeGenId2Id:ty") d p i
497 498 499

isDataCon id = is_data (unsafeGenId2Id id)
 where
500 501 502
  is_data (Id _ _ _ (DataConId _ _ _ _ _ _ _) _ _) = True
  is_data (Id _ _ _ (TupleConId _) _ _)		   = True
  is_data (Id _ _ _ (SpecId unspec _ _) _ _)	   = is_data unspec
503
  is_data other					   = False
504 505 506 507


isTupleCon id = is_tuple (unsafeGenId2Id id)
 where
508 509
  is_tuple (Id _ _ _ (TupleConId _) _ _)	 = True
  is_tuple (Id _ _ _ (SpecId unspec _ _) _ _)	 = is_tuple unspec
510 511 512
  is_tuple other				 = False

{-LATER:
513
isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
514 515 516 517 518
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
    Just (unspec, ty_maybes)
isSpecId_maybe other_id
  = Nothing

519
isSpecPragmaId_maybe (Id _ _ _ (SpecPragmaId specid _) _ _)
520
  = Just specid
521 522
isSpecPragmaId_maybe other_id
  = Nothing
523
-}
524 525
\end{code}

526 527 528 529
@toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
@let(rec)@ (returns @False@), or whether it is {\em sure} to be
defined at top level (returns @True@). This is used to decide whether
the @Id@ is a candidate free variable. NB: you are only {\em sure}
530 531 532
about something if it returns @True@!

\begin{code}
533 534
toplevelishId	  :: Id -> Bool
idHasNoFreeTyVars :: Id -> Bool
535

536
toplevelishId (Id _ _ _ details _ _)
537 538
  = chk details
  where
539 540
    chk (DataConId _ _ _ _ _ _ _)   = True
    chk (TupleConId _)    	    = True
541
    chk (RecordSelId _)   	    = True
542 543
    chk ImportedId	    	    = True
    chk TopLevId	    	    = True	-- NB: see notes
544 545 546
    chk (SuperDictSelId _ _)	    = True
    chk (MethodSelId _ _)	    = True
    chk (DefaultMethodId _ _ _)     = True
547 548
    chk (DictFunId     _ _ _)	    = True
    chk (ConstMethodId _ _ _ _)     = True
549 550 551
    chk (SpecId unspec _ _)	    = toplevelishId unspec
				    -- depends what the unspecialised thing is
    chk (WorkerId unwrkr)	    = toplevelishId unwrkr
552 553 554 555
    chk (InstId	      _)	    = False	-- these are local
    chk (LocalId      _)	    = False
    chk (SysLocalId   _)	    = False
    chk (SpecPragmaId _ _)	    = False
556

557
idHasNoFreeTyVars (Id _ _ _ details _ info)
558 559
  = chk details
  where
560 561
    chk (DataConId _ _ _ _ _ _ _) = True
    chk (TupleConId _)    	  = True
562
    chk (RecordSelId _)   	  = True
563 564
    chk ImportedId	    	  = True
    chk TopLevId	    	  = True
565
    chk (SuperDictSelId _ _)	  = True
566
    chk (MethodSelId _ _)	  = True
567
    chk (DefaultMethodId _ _ _)   = True
568 569
    chk (DictFunId     _ _ _)	  = True
    chk (ConstMethodId _ _ _ _)   = True
570
    chk (WorkerId unwrkr)	  = idHasNoFreeTyVars unwrkr
571
    chk (SpecId _     _   no_free_tvs) = no_free_tvs
572 573 574 575
    chk (InstId         no_free_tvs) = no_free_tvs
    chk (LocalId        no_free_tvs) = no_free_tvs
    chk (SysLocalId     no_free_tvs) = no_free_tvs
    chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
576 577 578
\end{code}

\begin{code}
579 580
isTopLevId (Id _ _ _ TopLevId _ _) = True
isTopLevId other		   = False
581

582 583
isImportedId (Id _ _ _ ImportedId _ _) = True
isImportedId other		       = False
584

585
isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (getInfo info)
586

587
isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
588 589
isSysLocalId other			   = False

590
isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
591 592
isSpecPragmaId other			         = False

593 594
isMethodSelId (Id _ _ _ (MethodSelId _ _) _ _) = True
isMethodSelId _				       = False
595

596 597
isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
isDefaultMethodId other				         = False
598

599
isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls clsop err) _ _)
600 601 602
  = Just (cls, clsop, err)
isDefaultMethodId_maybe other = Nothing

603
isDictFunId (Id _ _ _ (DictFunId _ _ _) _ _) = True
604 605
isDictFunId other		    	     = False

606
isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _) _ _) = True
607 608
isConstMethodId other		    		       = False

609
isConstMethodId_maybe (Id _ _ _ (ConstMethodId cls ty clsop _) _ _)
610 611 612
  = Just (cls, ty, clsop)
isConstMethodId_maybe other = Nothing

613
isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
614 615
isSuperDictSelId_maybe other_id				  = Nothing

616
isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
617 618
isWorkerId other		     = False

619 620 621 622
isWrapperId id = workerExists (getIdStrictness id)
\end{code}

\begin{code}
623
{-LATER:
624 625 626 627
pprIdInUnfolding :: IdSet -> Id -> Pretty

pprIdInUnfolding in_scopes v
  = let
628
	v_ty = idType v
629 630 631
    in
    -- local vars first:
    if v `elementOfUniqSet` in_scopes then
632
	pprUnique (idUnique v)
633 634 635 636 637

    -- ubiquitous Ids with special syntax:
    else if v == nilDataCon then
	ppPStr SLIT("_NIL_")
    else if isTupleCon v then
638
	ppBeside (ppPStr SLIT("_TUP_")) (ppInt (dataConArity v))
639 640 641 642

    -- ones to think about:
    else
	let
643
	    (Id _ _ _ v_details _ _) = v
644 645 646
	in
    	case v_details of
	    -- these ones must have been exported by their original module
647
	  ImportedId   -> pp_full_name
648 649

	    -- these ones' exportedness checked later...
650 651
	  TopLevId  -> pp_full_name
	  DataConId _ _ _ _ _ _ _ -> pp_full_name
652

653
	  RecordSelId lbl -> ppr sty lbl
654 655 656 657

	    -- class-ish things: class already recorded as "mentioned"
	  SuperDictSelId c sc
	    -> ppCat [ppPStr SLIT("_SDSEL_"), pp_class c, pp_class sc]
658
	  MethodSelId c o
659 660 661 662 663 664
	    -> ppCat [ppPStr SLIT("_METH_"), pp_class c, pp_class_op o]
	  DefaultMethodId c o _
	    -> ppCat [ppPStr SLIT("_DEFM_"), pp_class c, pp_class_op o]

	    -- instance-ish things: should we try to figure out
	    -- *exactly* which extra instances have to be exported? (ToDo)
665
	  DictFunId  c t _
666
	    -> ppCat [ppPStr SLIT("_DFUN_"), pp_class c, pp_type t]
667
	  ConstMethodId c t o _
668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691
	    -> ppCat [ppPStr SLIT("_CONSTM_"), pp_class c, pp_class_op o, pp_type t]

	  -- specialisations and workers
	  SpecId unspec ty_maybes _
	    -> let
		  pp = pprIdInUnfolding in_scopes unspec
	       in
	       ppCat [ppPStr SLIT("_SPEC_"), pp, ppLbrack,
			ppIntersperse pp'SP{-'-} (map pp_ty_maybe ty_maybes),
			ppRbrack]

	  WorkerId unwrkr
	    -> let
		  pp = pprIdInUnfolding in_scopes unwrkr
	       in
	       ppBeside (ppPStr SLIT("_WRKR_ ")) pp

	  -- anything else? we're nae interested
	  other_id -> panic "pprIdInUnfolding:mystery Id"
  where
    ppr_Unfolding = PprUnfolding (panic "Id:ppr_Unfolding")

    pp_full_name
      = let
692
	    (OrigName m_str n_str) = origName "Id:ppr_Unfolding" v
693 694

	    pp_n =
695
	      if isLexSym n_str && not (isLexSpecialSym n_str) then
696 697 698 699
		  ppBesides [ppLparen, ppPStr n_str, ppRparen]
	      else
		  ppPStr n_str
	in
700
	if isPreludeDefined v then
701 702 703 704 705 706
	    pp_n
	else
	    ppCat [ppPStr SLIT("_ORIG_"), ppPStr m_str, pp_n]

    pp_class :: Class -> Pretty
    pp_class_op :: ClassOp -> Pretty
707 708
    pp_type :: Type -> Pretty
    pp_ty_maybe :: Maybe Type -> Pretty
709 710 711 712 713 714 715 716

    pp_class    clas = ppr ppr_Unfolding clas
    pp_class_op op   = ppr ppr_Unfolding op

    pp_type t = ppBesides [ppLparen, ppr ppr_Unfolding t, ppRparen]

    pp_ty_maybe Nothing  = ppPStr SLIT("_N_")
    pp_ty_maybe (Just t) = pp_type t
717
-}
718 719 720 721 722 723 724 725
\end{code}

@whatsMentionedInId@ ferrets out the types/classes/instances on which
this @Id@ depends.  If this Id is to appear in an interface, then
those entities had Jolly Well be in scope.  Someone else up the
call-tree decides that.

\begin{code}
726
{-LATER:
727 728 729 730 731 732 733
whatsMentionedInId
	:: IdSet			    -- Ids known to be in scope
	-> Id				    -- Id being processed
	-> (Bag Id, Bag TyCon, Bag Class)   -- mentioned Ids/TyCons/etc.

whatsMentionedInId in_scopes v
  = let
734
	v_ty = idType v
735 736

    	(tycons, clss)
737
	  = getMentionedTyConsAndClassesFromType v_ty
738 739 740 741 742 743 744 745 746 747 748 749 750 751 752

	result0 id_bag = (id_bag, tycons, clss)

	result1 ids tcs cs
	  = (ids `unionBags` unitBag v,	-- we add v to "mentioned"...
	     tcs `unionBags` tycons,
	     cs  `unionBags` clss)
    in
    -- local vars first:
    if v `elementOfUniqSet` in_scopes then
	result0 emptyBag    -- v not added to "mentioned"

    -- ones to think about:
    else
	let
753
	    (Id _ _ _ v_details _ _) = v
754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769
	in
    	case v_details of
	  -- specialisations and workers
	  SpecId unspec ty_maybes _
	    -> let
		  (ids2, tcs2, cs2) = whatsMentionedInId in_scopes unspec
	       in
	       result1 ids2 tcs2 cs2

	  WorkerId unwrkr
	    -> let
		  (ids2, tcs2, cs2) = whatsMentionedInId in_scopes unwrkr
	       in
	       result1 ids2 tcs2 cs2

	  anything_else -> result0 (unitBag v) -- v is  added to "mentioned"
770
-}
771 772 773 774
\end{code}

Tell them who my wrapper function is.
\begin{code}
775
{-LATER:
776 777
myWrapperMaybe :: Id -> Maybe Id

778
myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper) _ _) = Just my_wrapper
779 780
myWrapperMaybe other_id			    	  = Nothing
-}
781 782 783 784 785 786 787 788
\end{code}

\begin{code}
unfoldingUnfriendlyId	-- return True iff it is definitely a bad
	:: Id		-- idea to export an unfolding that
	-> Bool		-- mentions this Id.  Reason: it cannot
			-- possibly be seen in another module.

789
unfoldingUnfriendlyId id = not (externallyVisibleId id)
790 791 792 793 794 795 796 797 798 799 800 801 802
\end{code}

@externallyVisibleId@: is it true that another module might be
able to ``see'' this Id?

We need the @toplevelishId@ check as well as @isExported@ for when we
compile instance declarations in the prelude.  @DictFunIds@ are
``exported'' if either their class or tycon is exported, but, in
compiling the prelude, the compiler may not recognise that as true.

\begin{code}
externallyVisibleId :: Id -> Bool

803
externallyVisibleId id@(Id _ _ _ details _ _)
804
  = if isLocallyDefined id then
805 806 807 808 809 810
	toplevelishId id && (isExported id || isDataCon id)
	-- NB: the use of "isExported" is most dodgy;
	-- We may eventually move to a situation where
	-- every Id is "externallyVisible", even if the
	-- module system's namespace control renders it
	-- "not exported".
811
    else
812
	True
813 814 815 816 817 818
	-- if visible here, it must be visible elsewhere, too.
\end{code}

\begin{code}
idWantsToBeINLINEd :: Id -> Bool

819 820
idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
idWantsToBeINLINEd _				   = False
821 822 823 824

addInlinePragma :: Id -> Id
addInlinePragma (Id u sn ty details _ info)
  = Id u sn ty details IWantToBeINLINEd info
825 826 827 828 829 830
\end{code}

For @unlocaliseId@: See the brief commentary in
\tr{simplStg/SimplStg.lhs}.

\begin{code}
831
{-LATER:
832 833
unlocaliseId :: FAST_STRING{-modulename-} -> Id -> Maybe Id

834 835
unlocaliseId mod (Id u fn ty info TopLevId)
  = Just (Id u (unlocaliseFullName fn) ty info TopLevId)
836

837
unlocaliseId mod (Id u sn ty info (LocalId no_ftvs))
838 839 840 841
  = --false?: ASSERT(no_ftvs)
    let
	full_name = unlocaliseShortName mod u sn
    in
842
    Just (Id u full_name ty info TopLevId)
843

844
unlocaliseId mod (Id u sn ty info (SysLocalId no_ftvs))
845 846 847 848
  = --false?: on PreludeGlaST: ASSERT(no_ftvs)
    let
	full_name = unlocaliseShortName mod u sn
    in
849
    Just (Id u full_name ty info TopLevId)
850

851
unlocaliseId mod (Id u n ty info (SpecId unspec ty_maybes no_ftvs))
852 853
  = case unlocalise_parent mod u unspec of
      Nothing -> Nothing
854
      Just xx -> Just (Id u n ty info (SpecId xx ty_maybes no_ftvs))
855

856
unlocaliseId mod (Id u n ty info (WorkerId unwrkr))
857 858
  = case unlocalise_parent mod u unwrkr of
      Nothing -> Nothing
859
      Just xx -> Just (Id u n ty info (WorkerId xx))
860

861 862
unlocaliseId mod (Id u name ty info (InstId no_ftvs))
  = Just (Id u full_name ty info TopLevId)
863 864 865
	-- type might be wrong, but it hardly matters
	-- at this stage (just before printing C)  ToDo
  where
866
    name = nameOf (origName "Id.unlocaliseId" name)
867
    full_name = mkFullName mod name InventedInThisModule ExportAll mkGeneratedSrcLoc
868 869 870 871 872 873 874

unlocaliseId mod other_id = Nothing

--------------------
-- we have to be Very Careful for workers/specs of
-- local functions!

875
unlocalise_parent mod uniq (Id _ sn ty info (LocalId no_ftvs))
876 877 878 879
  = --false?: ASSERT(no_ftvs)
    let
	full_name = unlocaliseShortName mod uniq sn
    in
880
    Just (Id uniq full_name ty info TopLevId)
881

882
unlocalise_parent mod uniq (Id _ sn ty info (SysLocalId no_ftvs))
883 884 885 886
  = --false?: ASSERT(no_ftvs)
    let
	full_name = unlocaliseShortName mod uniq sn
    in
887
    Just (Id uniq full_name ty info TopLevId)
888 889 890

unlocalise_parent mod uniq other_id = unlocaliseId mod other_id
  -- we're OK otherwise
891
-}
892 893 894 895 896 897 898 899 900 901
\end{code}

CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
`Top-levelish Ids'' cannot have any free type variables, so applying
the type-env cannot have any effect.  (NB: checked in CoreLint?)

The special casing is in @applyTypeEnvToId@, not @apply_to_Id@, as the
former ``should be'' the usual crunch point.

\begin{code}
902 903
type TypeEnv = TyVarEnv Type

904 905
applyTypeEnvToId :: TypeEnv -> Id -> Id

906
applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
907 908 909 910 911 912 913 914 915
  | idHasNoFreeTyVars id
  = id
  | otherwise
  = apply_to_Id ( \ ty ->
	applyTypeEnvToTy type_env ty
    ) id
\end{code}

\begin{code}
916
apply_to_Id :: (Type -> Type) -> Id -> Id
917

918
apply_to_Id ty_fn (Id u n ty details prag info)
919 920 921
  = let
	new_ty = ty_fn ty
    in
922
    Id u n new_ty (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
923 924 925 926 927 928
  where
    apply_to_details (SpecId unspec ty_maybes no_ftvs)
      = let
	    new_unspec = apply_to_Id ty_fn unspec
	    new_maybes = map apply_to_maybe ty_maybes
	in
929 930
	SpecId new_unspec new_maybes (no_free_tvs ty)
	-- ToDo: gratuitous recalc no_ftvs???? (also InstId)
931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950
      where
	apply_to_maybe Nothing   = Nothing
	apply_to_maybe (Just ty) = Just (ty_fn ty)

    apply_to_details (WorkerId unwrkr)
      = let
	    new_unwrkr = apply_to_Id ty_fn unwrkr
	in
	WorkerId new_unwrkr

    apply_to_details other = other
\end{code}

Sadly, I don't think the one using the magic typechecker substitution
can be done with @apply_to_Id@.  Here we go....

Strictness is very important here.  We can't leave behind thunks
with pointers to the substitution: it {\em must} be single-threaded.

\begin{code}
951
{-LATER:
952 953
applySubstToId :: Subst -> Id -> (Subst, Id)

954
applySubstToId subst id@(Id u n ty info details)
955 956 957 958 959 960
  -- *cannot* have a "idHasNoFreeTyVars" get-out clause
  -- because, in the typechecker, we are still
  -- *concocting* the types.
  = case (applySubstToTy     subst ty)		of { (s2, new_ty)      ->
    case (applySubstToIdInfo s2    info)	of { (s3, new_info)    ->
    case (apply_to_details   s3 new_ty details) of { (s4, new_details) ->
961
    (s4, Id u n new_ty new_info new_details) }}}
962
  where
963
    apply_to_details subst _ (InstId inst no_ftvs)
964
      = case (applySubstToInst subst inst) of { (s2, new_inst) ->
965
	(s2, InstId new_inst no_ftvs{-ToDo:right???-}) }
966 967 968

    apply_to_details subst new_ty (SpecId unspec ty_maybes _)
      = case (applySubstToId subst unspec)  	     of { (s2, new_unspec) ->
969
	case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
970 971 972 973 974 975 976 977 978 979
	(s3, SpecId new_unspec new_maybes (no_free_tvs new_ty)) }}
	-- NB: recalc no_ftvs (I think it's necessary (?) WDP 95/04)
      where
	apply_to_maybe subst Nothing   = (subst, Nothing)
	apply_to_maybe subst (Just ty)
	  = case (applySubstToTy subst ty) of { (s2, new_ty) ->
	    (s2, Just new_ty) }

    apply_to_details subst _ (WorkerId unwrkr)
      = case (applySubstToId subst unwrkr) of { (s2, new_unwrkr) ->
980
	(s2, WorkerId new_unwrkr) }
981 982

    apply_to_details subst _ other = (subst, other)
983
-}
984 985 986 987 988 989 990 991 992
\end{code}

%************************************************************************
%*									*
\subsection[Id-type-funs]{Type-related @Id@ functions}
%*									*
%************************************************************************

\begin{code}
993 994
idType :: GenId ty -> ty

995
idType (Id _ _ ty _ _ _) = ty
996 997 998
\end{code}

\begin{code}
999
{-LATER:
1000 1001 1002
getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)

getMentionedTyConsAndClassesFromId id
1003 1004
 = getMentionedTyConsAndClassesFromType (idType id)
-}
1005 1006 1007
\end{code}

\begin{code}
1008
idPrimRep i = typePrimRep (idType i)
1009 1010
\end{code}

1011
\begin{code}
1012
{-LATER:
1013 1014
getInstIdModule (Id _ _ _ (DictFunId _ _ mod)) = mod
getInstIdModule (Id _ _ _ (ConstMethodId _ _ _ mod)) = mod
1015
getInstIdModule other = panic "Id:getInstIdModule"
1016 1017 1018 1019 1020 1021 1022 1023 1024 1025
-}
\end{code}

%************************************************************************
%*									*
\subsection[Id-overloading]{Functions related to overloading}
%*									*
%************************************************************************

\begin{code}
1026
mkSuperDictSelId u c sc ty info
1027
  = mk_classy_id (SuperDictSelId c sc) SLIT("sdsel") (Left (origName "mkSuperDictSelId" sc)) u c ty info
1028

1029
mkMethodSelId u rec_c op ty info
1030
  = mk_classy_id (MethodSelId rec_c op) SLIT("meth") (Right (classOpString op)) u rec_c ty info
1031

1032
mkDefaultMethodId u rec_c op gen ty info
1033 1034 1035 1036
  = mk_classy_id (DefaultMethodId rec_c op gen) SLIT("defm") (Right (classOpString op)) u rec_c ty info

mk_classy_id details str op_str u rec_c ty info
  = Id u n ty details NoPragmaInfo info
1037
  where
1038
    cname = getName rec_c -- we get other info out of here
1039 1040
    cname_orig = origName "mk_classy_id" cname
    cmod = moduleOf cname_orig
1041

1042
    n = mkCompoundName u cmod str [Left cname_orig, op_str] cname
1043 1044 1045 1046

mkDictFunId u c ity full_ty from_here locn mod info
  = Id u n full_ty (DictFunId c ity mod) NoPragmaInfo info
  where
1047
    n = mkCompoundName2 u mod SLIT("dfun") (Left (origName "mkDictFunId" c) : renum_type_string full_ty ity) from_here locn
1048 1049 1050 1051

mkConstMethodId	u c op ity full_ty from_here locn mod info
  = Id u n full_ty (ConstMethodId c ity op mod) NoPragmaInfo info
  where
1052 1053 1054 1055 1056 1057 1058 1059
    n = mkCompoundName2 u mod SLIT("const") (Left (origName "mkConstMethodId" c) : Right (classOpString op) : renum_type_string full_ty ity) from_here locn

renum_type_string full_ty ity
  = initNmbr (
	nmbrType full_ty    `thenNmbr` \ _ -> -- so all the tyvars get added to renumbering...
	nmbrType ity	    `thenNmbr` \ rn_ity ->
	returnNmbr (getTypeString rn_ity)
    )
1060 1061 1062 1063 1064

mkWorkerId u unwrkr ty info
  = Id u n ty (WorkerId unwrkr) NoPragmaInfo info
  where
    unwrkr_name = getName unwrkr
1065
    unwrkr_orig = origName "mkWorkerId" unwrkr_name
1066
    umod = moduleOf unwrkr_orig
1067

1068
    n = mkCompoundName u umod SLIT("wrk") [Left unwrkr_orig] unwrkr_name
1069 1070

mkInstId u ty name = Id u (changeUnique name u) ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
1071 1072 1073 1074 1075 1076 1077 1078 1079 1080

{-LATER:
getConstMethodId clas op ty
  = -- constant-method info is hidden in the IdInfo of
    -- the class-op id (as mentioned up above).
    let
	sel_id = getMethodSelId clas op
    in
    case (lookupConstMethodId (getIdSpecialisation sel_id) ty) of
      Just xx -> xx
1081 1082
      Nothing -> pprError "ERROR: getConstMethodId:" (ppAboves [
	ppCat [ppr PprDebug ty, ppr PprDebug ops, ppr PprDebug op_ids,
1083 1084 1085 1086
	       ppr PprDebug sel_id],
	ppStr "(This can arise if an interface pragma refers to an instance",
	ppStr "but there is no imported interface which *defines* that instance.",
	ppStr "The info above, however ugly, should indicate what else you need to import."
1087
	])
1088 1089 1090 1091 1092 1093 1094 1095 1096 1097
-}
\end{code}

%************************************************************************
%*									*
\subsection[local-funs]{@LocalId@-related functions}
%*									*
%************************************************************************

\begin{code}
1098
mkImported  n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
1099

1100 1101
{-LATER:
updateIdType :: Id -> Type -> Id
1102
updateIdType (Id u n _ info details) ty = Id u n ty info details
1103
-}
1104 1105 1106
\end{code}

\begin{code}
1107 1108 1109 1110
type MyTy a b = GenType (GenTyVar a) b
type MyId a b = GenId (MyTy a b)

no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
1111 1112 1113

-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
1114
mkSysLocal, mkUserLocal :: FAST_STRING -> Unique -> MyTy a b -> SrcLoc -> MyId a b
1115 1116

mkSysLocal str uniq ty loc
1117
  = Id uniq (mkLocalName uniq str True{-emph uniq-} loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
1118 1119

mkUserLocal str uniq ty loc
1120
  = Id uniq (mkLocalName uniq str False{-emph name-} loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
1121 1122

-- mkUserId builds a local or top-level Id, depending on the name given
1123
mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
1124 1125
mkUserId name ty pragma_info
  | isLocalName name
1126
  = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
1127
  | otherwise
1128 1129 1130
  = Id (nameUnique name) name ty 
	(if isLocallyDefinedName name then TopLevId else ImportedId)
	pragma_info noIdInfo
1131 1132 1133 1134 1135
\end{code}


\begin{code}
{-LATER:
1136

1137
-- for a SpecPragmaId being created by the compiler out of thin air...
1138 1139
mkSpecPragmaId :: FAST_STRING -> Unique -> Type -> Maybe Id -> SrcLoc -> Id
mkSpecPragmaId str uniq ty specid loc
1140
  = Id uniq (mkShortName str loc) ty noIdInfo (SpecPragmaId specid (no_free_tvs ty))
1141

1142
-- for new SpecId
1143 1144
mkSpecId u unspec ty_maybes ty info
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
1145
    Id u n ty info (SpecId unspec ty_maybes (no_free_tvs ty))
1146 1147 1148 1149

-- Specialised version of constructor: only used in STG and code generation
-- Note: The specialsied Id has the same unique as the unspeced Id

1150
mkSameSpecCon ty_maybes unspec@(Id u n ty info details)
1151 1152
  = ASSERT(isDataCon unspec)
    ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
1153
    Id u n new_ty info (SpecId unspec ty_maybes (no_free_tvs new_ty))
1154 1155 1156 1157
  where
    new_ty = specialiseTy ty ty_maybes 0

localiseId :: Id -> Id
1158 1159
localiseId id@(Id u n ty info details)
  = Id u (mkShortName name loc) ty info (LocalId (no_free_tvs ty))
1160
  where
1161
    name = getOccName id
1162
    loc  = getSrcLoc id
1163
-}
1164 1165 1166

mkIdWithNewUniq :: Id -> Unique -> Id

1167 1168
mkIdWithNewUniq (Id _ n ty details prag info) u
  = Id u (changeUnique n u) ty details prag info
1169 1170 1171 1172 1173 1174
\end{code}

Make some local @Ids@ for a template @CoreExpr@.  These have bogus
@Uniques@, but that's OK because the templates are supposed to be
instantiated before use.
\begin{code}
1175
mkTemplateLocals :: [Type] -> [Id]
1176
mkTemplateLocals tys
1177
  = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
1178 1179 1180 1181 1182
	    (getBuiltinUniques (length tys))
	    tys
\end{code}

\begin{code}
1183 1184
getIdInfo     :: GenId ty -> IdInfo
getPragmaInfo :: GenId ty -> PragmaInfo
1185

1186 1187
getIdInfo     (Id _ _ _ _ _ info) = info
getPragmaInfo (Id _ _ _ _ info _) = info
1188 1189 1190

replaceIdInfo :: Id -> IdInfo -> Id

1191
replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
1192

1193
{-LATER:
1194 1195 1196 1197
selectIdInfoForSpecId :: Id -> IdInfo
selectIdInfoForSpecId unspec
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
    noIdInfo `addInfo_UF` getIdUnfolding unspec
1198
-}
1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211
\end{code}

%************************************************************************
%*									*
\subsection[Id-arities]{Arity-related functions}
%*									*
%************************************************************************

For locally-defined Ids, the code generator maintains its own notion
of their arities; so it should not be asking...	 (but other things
besides the code-generator need arity info!)

\begin{code}
1212
getIdArity :: Id -> ArityInfo
1213 1214 1215 1216 1217
getIdArity id@(Id _ _ _ _ _ id_info)
  = --ASSERT( not (isDataCon id))
    getInfo id_info

dataConArity, dataConNumFields :: DataCon -> Int