Id.lhs 47.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,
sof's avatar
sof committed
22
	mkIdWithNewUniq, mkIdWithNewName,
23 24 25 26 27 28 29 30 31 32
	mkImported,
	mkInstId,
	mkMethodSelId,
	mkRecordSelId,
	mkSuperDictSelId,
	mkSysLocal,
	mkTemplateLocals,
	mkTupleCon,
	mkUserId,
	mkUserLocal,
33
	mkWorkerId,
34 35
	mkPrimitiveId, 
	setIdVisibility,
36 37 38

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

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

	recordSelectorFieldLabel,
53 54

	-- PREDICATES
55
	omitIfaceSigForId,
56 57
	cmpEqDataCon,
	cmpId,
58
	cmpId_withSpecDataCon,
59 60
	externallyVisibleId,
	idHasNoFreeTyVars,
sof's avatar
sof committed
61 62
	idWantsToBeINLINEd, getInlinePragma,
	idMustBeINLINEd, idMustNotBeINLINEd,
63 64 65 66 67 68 69 70
	isBottomingId,
	isConstMethodId,
	isConstMethodId_maybe,
	isDataCon,
	isDefaultMethodId,
	isDefaultMethodId_maybe,
	isDictFunId,
	isImportedId,
71 72
	isRecordSelector,
	isMethodSelId_maybe,
73 74 75
	isNullaryDataCon,
	isSpecPragmaId,
	isSuperDictSelId_maybe,
76
	isPrimitiveId_maybe,
77 78 79
	isSysLocalId,
	isTupleCon,
	isWorkerId,
80
	isWrapperId,
81 82
	toplevelishId,
	unfoldingUnfriendlyId,
83 84

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

95 96 97 98
	-- Specialialisation
	getIdSpecialisation,
	addIdSpecialisation,

99
	-- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
100
	addIdUnfolding,
101 102 103 104 105 106 107 108 109 110 111
	addIdArity,
	addIdDemandInfo,
	addIdStrictness,
	addIdUpdateInfo,
	getIdArity,
	getIdDemandInfo,
	getIdInfo,
	getIdStrictness,
	getIdUnfolding,
	getIdUpdateInfo,
	getPragmaInfo,
112
	replaceIdInfo,
sof's avatar
sof committed
113
	addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
114

115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
	-- 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,
137
	modifyIdEnv_Directly,
138 139 140 141 142 143 144
	nullIdEnv,
	rngIdEnv,
	unionIdSets,
	unionManyIdSets,
	unitIdEnv,
	unitIdSet
    ) where
145

146
IMP_Ubiq()
sof's avatar
sof committed
147

148 149
IMPORT_DELOOPER(IdLoop)   -- for paranoia checking
IMPORT_DELOOPER(TyLoop)   -- for paranoia checking
150

sof's avatar
sof committed
151

152
import Bag
153
import Class		( classOpString, SYN_IE(Class), GenClass, SYN_IE(ClassOp), GenClassOp )
154 155
import IdInfo
import Maybes		( maybeToBool )
sof's avatar
sof committed
156
import Name	{- 	( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
157
			  mkCompoundName, mkInstDeclName,
158 159 160 161 162
			  isLocallyDefinedName, occNameString, modAndOcc,
			  isLocallyDefined, changeUnique, isWiredInName,
			  nameString, getOccString, setNameVisibility,
			  isExported, ExportFlag(..), DefnInfo, Provenance,
			  OccName(..), Name
sof's avatar
sof committed
163
			) -}
164 165
import PrelMods		( pREL_TUP, pREL_BASE )
import Lex		( mkTupNameStr )
166
import FieldLabel	( fieldLabelName, FieldLabel(..){-instances-} )
167
import PragmaInfo	( PragmaInfo(..) )
sof's avatar
sof committed
168 169 170
#if __GLASGOW_HASKELL__ >= 202
import PrimOp	        ( PrimOp )
#endif
171
import PprEnv		-- ( SYN_IE(NmbrM), NmbrEnv(..) )
172
import PprType		( getTypeString, specMaybeTysSuffix,
173
			  nmbrType, nmbrTyVar,
174 175
			  GenType, GenTyVar
			)
