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

	-- DESTRUCTION (excluding pragmatic info)
	idPrimRep,
38
	idType,
39
	idUnique,
sof's avatar
sof committed
40
	idName,
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
	idWantsToBeINLINEd, getInlinePragma, 
sof's avatar
sof committed
62
	idMustBeINLINEd, idMustNotBeINLINEd,
63
	isBottomingId,
sof's avatar
sof committed
64
	isDataCon, isAlgCon, isNewCon,
65 66 67 68
	isDefaultMethodId,
	isDefaultMethodId_maybe,
	isDictFunId,
	isImportedId,
69 70
	isRecordSelector,
	isMethodSelId_maybe,
71 72 73
	isNullaryDataCon,
	isSpecPragmaId,
	isSuperDictSelId_maybe,
74
	isPrimitiveId_maybe,
75 76
	isSysLocalId,
	isTupleCon,
77
	isWrapperId,
78 79
	toplevelishId,
	unfoldingUnfriendlyId,
80 81

	-- SUBSTITUTION
82 83 84 85 86
	applyTypeEnvToId,
	apply_to_Id,
	
	-- PRINTING and RENUMBERING
	pprId,
sof's avatar
sof committed
87
--	pprIdInUnfolding,
88
	showId,
89

90 91 92 93
	-- Specialialisation
	getIdSpecialisation,
	addIdSpecialisation,

94
	-- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
95
	addIdUnfolding,
96 97 98 99 100 101 102 103 104 105 106
	addIdArity,
	addIdDemandInfo,
	addIdStrictness,
	addIdUpdateInfo,
	getIdArity,
	getIdDemandInfo,
	getIdInfo,
	getIdStrictness,
	getIdUnfolding,
	getIdUpdateInfo,
	getPragmaInfo,
sof's avatar
sof committed
107
	replaceIdInfo, replacePragmaInfo,
sof's avatar
sof committed
108
	addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
109

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

141
IMP_Ubiq()
sof's avatar
sof committed
142