176 177
import PprStyle
import Pretty
178
import MatchEnv		( MatchEnv )
sof's avatar
sof committed
179
import SrcLoc		--( mkBuiltinSrcLoc )
180
import TysWiredIn	( tupleTyCon )
sof's avatar
sof committed
181 182
import TyCon		--( TyCon, tyConDataCons )
import Type	{-	( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
183
			  applyTyCon, instantiateTy, mkForAllTys,
184
			  tyVarsOfType, applyTypeEnvToTy, typePrimRep,
185
			  GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
sof's avatar
sof committed
186 187
			) -}
import TyVar		--( alphaTyVars, isEmptyTyVarSet, SYN_IE(TyVarEnv) )
188
import Usage		( SYN_IE(UVar) )
189
import UniqFM
190
import UniqSet		-- practically all of it
191
import Unique		( getBuiltinUniques, pprUnique, showUnique,
192
			  incrUnique, 
193 194
			  Unique{-instance Ord3-}
			)
sof's avatar
sof committed
195 196
import Outputable	( ifPprDebug, Outputable(..) )
import Util	{-	( mapAccumL, nOfThem, zipEqual, assoc,
197
			  panic, panic#, pprPanic, assertPanic
sof's avatar
sof committed
198
			) -}
199 200 201 202 203 204
\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
205
@Type@, and an @IdInfo@ (non-essential info about it, e.g.,
206 207 208 209 210 211
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}
212 213
data GenId ty = Id
	Unique		-- Key for fast comparison
214
	Name
215 216 217 218 219 220
	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
				   
221
type Id	           = GenId Type
222 223

data StrictnessMark = MarkedStrict | NotMarkedStrict
224 225 226 227 228

data IdDetails

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

229 230
  = LocalId	Bool		-- Local name; mentioned by the user
				-- True <=> no free type vars
231

232 233
  | SysLocalId	Bool	        -- Local name; made up by the compiler
				-- as for LocalId
234

235 236
  | PrimitiveId PrimOp		-- The Id for a primitive operation

237
  | SpecPragmaId 		-- Local name; introduced by the compiler
238 239
		 (Maybe Id)	-- for explicit specid in pragma
		 Bool		-- as for LocalId
240 241 242

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

243
  | ImportedId			-- Global name (Imported or Implicit); Id imported from an interface
244 245 246

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

247
  | DataConId	ConTag
248
		[StrictnessMark] -- Strict args; length = arity
sof's avatar
sof committed
249 250
		[FieldLabel]	-- Field labels for this constructor; 
				--length = 0 (not a record) or arity
251

sof's avatar
sof committed
252 253 254 255
		[TyVar] [(Class,Type)] 	-- Type vars and context for the data type decl
		[TyVar] [(Class,Type)] 	-- Ditto for the context of the constructor, 
					-- the existentially quantified stuff
		[Type] TyCon		-- Args and result tycon
256
				-- the type is:
sof's avatar
sof committed
257
				-- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
258
				--    unitype_1 -> ... -> unitype_n -> tycon tyvars
259

260
  | TupleConId	Int		-- Its arity
261

262
  | RecordSelId FieldLabel
263

264 265 266 267 268 269
  ---------------- Things to do with overloading

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

270
  | MethodSelId	Class		-- An overloaded class operation, with
271 272 273 274 275
				-- a fully polymorphic type.  Its code
				-- just selects a method from the
				-- dictionary.  The class.
		ClassOp		-- The operation

276
	-- NB: The IdInfo for a MethodSelId has all the info about its
277 278 279 280
	-- related "constant method Ids", which are just
	-- specialisations of this general one.

  | DefaultMethodId		-- Default method for a particular class op
281
		Class		-- same class, <blah-blah> info as MethodSelId
282 283 284 285
		ClassOp		-- (surprise, surprise)
		Bool		-- True <=> I *know* this default method Id
				-- is a generated one that just says
				-- `error "No default method for <op>"'.
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301

				-- 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.

				-- 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
302
		Module		-- module where instance came from
303

304
  | InstId			-- An instance of a dictionary, class operation,
305
				-- or overloaded value (Local name)
306
		Bool		-- as for LocalId
307 308 309 310 311 312 313 314 315 316

  | 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).

317 318
-- Scheduled for deletion: SLPJ Nov 96
-- Nobody seems to depend on knowing this.
319 320 321 322 323 324 325
  | 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
326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348
\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}
349
	dfun.Foo.[Int] = ...
350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384
\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.

385

386 387 388 389 390 391 392 393 394
%************************************************************************
%*									*
\subsection[Id-documentation]{Documentation}
%*									*
%************************************************************************

[A BIT DATED [WDP]]

The @Id@ datatype describes {\em values}.  The basic things we want to
395
know: (1)~a value's {\em type} (@idType@ is a very common
396 397 398 399 400 401 402 403
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
404
@Type@ (in the usual place), and also in its constituent pieces (in
405 406 407 408 409 410 411 412 413 414 415 416
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@).

%----------------------------------------------------------------------
417
\item[@MethodSelId@:] A selector from a dictionary; it may select either
418 419 420 421 422 423 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
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

466
@DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
467
@MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488
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}
sof's avatar
sof committed
489 490 491 492
isDataCon (Id _ _ _ (DataConId _ __ _ _ _ _ _ _) _ _) = True
isDataCon (Id _ _ _ (TupleConId _) _ _)		      = True
isDataCon (Id _ _ _ (SpecId unspec _ _) _ _)	      = isDataCon unspec
isDataCon other					      = False
493

494 495 496
isTupleCon (Id _ _ _ (TupleConId _) _ _)	 = True
isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _)	 = isTupleCon unspec
isTupleCon other				 = False
497 498

{-LATER:
499
isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
500 501 502 503 504
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
    Just (unspec, ty_maybes)
isSpecId_maybe other_id
  = Nothing

505
isSpecPragmaId_maybe (Id _ _ _ (SpecPragmaId specid _) _ _)
506
  = Just specid
507 508
isSpecPragmaId_maybe other_id
  = Nothing
509
-}
510 511
\end{code}

512 513 514 515
@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}
516 517 518
about something if it returns @True@!

\begin{code}
519 520
toplevelishId	  :: Id -> Bool
idHasNoFreeTyVars :: Id -> Bool
521

522
toplevelishId (Id _ _ _ details _ _)
523 524
  = chk details
  where
sof's avatar
sof committed
525
    chk (DataConId _ __ _ _ _ _ _ _)   = True
526
    chk (TupleConId _)    	    = True
527
    chk (RecordSelId _)   	    = True
528
    chk ImportedId	    	    = True
529 530 531
    chk (SuperDictSelId _ _)	    = True
    chk (MethodSelId _ _)	    = True
    chk (DefaultMethodId _ _ _)     = True
532
    chk (DictFunId     _ _)	    = True
533
    chk (ConstMethodId _ _ _ _)     = True
534 535 536
    chk (SpecId unspec _ _)	    = toplevelishId unspec
				    -- depends what the unspecialised thing is
    chk (WorkerId unwrkr)	    = toplevelishId unwrkr
537 538 539 540
    chk (InstId	      _)	    = False	-- these are local
    chk (LocalId      _)	    = False
    chk (SysLocalId   _)	    = False
    chk (SpecPragmaId _ _)	    = False
541
    chk (PrimitiveId _)		    = True
542

543
idHasNoFreeTyVars (Id _ _ _ details _ info)
544 545
  = chk details
  where
sof's avatar
sof committed
546
    chk (DataConId _ _ _ _ _ _ _ _ _) = True
547
    chk (TupleConId _)    	  = True
548
    chk (RecordSelId _)   	  = True
549
    chk ImportedId	    	  = True
550
    chk (SuperDictSelId _ _)	  = True
551
    chk (MethodSelId _ _)	  = True
552
    chk (DefaultMethodId _ _ _)   = True
553
    chk (DictFunId     _ _)	  = True
554
    chk (ConstMethodId _ _ _ _)   = True
555
    chk (WorkerId unwrkr)	  = idHasNoFreeTyVars unwrkr
556
    chk (SpecId _     _   no_free_tvs) = no_free_tvs
557 558 559 560
    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
561 562
    chk (PrimitiveId _)		    = True

563 564 565 566 567 568
-- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
-- so we don't need to put its signature in an interface file, even if it's mentioned
-- in some other interface unfolding.

omitIfaceSigForId
	:: Id
569 570
	-> Bool

571 572 573 574 575 576 577 578
omitIfaceSigForId (Id _ name _ details _ _)
  | isWiredInName name
  = True

  | otherwise
  = case details of
        ImportedId	  -> True		-- Never put imports in interface file
        (PrimitiveId _)	  -> True		-- Ditto, for primitives
579 580

	-- This group is Ids that are implied by their type or class decl;
581 582 583
	-- remember that all type and class decls appear in the interface file.
	-- The dfun id must *not* be omitted, because it carries version info for
	-- the instance decl
sof's avatar
sof committed
584
        (DataConId _ _ _ _ _ _ _ _ _) -> True
585 586 587 588 589 590 591
        (TupleConId _)    	  -> True
        (RecordSelId _)   	  -> True
        (SuperDictSelId _ _)	  -> True
        (MethodSelId _ _)	  -> True

	other			  -> False	-- Don't omit!
		-- NB DefaultMethodIds are not omitted
592 593 594
\end{code}

\begin{code}
595 596
isImportedId (Id _ _ _ ImportedId _ _) = True
isImportedId other		       = False
597

598
isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
599

600
isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
601 602
isSysLocalId other			   = False

603
isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
604 605
isSpecPragmaId other			         = False

606 607
isMethodSelId_maybe (Id _ _ _ (MethodSelId cls op) _ _) = Just (cls,op)
isMethodSelId_maybe _				        = Nothing
608

609 610
isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
isDefaultMethodId other				         = False
611

612
isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls clsop err) _ _)
613 614 615
  = Just (cls, clsop, err)
isDefaultMethodId_maybe other = Nothing

616 617
isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
isDictFunId other		    	   = False
618

619
isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _) _ _) = True
620 621
isConstMethodId other		    		       = False

622
isConstMethodId_maybe (Id _ _ _ (ConstMethodId cls ty clsop _) _ _)
623 624 625
  = Just (cls, ty, clsop)
isConstMethodId_maybe other = Nothing

626
isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
627 628
isSuperDictSelId_maybe other_id				  = Nothing

629
isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
630 631
isWorkerId other		     = False

632 633
isWrapperId id = workerExists (getIdStrictness id)

634 635
isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
isPrimitiveId_maybe other				= Nothing
636 637 638 639
\end{code}

Tell them who my wrapper function is.
\begin{code}
640
{-LATER:
641 642
myWrapperMaybe :: Id -> Maybe Id

643
myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper) _ _) = Just my_wrapper
644 645
myWrapperMaybe other_id			    	  = Nothing
-}
646 647 648 649 650 651 652 653
\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.

654
unfoldingUnfriendlyId id = not (externallyVisibleId id)
655 656 657
\end{code}

@externallyVisibleId@: is it true that another module might be
658 659
able to ``see'' this Id in a code generation sense. That
is, another .o file might refer to this Id.
660

661 662
In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
local-ness precisely so that the test here would be easy
663 664 665

\begin{code}
externallyVisibleId :: Id -> Bool
666 667
externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
		     -- not local => global => externally visible
668 669 670 671 672 673 674 675 676 677
\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}
678 679
type TypeEnv = TyVarEnv Type

680 681
applyTypeEnvToId :: TypeEnv -> Id -> Id

682
applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
683 684 685 686 687 688 689 690 691
  | idHasNoFreeTyVars id
  = id
  | otherwise
  = apply_to_Id ( \ ty ->
	applyTypeEnvToTy type_env ty
    ) id
\end{code}

\begin{code}
692
apply_to_Id :: (Type -> Type) -> Id -> Id
693

694
apply_to_Id ty_fn (Id u n ty details prag info)
695 696 697
  = let
	new_ty = ty_fn ty
    in
698
    Id u n new_ty (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
699 700 701 702 703 704
  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
705 706
	SpecId new_unspec new_maybes (no_free_tvs ty)
	-- ToDo: gratuitous recalc no_ftvs???? (also InstId)
707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726
      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}
727
{-LATER:
728 729
applySubstToId :: Subst -> Id -> (Subst, Id)

730
applySubstToId subst id@(Id u n ty info details)
731 732 733 734 735 736
  -- *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) ->
737
    (s4, Id u n new_ty new_info new_details) }}}
738
  where
739
    apply_to_details subst _ (InstId inst no_ftvs)
740
      = case (applySubstToInst subst inst) of { (s2, new_inst) ->
741
	(s2, InstId new_inst no_ftvs{-ToDo:right???-}) }
742 743 744

    apply_to_details subst new_ty (SpecId unspec ty_maybes _)
      = case (applySubstToId subst unspec)  	     of { (s2, new_unspec) ->
745
	case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
746 747 748 749 750 751 752 753 754 755
	(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) ->
756
	(s2, WorkerId new_unwrkr) }
757 758

    apply_to_details subst _ other = (subst, other)
759
-}
760 761 762 763 764 765 766 767 768
\end{code}

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

\begin{code}
769 770
idType :: GenId ty -> ty

771
idType (Id _ _ ty _ _ _) = ty
772 773 774
\end{code}

\begin{code}
775
{-LATER:
776 777 778
getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)

getMentionedTyConsAndClassesFromId id
779 780
 = getMentionedTyConsAndClassesFromType (idType id)
-}
781 782 783
\end{code}

\begin{code}
784
idPrimRep i = typePrimRep (idType i)
785 786 787 788 789 790 791 792 793
\end{code}

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

\begin{code}
794 795 796
mkSuperDictSelId u clas sc ty
  = addStandardIdInfo $
    Id u name ty details NoPragmaInfo noIdInfo
797
  where
798 799 800 801 802 803 804 805 806 807 808
    name    = mkCompoundName name_fn u (getName clas)
    details = SuperDictSelId clas sc
    name_fn clas_str = SLIT("scsel_") _APPEND_ clas_str _APPEND_ mod _APPEND_ occNameString occ
    (mod,occ) = modAndOcc sc

	-- For method selectors the clean thing to do is
	-- to give the method selector the same name as the class op itself.
mkMethodSelId op_name rec_c op ty
  = addStandardIdInfo $
    Id (uniqueOf op_name) op_name ty (MethodSelId rec_c op) NoPragmaInfo noIdInfo

809 810
mkDefaultMethodId dm_name rec_c op gen ty
  = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c op gen) NoPragmaInfo noIdInfo
811

812 813
mkDictFunId dfun_name full_ty clas ity
  = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
814
  where
815
    details  = DictFunId clas ity
816

817 818 819 820 821 822 823
mkConstMethodId	uniq clas op ity full_ty from_here locn mod info
  = Id uniq name full_ty details NoPragmaInfo info
  where
    name     = mkInstDeclName uniq mod (VarOcc occ_name) locn from_here
    details  = ConstMethodId clas ity op mod
    occ_name = classOpString op _APPEND_ 
	       SLIT("_cm_") _APPEND_ renum_type_string full_ty ity
824 825

mkWorkerId u unwrkr ty info
826
  = Id u name ty details NoPragmaInfo info
827
  where
828 829
    name    = mkCompoundName name_fn u (getName unwrkr)
    details = WorkerId unwrkr
830
    name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
831

832
mkInstId u ty name 
sof's avatar
sof committed
833
  = Id u name ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
834 835 836 837 838 839 840 841 842 843

{-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
sof's avatar
sof committed
844 845
      Nothing -> pprError "ERROR: getConstMethodId:" (vcat [
	hsep [ppr PprDebug ty, ppr PprDebug ops, ppr PprDebug op_ids,
846
	       ppr PprDebug sel_id],
sof's avatar
sof committed
847 848 849
	text "(This can arise if an interface pragma refers to an instance",
	text "but there is no imported interface which *defines* that instance.",
	text "The info above, however ugly, should indicate what else you need to import."
850
	])
851
-}
852 853 854 855 856 857 858 859


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)
    )
860 861 862 863 864 865 866 867 868
\end{code}

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

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

871 872
mkPrimitiveId n ty primop 
  = addStandardIdInfo $
sof's avatar
sof committed
873 874 875
    Id (nameUnique n) n ty (PrimitiveId primop) IMustBeINLINEd noIdInfo
	-- The pragma @IMustBeINLINEd@ says that this Id absolutely must be inlined.
	-- It's only true for primitives, because we don't want to make a closure for each of them.
876 877 878
\end{code}

\begin{code}
879

880 881 882 883
type MyTy a b = GenType (GenTyVar a) b
type MyId a b = GenId (MyTy a b)

no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
884 885 886

-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
887 888
mkSysLocal  :: FAST_STRING -> Unique -> MyTy a b -> SrcLoc -> MyId a b
mkUserLocal :: OccName     -> Unique -> MyTy a b -> SrcLoc -> MyId a b
889 890

mkSysLocal str uniq ty loc
891
  = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
892

893 894
mkUserLocal occ uniq ty loc
  = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
895

896
mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
897
mkUserId name ty pragma_info
898
  = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
899 900 901 902 903
\end{code}


\begin{code}
{-LATER:
904

905
-- for a SpecPragmaId being created by the compiler out of thin air...
906
mkSpecPragmaId :: OccName -> Unique -> Type -> Maybe Id -> SrcLoc -> Id
907
mkSpecPragmaId str uniq ty specid loc
908
  = Id uniq (mkShortName str loc) ty noIdInfo (SpecPragmaId specid (no_free_tvs ty))
909

910
-- for new SpecId
911 912
mkSpecId u unspec ty_maybes ty info
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
913
    Id u n ty info (SpecId unspec ty_maybes (no_free_tvs ty))
914 915 916 917

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

918
mkSameSpecCon ty_maybes unspec@(Id u n ty info details)
919 920
  = ASSERT(isDataCon unspec)
    ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
921
    Id u n new_ty info (SpecId unspec ty_maybes (no_free_tvs new_ty))
922 923 924 925
  where
    new_ty = specialiseTy ty ty_maybes 0

localiseId :: Id -> Id
926 927
localiseId id@(Id u n ty info details)
  = Id u (mkShortName name loc) ty info (LocalId (no_free_tvs ty))
928
  where
929
    name = getOccName id
930
    loc  = getSrcLoc id
931
-}
932

933 934 935 936
-- See notes with setNameVisibility (Name.lhs)
setIdVisibility :: Module -> Id -> Id
setIdVisibility mod (Id uniq name ty details prag info)
  = Id uniq (setNameVisibility mod name) ty details prag info
937

938
mkIdWithNewUniq :: Id -> Unique -> Id
939 940
mkIdWithNewUniq (Id _ n ty details prag info) u
  = Id u (changeUnique n u) ty details prag info
sof's avatar
sof committed
941 942 943 944

mkIdWithNewName :: Id -> Name -> Id
mkIdWithNewName (Id _ _ ty details prag info) new_name
  = Id (uniqueOf new_name) new_name ty details prag info
945 946 947 948 949 950
\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}
951
mkTemplateLocals :: [Type] -> [Id]
952
mkTemplateLocals tys
953
  = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
954 955 956 957 958
	    (getBuiltinUniques (length tys))
	    tys
\end{code}

\begin{code}
959 960
getIdInfo     :: GenId ty -> IdInfo
getPragmaInfo :: GenId ty -> PragmaInfo
961

962 963
getIdInfo     (Id _ _ _ _ _ info) = info
getPragmaInfo (Id _ _ _ _ info _) = info
964 965 966

replaceIdInfo :: Id -> IdInfo -> Id

967
replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
968

969
{-LATER:
970 971 972
selectIdInfoForSpecId :: Id -> IdInfo
selectIdInfoForSpecId unspec
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
973
    noIdInfo `addUnfoldInfo` getIdUnfolding unspec
974
-}
975 976 977 978 979 980 981 982 983 984 985 986 987
\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}
988
getIdArity :: Id -> ArityInfo
989 990
getIdArity id@(Id _ _ _ _ _ id_info)
  = --ASSERT( not (isDataCon id))
991
    arityInfo id_info
992

993
addIdArity :: Id -> ArityInfo -> Id
994
addIdArity (Id u n ty details pinfo info) arity
995
  = Id u n ty details pinfo (info `addArityInfo` arity)
996 997 998 999 1000 1001 1002 1003 1004
\end{code}

%************************************************************************
%*									*
\subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
%*									*
%************************************************************************

\begin{code}
1005
mkDataCon :: Name
1006
	  -> [StrictnessMark] -> [FieldLabel]
sof's avatar
sof committed
1007 1008 1009
	  -> [TyVar] -> ThetaType
	  -> [TyVar] -> ThetaType
	  -> [TauType] -> TyCon
1010 1011 1012
	  -> Id
  -- can get the tag and all the pieces of the type from the Type

sof's avatar
sof committed
1013
mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
1014
  = ASSERT(length stricts == length args_tys)
1015
    addStandardIdInfo data_con
1016
  where
1017 1018 1019
    -- NB: data_con self-recursion; should be OK as tags are not
    -- looked at until late in the game.
    data_con
1020
      = Id (nameUnique n)
1021
	   n
1022
	   data_con_ty
sof's avatar
sof committed
1023
	   (DataConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
1024
	   IWantToBeINLINEd	-- Always inline constructors if possible
1025
	   noIdInfo
1026

1027
    data_con_tag    = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
1028
    data_con_family = tyConDataCons tycon
1029

1030
    data_con_ty
sof's avatar
sof committed
1031
      = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
1032
	(mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
1033 1034


1035 1036 1037
mkTupleCon :: Arity -> Name -> Type -> Id
mkTupleCon arity name ty 
  = addStandardIdInfo tuple_id
1038
  where
1039 1040 1041 1042
    tuple_id = Id (nameUnique name) name ty 
	  	  (TupleConId arity) 
		  IWantToBeINLINEd		-- Always inline constructors if possible
	  	  noIdInfo
1043 1044 1045 1046 1047

fIRST_TAG :: ConTag
fIRST_TAG =  1	-- Tags allocated from here for real constructors
\end{code}

sof's avatar
sof committed
1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062
dataConNumFields gives the number of actual fields in the
{\em representation} of the data constructor.  This may be more than appear
in the source code; the extra ones are the existentially quantified
dictionaries

\begin{code}
dataConNumFields id
  = ASSERT(isDataCon id)
    case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
    length con_theta + length arg_tys }

isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
\end{code}


1063
\begin{code}
1064
dataConTag :: DataCon -> ConTag	-- will panic if not a DataCon
sof's avatar
sof committed
1065
dataConTag (Id _ _ _ (DataConId tag _ _ _ _ _ _ _ _) _ _) = tag
1066 1067
dataConTag (Id _ _ _ (TupleConId _) _ _)	      = fIRST_TAG
dataConTag (Id _ _ _ (SpecId unspec _ _) _ _)	      = dataConTag unspec
1068

1069
dataConTyCon :: DataCon -> TyCon	-- will panic if not a DataCon
sof's avatar
sof committed
1070
dataConTyCon (Id _ _ _ (DataConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
1071
dataConTyCon (Id _ _ _ (TupleConId a) _ _)	          = tupleTyCon a
1072

sof's avatar
sof committed
1073
dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
1074 1075
					-- will panic if not a DataCon

sof's avatar
sof committed
1076 1077
dataConSig (Id _ _ _ (DataConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
  = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
1078

1079
dataConSig (Id _ _ _ (TupleConId arity) _ _)
sof's avatar
sof committed
1080
  = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
1081 1082
  where
    tyvars	= take arity alphaTyVars
1083
    tyvar_tys	= mkTyVarTys tyvars
1084

1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103

-- dataConRepType returns the type of the representation of a contructor
-- This may differ from the type of the contructor Id itself for two reasons:
--	a) the constructor Id may be overloaded, but the dictionary isn't stored
--	b) the constructor may store an unboxed version of a strict field.
-- Here's an example illustrating both:
--	data Ord a => T a = MkT Int! a
-- Here
--	T :: Ord a => Int -> a -> T a
-- but the rep type is
--	Trep :: Int# -> a -> T a
-- Actually, the unboxed part isn't implemented yet!

dataConRepType :: GenId (GenType tv u) -> GenType tv u
dataConRepType con
  = mkForAllTys tyvars tau
  where
    (tyvars, theta, tau) = splitSigmaTy (idType con)

1104
dataConFieldLabels :: DataCon -> [FieldLabel]
sof's avatar
sof committed
1105
dataConFieldLabels (Id _ _ _ (DataConId _ _ fields _ _ _ _ _ _) _ _) = fields
1106
dataConFieldLabels (Id _ _ _ (TupleConId _)		    _ _) = []
1107 1108

dataConStrictMarks :: DataCon -> [StrictnessMark]
sof's avatar
sof committed
1109
dataConStrictMarks (Id _ _ _ (DataConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
1110 1111
dataConStrictMarks (Id _ _ _ (TupleConId arity)		     _ _) 
  = nOfThem arity NotMarkedStrict
1112

1113
dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
sof's avatar
sof committed
1114
dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
1115

1116 1117 1118 1119 1120 1121
dataConArgTys :: DataCon 
	      -> [Type] 	-- Instantiated at these types
	      -> [Type]		-- Needs arguments of these types
dataConArgTys con_id inst_tys
 = map (instantiateTy tenv) arg_tys
 where
sof's avatar
sof committed
1122 1123
    (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
    tenv 		          = zipEqual "dataConArgTys" tyvars inst_tys
1124 1125 1126
\end{code}

\begin{code}
1127
mkRecordSelId field_label selector_ty
1128 1129
  = addStandardIdInfo $		-- Record selectors have a standard unfolding
    Id (nameUnique name)
1130
       name
1131
       selector_ty
1132
       (RecordSelId field_label)
1133 1134 1135 1136 1137 1138
       NoPragmaInfo
       noIdInfo
  where
    name = fieldLabelName field_label

recordSelectorFieldLabel :: Id -> FieldLabel
1139
recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1140 1141 1142

isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
isRecordSelector other				  = False