sof's avatar
sof committed
143
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
144 145
IMPORT_DELOOPER(IdLoop)   -- for paranoia checking
IMPORT_DELOOPER(TyLoop)   -- for paranoia checking
sof's avatar
sof committed
146 147 148 149 150 151 152
#else
import {-# SOURCE #-} SpecEnv    ( SpecEnv   )
import {-# SOURCE #-} CoreUnfold ( Unfolding )
import {-# SOURCE #-} StdIdInfo  ( addStandardIdInfo )
-- Let's see how much we can leave out..
--import {-# SOURCE #-} TysPrim
#endif
sof's avatar
sof committed
153

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

data StrictnessMark = MarkedStrict | NotMarkedStrict
228 229 230 231 232

data IdDetails

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

233 234
  = LocalId	Bool		-- Local name; mentioned by the user
				-- True <=> no free type vars
235

236 237
  | SysLocalId	Bool	        -- Local name; made up by the compiler
				-- as for LocalId
238

239 240
  | PrimitiveId PrimOp		-- The Id for a primitive operation

241
  | SpecPragmaId 		-- Local name; introduced by the compiler
242 243
		 (Maybe Id)	-- for explicit specid in pragma
		 Bool		-- as for LocalId
244 245 246

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

247
  | ImportedId			-- Global name (Imported or Implicit); Id imported from an interface
248 249 250

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

sof's avatar
sof committed
251 252 253
  | AlgConId			-- Used for both data and newtype constructors.
				-- You can tell the difference by looking at the TyCon
		ConTag
254
		[StrictnessMark] -- Strict args; length = arity
sof's avatar
sof committed
255 256
		[FieldLabel]	-- Field labels for this constructor; 
				--length = 0 (not a record) or arity
257

sof's avatar
sof committed
258 259 260 261
		[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
262
				-- the type is:
sof's avatar
sof committed
263
				-- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
264
				--    unitype_1 -> ... -> unitype_n -> tycon tyvars
265

266
  | TupleConId	Int		-- Its arity
267

268
  | RecordSelId FieldLabel
269

270 271 272 273 274 275
  ---------------- Things to do with overloading

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

276
  | MethodSelId	Class		-- An overloaded class operation, with
277 278
				-- a fully polymorphic type.  Its code
				-- just selects a method from the
sof's avatar
sof committed
279
				-- dictionary.
280

281
	-- NB: The IdInfo for a MethodSelId has all the info about its
282 283 284 285
	-- related "constant method Ids", which are just
	-- specialisations of this general one.

  | DefaultMethodId		-- Default method for a particular class op
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309
		Class		-- same class, <blah-blah> info as MethodSelId

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

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

type ConTag	= Int
type DictVar	= Id
type DictFun	= Id
type DataCon	= Id
310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332
\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}
333
	dfun.Foo.[Int] = ...
334 335 336 337 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
\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.

369

370 371 372 373 374 375 376 377 378
%************************************************************************
%*									*
\subsection[Id-documentation]{Documentation}
%*									*
%************************************************************************

[A BIT DATED [WDP]]

The @Id@ datatype describes {\em values}.  The basic things we want to
379
know: (1)~a value's {\em type} (@idType@ is a very common
380 381 382 383 384 385
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}
%----------------------------------------------------------------------
sof's avatar
sof committed
386
\item[@AlgConId@:] For the data constructors declared by a @data@
387
declaration.  Their type is kept in {\em two} forms---as a regular
388
@Type@ (in the usual place), and also in its constituent pieces (in
389 390 391 392 393 394 395 396 397 398 399 400
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@).

%----------------------------------------------------------------------
401
\item[@MethodSelId@:] A selector from a dictionary; it may select either
402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 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
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[@SpecId@:]

%----------------------------------------------------------------------
\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

444
@DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
445
@MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
446 447 448 449 450 451 452 453 454 455
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}
456
Note that @Locals@ and @SysLocals@ {\em may} have the above
457 458 459 460 461 462 463 464 465 466
properties, but they may not.
\end{enumerate}

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

\begin{code}
sof's avatar
sof committed
467 468 469 470 471 472 473 474 475 476 477 478 479 480
-- isDataCon returns False for @newtype@ constructors
isDataCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isDataTyCon tc
isDataCon (Id _ _ _ (TupleConId _) _ _)		        = True
isDataCon (Id _ _ _ (SpecId unspec _ _) _ _)	        = isDataCon unspec
isDataCon other					        = False

isNewCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isNewTyCon tc
isNewCon other					       = False

-- isAlgCon returns True for @data@ or @newtype@ constructors
isAlgCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ _) _ _) = True
isAlgCon (Id _ _ _ (TupleConId _) _ _)		      = True
isAlgCon (Id _ _ _ (SpecId unspec _ _) _ _)	      = isAlgCon unspec
isAlgCon other					      = False
481

482 483 484
isTupleCon (Id _ _ _ (TupleConId _) _ _)	 = True
isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _)	 = isTupleCon unspec
isTupleCon other				 = False
485 486
\end{code}

487 488 489 490
@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}
491 492 493
about something if it returns @True@!

\begin{code}
494 495
toplevelishId	  :: Id -> Bool
idHasNoFreeTyVars :: Id -> Bool
496

497
toplevelishId (Id _ _ _ details _ _)
498 499
  = chk details
  where
sof's avatar
sof committed
500
    chk (AlgConId _ __ _ _ _ _ _ _)   = True
501
    chk (TupleConId _)    	    = True
502
    chk (RecordSelId _)   	    = True
503
    chk ImportedId	    	    = True
504
    chk (SuperDictSelId _ _)	    = True
sof's avatar
sof committed
505 506
    chk (MethodSelId _)		    = True
    chk (DefaultMethodId _)         = True
507
    chk (DictFunId     _ _)	    = True
508 509
    chk (SpecId unspec _ _)	    = toplevelishId unspec
				    -- depends what the unspecialised thing is
510 511 512
    chk (LocalId      _)	    = False
    chk (SysLocalId   _)	    = False
    chk (SpecPragmaId _ _)	    = False
513
    chk (PrimitiveId _)		    = True
514

515
idHasNoFreeTyVars (Id _ _ _ details _ info)
516 517
  = chk details
  where
sof's avatar
sof committed
518
    chk (AlgConId _ _ _ _ _ _ _ _ _) = True
519
    chk (TupleConId _)    	  = True
520
    chk (RecordSelId _)   	  = True
521
    chk ImportedId	    	  = True
522
    chk (SuperDictSelId _ _)	  = True
sof's avatar
sof committed
523 524
    chk (MethodSelId _)		  = True
    chk (DefaultMethodId _)       = True
525
    chk (DictFunId     _ _)	  = True
526
    chk (SpecId _     _   no_free_tvs) = no_free_tvs
527 528 529
    chk (LocalId        no_free_tvs) = no_free_tvs
    chk (SysLocalId     no_free_tvs) = no_free_tvs
    chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
530 531
    chk (PrimitiveId _)		    = True

532 533 534 535 536 537
-- 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
538 539
	-> Bool

540 541 542 543 544 545 546 547
omitIfaceSigForId (Id _ name _ details _ _)
  | isWiredInName name
  = True

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

	-- This group is Ids that are implied by their type or class decl;
550 551 552
	-- 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
553
        (AlgConId _ _ _ _ _ _ _ _ _) -> True
554 555 556
        (TupleConId _)    	  -> True
        (RecordSelId _)   	  -> True
        (SuperDictSelId _ _)	  -> True
sof's avatar
sof committed
557
        (MethodSelId _)		  -> True
558 559 560

	other			  -> False	-- Don't omit!
		-- NB DefaultMethodIds are not omitted
561 562 563
\end{code}

\begin{code}
564 565
isImportedId (Id _ _ _ ImportedId _ _) = True
isImportedId other		       = False
566

567
isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
568

569
isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
570 571
isSysLocalId other			   = False

572
isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
573 574
isSpecPragmaId other			         = False

sof's avatar
sof committed
575 576 577 578 579 580 581 582
isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
    Just (unspec, ty_maybes)
isSpecId_maybe other_id
  = Nothing

isMethodSelId_maybe (Id _ _ _ (MethodSelId cls) _ _) = Just cls
isMethodSelId_maybe _				     = Nothing
583

sof's avatar
sof committed
584 585
isDefaultMethodId (Id _ _ _ (DefaultMethodId _) _ _) = True
isDefaultMethodId other				     = False
586

sof's avatar
sof committed
587 588
isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls) _ _)
  = Just cls
589 590
isDefaultMethodId_maybe other = Nothing

591 592
isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
isDictFunId other		    	   = False
593

594
isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
595 596
isSuperDictSelId_maybe other_id				  = Nothing

597 598
isWrapperId id = workerExists (getIdStrictness id)

599 600
isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
isPrimitiveId_maybe other				= Nothing
601 602 603 604 605 606 607 608
\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.

609
unfoldingUnfriendlyId id = not (externallyVisibleId id)
610 611 612
\end{code}

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

616 617
In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
local-ness precisely so that the test here would be easy
618 619 620

\begin{code}
externallyVisibleId :: Id -> Bool
621 622
externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
		     -- not local => global => externally visible
623 624 625 626 627 628 629
\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?)

\begin{code}
630 631
type TypeEnv = TyVarEnv Type

632
applyTypeEnvToId :: TypeEnv -> Id -> Id
633
applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
634 635 636 637 638 639
  = apply_to_Id ( \ ty ->
	applyTypeEnvToTy type_env ty
    ) id
\end{code}

\begin{code}
640
apply_to_Id :: (Type -> Type) -> Id -> Id
641

sof's avatar
sof committed
642 643 644 645 646
apply_to_Id ty_fn id@(Id u n ty details prag info)
  | idHasNoFreeTyVars id
  = id
  | otherwise
  = Id u n (ty_fn ty) (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
647 648 649 650 651 652
  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
653
	SpecId new_unspec new_maybes (no_free_tvs ty)
654
	-- ToDo: gratuitous recalc no_ftvs????
655 656 657 658 659 660 661 662 663 664 665 666 667 668 669
      where
	apply_to_maybe Nothing   = Nothing
	apply_to_maybe (Just ty) = Just (ty_fn ty)

    apply_to_details other = other
\end{code}


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

\begin{code}
sof's avatar
sof committed
670 671
idName :: GenId ty -> Name
idName (Id _ n _ _ _ _) = n
672

sof's avatar
sof committed
673
idType :: GenId ty -> ty
674
idType (Id _ _ ty _ _ _) = ty
675

676
idPrimRep i = typePrimRep (idType i)
677 678 679 680 681 682 683 684 685
\end{code}

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

\begin{code}
686 687 688
mkSuperDictSelId u clas sc ty
  = addStandardIdInfo $
    Id u name ty details NoPragmaInfo noIdInfo
689
  where
690 691 692 693 694 695 696
    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.
sof's avatar
sof committed
697
mkMethodSelId op_name rec_c ty
698
  = addStandardIdInfo $
sof's avatar
sof committed
699
    Id (uniqueOf op_name) op_name ty (MethodSelId rec_c) NoPragmaInfo noIdInfo
700

sof's avatar
sof committed
701 702
mkDefaultMethodId dm_name rec_c ty
  = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c) NoPragmaInfo noIdInfo
703

704 705
mkDictFunId dfun_name full_ty clas ity
  = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
706
  where
707
    details  = DictFunId clas ity
708

709
mkWorkerId u unwrkr ty info
710
  = Id u name ty details NoPragmaInfo info
711
  where
sof's avatar
sof committed
712
    details = LocalId (no_free_tvs ty)
713
    name    = mkCompoundName name_fn u (getName unwrkr)
714
    name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
715 716 717 718 719 720 721 722 723
\end{code}

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

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

726 727
mkPrimitiveId n ty primop 
  = addStandardIdInfo $
sof's avatar
sof committed
728 729 730
    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.
sof's avatar
sof committed
731

732 733 734
\end{code}

\begin{code}
735

736 737 738 739
type MyTy a b = GenType (GenTyVar a) b
type MyId a b = GenId (MyTy a b)

no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
740 741 742

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

mkSysLocal str uniq ty loc
747
  = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
748

749 750
mkUserLocal occ uniq ty loc
  = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
751

752
mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
753
mkUserId name ty pragma_info
754
  = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
755 756 757
\end{code}

\begin{code}
sof's avatar
sof committed
758 759 760 761
-- See notes with setNameVisibility (Name.lhs)
setIdVisibility :: Maybe Module -> Unique -> Id -> Id
setIdVisibility maybe_mod u (Id uniq name ty details prag info)
  = Id uniq (setNameVisibility maybe_mod u name) ty details prag info
762

sof's avatar
sof committed
763 764 765
mkIdWithNewUniq :: Id -> Unique -> Id
mkIdWithNewUniq (Id _ n ty details prag info) u
  = Id u (changeUnique n u) ty details prag info
766

sof's avatar
sof committed
767 768 769 770 771 772 773
mkIdWithNewName :: Id -> Name -> Id
mkIdWithNewName (Id _ _ ty details prag info) new_name
  = Id (uniqueOf new_name) new_name ty details prag info

mkIdWithNewType :: Id -> Type -> Id
mkIdWithNewType (Id u name _ details pragma info) ty 
  = Id u name ty details pragma info
774 775 776 777

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

sof's avatar
sof committed
778
mkSameSpecCon ty_maybes unspec@(Id u name ty details pragma info)
779 780
  = ASSERT(isDataCon unspec)
    ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
sof's avatar
sof committed
781
    Id u name new_ty (SpecId unspec ty_maybes (no_free_tvs new_ty)) pragma info
782 783 784
  where
    new_ty = specialiseTy ty ty_maybes 0

sof's avatar
sof committed
785 786
    -- pprTrace "SameSpecCon:Unique:"
    --	        (ppSep (ppr PprDebug unspec: [pprMaybeTy PprDebug ty | ty <- ty_maybes]))
787 788 789 790 791 792
\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}
793
mkTemplateLocals :: [Type] -> [Id]
794
mkTemplateLocals tys
795
  = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
796 797 798 799 800
	    (getBuiltinUniques (length tys))
	    tys
\end{code}

\begin{code}
801 802
getIdInfo     :: GenId ty -> IdInfo
getPragmaInfo :: GenId ty -> PragmaInfo
803

804 805
getIdInfo     (Id _ _ _ _ _ info) = info
getPragmaInfo (Id _ _ _ _ info _) = info
806 807

replaceIdInfo :: Id -> IdInfo -> Id
808
replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
809

sof's avatar
sof committed
810
replacePragmaInfo :: GenId ty -> PragmaInfo -> GenId ty
sof's avatar
sof committed
811
replacePragmaInfo (Id u sn ty details _ info) prag = Id u sn ty details prag info
812 813 814 815 816 817 818 819 820 821 822 823 824
\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}
825
getIdArity :: Id -> ArityInfo
826
getIdArity id@(Id _ _ _ _ _ id_info)
sof's avatar
sof committed
827
  = arityInfo id_info
828

829
addIdArity :: Id -> ArityInfo -> Id
830
addIdArity (Id u n ty details pinfo info) arity
831
  = Id u n ty details pinfo (info `addArityInfo` arity)
832
\end{code}
sof's avatar
sof committed
833

834 835 836 837 838 839 840
%************************************************************************
%*									*
\subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
%*									*
%************************************************************************

\begin{code}
841
mkDataCon :: Name
842
	  -> [StrictnessMark] -> [FieldLabel]
sof's avatar
sof committed
843 844 845
	  -> [TyVar] -> ThetaType
	  -> [TyVar] -> ThetaType
	  -> [TauType] -> TyCon
846 847 848
	  -> Id
  -- can get the tag and all the pieces of the type from the Type

sof's avatar
sof committed
849
mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
850
  = ASSERT(length stricts == length args_tys)
851
    addStandardIdInfo data_con
852
  where
853 854 855
    -- NB: data_con self-recursion; should be OK as tags are not
    -- looked at until late in the game.
    data_con
856
      = Id (nameUnique n)
857
	   n
858
	   data_con_ty
sof's avatar
sof committed
859
	   (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
860
	   IWantToBeINLINEd	-- Always inline constructors if possible
861
	   noIdInfo
862

863
    data_con_tag    = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
864
    data_con_family = tyConDataCons tycon
865

866
    data_con_ty
sof's avatar
sof committed
867
      = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
868
	(mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
869 870


871 872 873
mkTupleCon :: Arity -> Name -> Type -> Id
mkTupleCon arity name ty 
  = addStandardIdInfo tuple_id
874
  where
875 876 877 878
    tuple_id = Id (nameUnique name) name ty 
	  	  (TupleConId arity) 
		  IWantToBeINLINEd		-- Always inline constructors if possible
	  	  noIdInfo
879 880 881 882 883

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

sof's avatar
sof committed
884 885 886 887 888 889 890 891 892 893 894 895
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
sof's avatar
sof committed
896

sof's avatar
sof committed
897 898 899
\end{code}


900
\begin{code}
901
dataConTag :: DataCon -> ConTag	-- will panic if not a DataCon
sof's avatar
sof committed
902
dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
903 904
dataConTag (Id _ _ _ (TupleConId _) _ _)	      = fIRST_TAG
dataConTag (Id _ _ _ (SpecId unspec _ _) _ _)	      = dataConTag unspec
905

906
dataConTyCon :: DataCon -> TyCon	-- will panic if not a DataCon
sof's avatar
sof committed
907
dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
908
dataConTyCon (Id _ _ _ (TupleConId a) _ _)	          = tupleTyCon a
909

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

sof's avatar
sof committed
913
dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
sof's avatar
sof committed
914
  = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
915

916
dataConSig (Id _ _ _ (TupleConId arity) _ _)
sof's avatar
sof committed
917
  = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
918 919
  where
    tyvars	= take arity alphaTyVars
920
    tyvar_tys	= mkTyVarTys tyvars
sof's avatar
sof committed
921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943
dataConSig (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
  = (spec_tyvars, spec_theta_ty, spec_con_tyvars, spec_con_theta, spec_arg_tys, spec_tycon)
  where
    (tyvars, theta_ty, con_tyvars, con_theta, arg_tys, tycon) = dataConSig unspec

    ty_env = tyvars `zip` ty_maybes

    spec_tyvars     = foldr nothing_tyvars [] ty_env
    spec_con_tyvars = foldr nothing_tyvars [] (con_tyvars `zip` ty_maybes) -- Hmm..

    nothing_tyvars (tyvar, Nothing) l = tyvar : l
    nothing_tyvars (tyvar, Just ty) l = l

    spec_env = foldr just_env [] ty_env
    just_env (tyvar, Nothing) l = l
    just_env (tyvar, Just ty) l = (tyvar, ty) : l
    spec_arg_tys = map (instantiateTauTy spec_env) arg_tys

    spec_theta_ty  = if null theta_ty then []
		     else panic "dataConSig:ThetaTy:SpecDataCon1"
    spec_con_theta = if null con_theta then []
		     else panic "dataConSig:ThetaTy:SpecDataCon2"
    spec_tycon     = mkSpecTyCon tycon ty_maybes
944

945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963

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

964
dataConFieldLabels :: DataCon -> [FieldLabel]
sof's avatar
sof committed
965
dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
966
dataConFieldLabels (Id _ _ _ (TupleConId _)		    _ _) = []
sof's avatar
sof committed
967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982
#ifdef DEBUG
dataConFieldLabels x@(Id _ _ _ idt _ _) = 
  panic ("dataConFieldLabel: " ++
    (case idt of
      LocalId _    -> "l"
      SysLocalId _ -> "sl"
      PrimitiveId _ -> "p"
      SpecPragmaId _  _ -> "sp"
      ImportedId -> "i"
      RecordSelId _ -> "r"
      SuperDictSelId _ _ -> "sc"
      MethodSelId _ -> "m"
      DefaultMethodId _ -> "d"
      DictFunId _ _ -> "di"
      SpecId _ _ _ -> "spec"))
#endif
983 984

dataConStrictMarks :: DataCon -> [StrictnessMark]
sof's avatar
sof committed
985
dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
986 987
dataConStrictMarks (Id _ _ _ (TupleConId arity)		     _ _) 
  = nOfThem arity NotMarkedStrict
988

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

992 993 994 995 996 997
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
998 999
    (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
    tenv 		          = zipEqual "dataConArgTys" tyvars inst_tys
1000 1001 1002
\end{code}

\begin{code}
1003
mkRecordSelId field_label selector_ty
1004 1005
  = addStandardIdInfo $		-- Record selectors have a standard unfolding
    Id (nameUnique name)
1006
       name
1007
       selector_ty
1008
       (RecordSelId field_label)
1009 1010 1011 1012 1013 1014
       NoPragmaInfo
       noIdInfo
  where
    name = fieldLabelName field_label

recordSelectorFieldLabel :: Id -> FieldLabel
1015
recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1016 1017 1018

isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
isRecordSelector other				  = False
1019 1020
\end{code}

1021 1022 1023 1024 1025 1026 1027 1028

Data type declarations are of the form:
\begin{verbatim}
data Foo a b = C1 ... | C2 ... | ... | Cn ...
\end{verbatim}
For each constructor @Ci@, we want to generate a curried function; so, e.g., for
@C1 x y z@, we want a function binding:
\begin{verbatim}
1029
fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1030
\end{verbatim}
1031
Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1032 1033 1034 1035 1036 1037 1038 1039
2nd-order polymorphic lambda calculus with explicit types.

%************************************************************************
%*									*
\subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
%*									*
%************************************************************************

1040 1041
\begin{code}
getIdUnfolding :: Id -> Unfolding
1042

1043
getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1044

1045 1046 1047 1048 1049 1050 1051
addIdUnfolding :: Id -> Unfolding -> Id
addIdUnfolding id@(Id u n ty details prag info) unfolding
  = Id u n ty details prag (info `addUnfoldInfo` unfolding)
\end{code}

The inline pragma tells us to be very keen to inline this Id, but it's still
OK not to if optimisation is switched off.
1052 1053

\begin{code}
sof's avatar
sof committed
1054 1055 1056
getInlinePragma :: Id -> PragmaInfo
getInlinePragma (Id _ _ _ _ prag _) = prag

1057
idWantsToBeINLINEd :: Id -> Bool
1058

1059
idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
sof's avatar
sof committed
1060
idWantsToBeINLINEd (Id _ _ _ _ IMustBeINLINEd   _) = True
1061
idWantsToBeINLINEd _				   = False
1062

sof's avatar
sof committed
1063 1064 1065 1066 1067 1068
idMustNotBeINLINEd (Id _ _ _ _ IMustNotBeINLINEd _) = True
idMustNotBeINLINEd _				    = False

idMustBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
idMustBeINLINEd _			      = False

1069 1070 1071
addInlinePragma :: Id -> Id
addInlinePragma (Id u sn ty details _ info)
  = Id u sn ty details IWantToBeINLINEd info
1072

sof's avatar
sof committed
1073 1074 1075 1076
nukeNoInlinePragma :: Id -> Id
nukeNoInlinePragma id@(Id u sn ty details IMustNotBeINLINEd info)
  = Id u sn ty details NoPragmaInfo info
nukeNoInlinePragma id@(Id u sn ty details _ info) = id		-- Otherwise no-op
1077

sof's avatar
sof committed
1078 1079 1080
addNoInlinePragma :: Id -> Id
addNoInlinePragma id@(Id u sn ty details _ info)
  = Id u sn ty details IMustNotBeINLINEd info
1081 1082
\end{code}

1083

sof's avatar
sof committed
1084

1085 1086 1087 1088 1089 1090 1091 1092
%************************************************************************
%*									*
\subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
%*									*
%************************************************************************

\begin{code}
getIdDemandInfo :: Id -> DemandInfo
1093
getIdDemandInfo (Id _ _ _ _ _ info) = demandInfo info
1094 1095

addIdDemandInfo :: Id -> DemandInfo -> Id
1096
addIdDemandInfo (Id u n ty details prags info) demand_info
1097
  = Id u n ty details prags (info `addDemandInfo` demand_info)
1098 1099 1100 1101
\end{code}

\begin{code}
getIdUpdateInfo :: Id -> UpdateInfo
1102
getIdUpdateInfo (Id _ _ _ _ _ info) = updateInfo info
1103 1104

addIdUpdateInfo :: Id -> UpdateInfo -> Id
1105
addIdUpdateInfo (Id u n ty details prags info) upd_info
1106
  = Id u n ty details prags (info `addUpdateInfo` upd_info)
1107 1108 1109
\end{code}

\begin{code}
1110
{- LATER:
1111
getIdArgUsageInfo :: Id -> ArgUsageInfo
1112
getIdArgUsageInfo (Id u n ty info details) = argUsageInfo info
1113 1114

addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1115
addIdArgUsageInfo (Id u n ty info details) au_info
1116
  = Id u n ty (info `addArgusageInfo` au_info) details
1117
-}
1118 1119 1120
\end{code}

\begin{code}
1121
{- LATER:
1122
getIdFBTypeInfo :: Id -> FBTypeInfo
1123
getIdFBTypeInfo (Id u n ty info details) = fbTypeInfo info
1124 1125