Id.lhs 48.7 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
	idWantsToBeINLINEd, getInlinePragma, 
sof's avatar
sof committed
62
	idMustBeINLINEd, idMustNotBeINLINEd,
63 64 65
	isBottomingId,
	isConstMethodId,
	isConstMethodId_maybe,
sof's avatar
sof committed
66
	isDataCon, isAlgCon, isNewCon,
67 68 69 70
	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
	addIdArity,
	addIdDemandInfo,
	addIdStrictness,
	addIdUpdateInfo,
sof's avatar
sof committed
105
	addIdDeforestInfo,
106 107 108 109 110 111 112
	getIdArity,
	getIdDemandInfo,
	getIdInfo,
	getIdStrictness,
	getIdUnfolding,
	getIdUpdateInfo,
	getPragmaInfo,
sof's avatar
sof committed
113
	replaceIdInfo, replacePragmaInfo,
sof's avatar
sof committed
114
	addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
115

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

147
IMP_Ubiq()
sof's avatar
sof committed
148

sof's avatar
sof committed
149
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
150 151
IMPORT_DELOOPER(IdLoop)   -- for paranoia checking
IMPORT_DELOOPER(TyLoop)   -- for paranoia checking
sof's avatar
sof committed
152 153 154 155 156 157 158 159 160 161 162 163
#else
import {-# SOURCE #-} SpecEnv    ( SpecEnv   )
import {-# SOURCE #-} CoreUnfold ( Unfolding )
import {-# SOURCE #-} StdIdInfo  ( addStandardIdInfo )
-- Let's see how much we can leave out..
--import {-# SOURCE #-} TyCon
--import {-# SOURCE #-} Type
--import {-# SOURCE #-} Class
--import {-# SOURCE #-} TysWiredIn
--import {-# SOURCE #-} TysPrim
--import {-# SOURCE #-} TyVar
#endif
sof's avatar
sof committed
164

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

data StrictnessMark = MarkedStrict | NotMarkedStrict
238 239 240 241 242

data IdDetails

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

243 244
  = LocalId	Bool		-- Local name; mentioned by the user
				-- True <=> no free type vars
245

246 247
  | SysLocalId	Bool	        -- Local name; made up by the compiler
				-- as for LocalId
248

249 250
  | PrimitiveId PrimOp		-- The Id for a primitive operation

251
  | SpecPragmaId 		-- Local name; introduced by the compiler
252 253
		 (Maybe Id)	-- for explicit specid in pragma
		 Bool		-- as for LocalId
254 255 256

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

257
  | ImportedId			-- Global name (Imported or Implicit); Id imported from an interface
258 259 260

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

sof's avatar
sof committed
261 262 263
  | AlgConId			-- Used for both data and newtype constructors.
				-- You can tell the difference by looking at the TyCon
		ConTag
264
		[StrictnessMark] -- Strict args; length = arity
sof's avatar
sof committed
265 266
		[FieldLabel]	-- Field labels for this constructor; 
				--length = 0 (not a record) or arity
267

sof's avatar
sof committed
268 269 270 271
		[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
272
				-- the type is:
sof's avatar
sof committed
273
				-- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
274
				--    unitype_1 -> ... -> unitype_n -> tycon tyvars
275

276
  | TupleConId	Int		-- Its arity
277

278
  | RecordSelId FieldLabel
279

280 281 282 283 284 285
  ---------------- Things to do with overloading

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

286
  | MethodSelId	Class		-- An overloaded class operation, with
287 288 289 290 291
				-- a fully polymorphic type.  Its code
				-- just selects a method from the
				-- dictionary.  The class.
		ClassOp		-- The operation

292
	-- NB: The IdInfo for a MethodSelId has all the info about its
293 294 295 296
	-- related "constant method Ids", which are just
	-- specialisations of this general one.

  | DefaultMethodId		-- Default method for a particular class op
297
		Class		-- same class, <blah-blah> info as MethodSelId
298 299 300 301
		ClassOp		-- (surprise, surprise)
		Bool		-- True <=> I *know* this default method Id
				-- is a generated one that just says
				-- `error "No default method for <op>"'.
302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317

				-- 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
318
		Module		-- module where instance came from
319

320
  | InstId			-- An instance of a dictionary, class operation,
321
				-- or overloaded value (Local name)
322
		Bool		-- as for LocalId
323 324 325 326 327 328 329 330 331 332

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

333 334
-- Scheduled for deletion: SLPJ Nov 96
-- Nobody seems to depend on knowing this.
335 336 337 338 339 340 341
  | 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
342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364
\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}
365
	dfun.Foo.[Int] = ...
366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400
\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.

401

402 403 404 405 406 407 408 409 410
%************************************************************************
%*									*
\subsection[Id-documentation]{Documentation}
%*									*
%************************************************************************

[A BIT DATED [WDP]]

The @Id@ datatype describes {\em values}.  The basic things we want to
411
know: (1)~a value's {\em type} (@idType@ is a very common
412 413 414 415 416 417
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
418
\item[@AlgConId@:] For the data constructors declared by a @data@
419
declaration.  Their type is kept in {\em two} forms---as a regular
420
@Type@ (in the usual place), and also in its constituent pieces (in
421 422 423 424 425 426 427 428 429 430 431 432
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@).

%----------------------------------------------------------------------
433
\item[@MethodSelId@:] A selector from a dictionary; it may select either
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 473 474 475 476 477 478 479 480 481
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

482
@DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
483
@MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504
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
505 506 507 508 509 510 511 512 513 514 515 516 517 518
-- 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
519

520 521 522
isTupleCon (Id _ _ _ (TupleConId _) _ _)	 = True
isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _)	 = isTupleCon unspec
isTupleCon other				 = False
523 524
\end{code}

525 526 527 528
@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}
529 530 531
about something if it returns @True@!

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

535
toplevelishId (Id _ _ _ details _ _)
536 537
  = chk details
  where
sof's avatar
sof committed
538
    chk (AlgConId _ __ _ _ _ _ _ _)   = True
539
    chk (TupleConId _)    	    = True
540
    chk (RecordSelId _)   	    = True
541
    chk ImportedId	    	    = True
542 543 544
    chk (SuperDictSelId _ _)	    = True
    chk (MethodSelId _ _)	    = True
    chk (DefaultMethodId _ _ _)     = True
545
    chk (DictFunId     _ _)	    = True
546
    chk (ConstMethodId _ _ _ _)     = True
547 548 549
    chk (SpecId unspec _ _)	    = toplevelishId unspec
				    -- depends what the unspecialised thing is
    chk (WorkerId unwrkr)	    = toplevelishId unwrkr
550 551 552 553
    chk (InstId	      _)	    = False	-- these are local
    chk (LocalId      _)	    = False
    chk (SysLocalId   _)	    = False
    chk (SpecPragmaId _ _)	    = False
554
    chk (PrimitiveId _)		    = True
555

556
idHasNoFreeTyVars (Id _ _ _ details _ info)
557 558
  = chk details
  where
sof's avatar
sof committed
559
    chk (AlgConId _ _ _ _ _ _ _ _ _) = True
560
    chk (TupleConId _)    	  = True
561
    chk (RecordSelId _)   	  = True
562
    chk ImportedId	    	  = True
563
    chk (SuperDictSelId _ _)	  = True
564
    chk (MethodSelId _ _)	  = True
565
    chk (DefaultMethodId _ _ _)   = True
566
    chk (DictFunId     _ _)	  = True
567
    chk (ConstMethodId _ _ _ _)   = True
568
    chk (WorkerId unwrkr)	  = idHasNoFreeTyVars unwrkr
569
    chk (SpecId _     _   no_free_tvs) = no_free_tvs
570 571 572 573
    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
574 575
    chk (PrimitiveId _)		    = True

576 577 578 579 580 581
-- 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
582 583
	-> Bool

584 585 586 587 588 589 590 591
omitIfaceSigForId (Id _ name _ details _ _)
  | isWiredInName name
  = True

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

	-- This group is Ids that are implied by their type or class decl;
594 595 596
	-- 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
597
        (AlgConId _ _ _ _ _ _ _ _ _) -> True
598 599 600 601 602 603 604
        (TupleConId _)    	  -> True
        (RecordSelId _)   	  -> True
        (SuperDictSelId _ _)	  -> True
        (MethodSelId _ _)	  -> True

	other			  -> False	-- Don't omit!
		-- NB DefaultMethodIds are not omitted
605 606 607
\end{code}

\begin{code}
608 609
isImportedId (Id _ _ _ ImportedId _ _) = True
isImportedId other		       = False
610

611
isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
612

613
isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
614 615
isSysLocalId other			   = False

616
isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
617 618
isSpecPragmaId other			         = False

619 620
isMethodSelId_maybe (Id _ _ _ (MethodSelId cls op) _ _) = Just (cls,op)
isMethodSelId_maybe _				        = Nothing
621

622 623
isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
isDefaultMethodId other				         = False
624

625
isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls clsop err) _ _)
626 627 628
  = Just (cls, clsop, err)
isDefaultMethodId_maybe other = Nothing

629 630
isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
isDictFunId other		    	   = False
631

632
isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _) _ _) = True
633 634
isConstMethodId other		    		       = False

635
isConstMethodId_maybe (Id _ _ _ (ConstMethodId cls ty clsop _) _ _)
636 637 638
  = Just (cls, ty, clsop)
isConstMethodId_maybe other = Nothing

639
isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
640 641
isSuperDictSelId_maybe other_id				  = Nothing

642
isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
643 644
isWorkerId other		     = False

645 646
isWrapperId id = workerExists (getIdStrictness id)

647 648
isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
isPrimitiveId_maybe other				= Nothing
649 650 651 652
\end{code}

Tell them who my wrapper function is.
\begin{code}
653
{-LATER:
654 655
myWrapperMaybe :: Id -> Maybe Id

656
myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper) _ _) = Just my_wrapper
657 658
myWrapperMaybe other_id			    	  = Nothing
-}
659 660 661 662 663 664 665 666
\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.

667
unfoldingUnfriendlyId id = not (externallyVisibleId id)
668 669 670
\end{code}

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

674 675
In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
local-ness precisely so that the test here would be easy
676 677 678

\begin{code}
externallyVisibleId :: Id -> Bool
679 680
externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
		     -- not local => global => externally visible
681 682 683 684 685 686 687 688 689 690
\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}
691 692
type TypeEnv = TyVarEnv Type

693 694
applyTypeEnvToId :: TypeEnv -> Id -> Id

695
applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
696 697 698 699 700 701 702 703 704
  | idHasNoFreeTyVars id
  = id
  | otherwise
  = apply_to_Id ( \ ty ->
	applyTypeEnvToTy type_env ty
    ) id
\end{code}

\begin{code}
705
apply_to_Id :: (Type -> Type) -> Id -> Id
706

707
apply_to_Id ty_fn (Id u n ty details prag info)
708 709 710
  = let
	new_ty = ty_fn ty
    in
711
    Id u n new_ty (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
712 713 714 715 716 717
  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
718 719
	SpecId new_unspec new_maybes (no_free_tvs ty)
	-- ToDo: gratuitous recalc no_ftvs???? (also InstId)
720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739
      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}
740
{-LATER:
741 742
applySubstToId :: Subst -> Id -> (Subst, Id)

743
applySubstToId subst id@(Id u n ty info details)
744 745 746 747 748 749
  -- *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) ->
750
    (s4, Id u n new_ty new_info new_details) }}}
751
  where
752
    apply_to_details subst _ (InstId inst no_ftvs)
753
      = case (applySubstToInst subst inst) of { (s2, new_inst) ->
754
	(s2, InstId new_inst no_ftvs{-ToDo:right???-}) }
755 756 757

    apply_to_details subst new_ty (SpecId unspec ty_maybes _)
      = case (applySubstToId subst unspec)  	     of { (s2, new_unspec) ->
758
	case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
759 760 761 762 763 764 765 766 767 768
	(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) ->
769
	(s2, WorkerId new_unwrkr) }
770 771

    apply_to_details subst _ other = (subst, other)
772
-}
773 774 775 776 777 778 779 780 781
\end{code}

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

\begin{code}
782 783
idType :: GenId ty -> ty

784
idType (Id _ _ ty _ _ _) = ty
785 786 787
\end{code}

\begin{code}
788
{-LATER:
789 790 791
getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)

getMentionedTyConsAndClassesFromId id
792 793
 = getMentionedTyConsAndClassesFromType (idType id)
-}
794 795 796
\end{code}

\begin{code}
797
idPrimRep i = typePrimRep (idType i)
798 799 800 801 802 803 804 805 806
\end{code}

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

\begin{code}
807 808 809
mkSuperDictSelId u clas sc ty
  = addStandardIdInfo $
    Id u name ty details NoPragmaInfo noIdInfo
810
  where
811 812 813 814 815 816 817 818 819 820 821
    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

822 823
mkDefaultMethodId dm_name rec_c op gen ty
  = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c op gen) NoPragmaInfo noIdInfo
824

825 826
mkDictFunId dfun_name full_ty clas ity
  = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
827
  where
828
    details  = DictFunId clas ity
829

830 831 832 833 834 835 836
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
837 838

mkWorkerId u unwrkr ty info
839
  = Id u name ty details NoPragmaInfo info
840
  where
841 842
    name    = mkCompoundName name_fn u (getName unwrkr)
    details = WorkerId unwrkr
843
    name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
844

845
mkInstId u ty name 
sof's avatar
sof committed
846
  = Id u name ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
847 848 849 850 851 852 853 854 855 856

{-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
857 858
      Nothing -> pprError "ERROR: getConstMethodId:" (vcat [
	hsep [ppr PprDebug ty, ppr PprDebug ops, ppr PprDebug op_ids,
859
	       ppr PprDebug sel_id],
sof's avatar
sof committed
860 861 862
	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."
863
	])
864
-}
865 866 867 868 869 870 871 872


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)
    )
873 874 875 876 877 878 879 880 881
\end{code}

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

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

884 885
mkPrimitiveId n ty primop 
  = addStandardIdInfo $
sof's avatar
sof committed
886 887 888
    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.
889 890 891
\end{code}

\begin{code}
892

893 894 895 896
type MyTy a b = GenType (GenTyVar a) b
type MyId a b = GenId (MyTy a b)

no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
897 898 899

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

mkSysLocal str uniq ty loc
904
  = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
905

906 907
mkUserLocal occ uniq ty loc
  = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
908

909
mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
910
mkUserId name ty pragma_info
911
  = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
912 913 914 915 916
\end{code}


\begin{code}
{-LATER:
917

918
-- for a SpecPragmaId being created by the compiler out of thin air...
919
mkSpecPragmaId :: OccName -> Unique -> Type -> Maybe Id -> SrcLoc -> Id
920
mkSpecPragmaId str uniq ty specid loc
921
  = Id uniq (mkShortName str loc) ty noIdInfo (SpecPragmaId specid (no_free_tvs ty))
922

923
-- for new SpecId
924 925
mkSpecId u unspec ty_maybes ty info
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
926
    Id u n ty info (SpecId unspec ty_maybes (no_free_tvs ty))
927 928 929 930

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

931
mkSameSpecCon ty_maybes unspec@(Id u n ty info details)
932 933
  = ASSERT(isDataCon unspec)
    ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
934
    Id u n new_ty info (SpecId unspec ty_maybes (no_free_tvs new_ty))
935 936 937 938
  where
    new_ty = specialiseTy ty ty_maybes 0

localiseId :: Id -> Id
939 940
localiseId id@(Id u n ty info details)
  = Id u (mkShortName name loc) ty info (LocalId (no_free_tvs ty))
941
  where
942
    name = getOccName id
943
    loc  = getSrcLoc id
944
-}
945

946 947 948 949
-- 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
950

951
mkIdWithNewUniq :: Id -> Unique -> Id
952 953
mkIdWithNewUniq (Id _ n ty details prag info) u
  = Id u (changeUnique n u) ty details prag info
sof's avatar
sof committed
954 955 956 957

mkIdWithNewName :: Id -> Name -> Id
mkIdWithNewName (Id _ _ ty details prag info) new_name
  = Id (uniqueOf new_name) new_name ty details prag info
958 959 960 961 962 963
\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}
964
mkTemplateLocals :: [Type] -> [Id]
965
mkTemplateLocals tys
966
  = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
967 968 969 970 971
	    (getBuiltinUniques (length tys))
	    tys
\end{code}

\begin{code}
972 973
getIdInfo     :: GenId ty -> IdInfo
getPragmaInfo :: GenId ty -> PragmaInfo
974

975 976
getIdInfo     (Id _ _ _ _ _ info) = info
getPragmaInfo (Id _ _ _ _ info _) = info
977 978

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

sof's avatar
sof committed
981
replacePragmaInfo :: GenId ty -> PragmaInfo -> GenId ty
sof's avatar
sof committed
982
replacePragmaInfo (Id u sn ty details _ info) prag = Id u sn ty details prag info
983 984 985 986 987 988 989 990 991 992 993 994 995
\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}
996
getIdArity :: Id -> ArityInfo
997
getIdArity id@(Id _ _ _ _ _ id_info)
sof's avatar
sof committed
998
  = arityInfo id_info
999

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

sof's avatar
sof committed
1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016
%************************************************************************
%*									*
\subsection[Id-arities]{Deforestation related functions}
%*									*
%************************************************************************

\begin{code}
addIdDeforestInfo :: Id -> DeforestInfo -> Id
addIdDeforestInfo (Id u n ty details pinfo info) def_info
  = Id u n ty details pinfo (info `addDeforestInfo` def_info)
\end{code}

1017 1018 1019 1020 1021 1022 1023
%************************************************************************
%*									*
\subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
%*									*
%************************************************************************

\begin{code}
1024
mkDataCon :: Name
1025
	  -> [StrictnessMark] -> [FieldLabel]
sof's avatar
sof committed
1026 1027 1028
	  -> [TyVar] -> ThetaType
	  -> [TyVar] -> ThetaType
	  -> [TauType] -> TyCon
1029 1030 1031
	  -> Id
  -- can get the tag and all the pieces of the type from the Type

sof's avatar
sof committed
1032
mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
1033
  = ASSERT(length stricts == length args_tys)
1034
    addStandardIdInfo data_con
1035
  where
1036 1037 1038
    -- NB: data_con self-recursion; should be OK as tags are not
    -- looked at until late in the game.
    data_con
1039
      = Id (nameUnique n)
1040
	   n
1041
	   data_con_ty
sof's avatar
sof committed
1042
	   (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
1043
	   IWantToBeINLINEd	-- Always inline constructors if possible
1044
	   noIdInfo
1045

1046
    data_con_tag    = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
1047
    data_con_family = tyConDataCons tycon
1048

1049
    data_con_ty
sof's avatar
sof committed
1050
      = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
1051
	(mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
1052 1053


1054 1055 1056
mkTupleCon :: Arity -> Name -> Type -> Id
mkTupleCon arity name ty 
  = addStandardIdInfo tuple_id
1057
  where
1058 1059 1060 1061
    tuple_id = Id (nameUnique name) name ty 
	  	  (TupleConId arity) 
		  IWantToBeINLINEd		-- Always inline constructors if possible
	  	  noIdInfo
1062 1063 1064 1065 1066

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

sof's avatar
sof committed
1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081
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}


1082
\begin{code}
1083
dataConTag :: DataCon -> ConTag	-- will panic if not a DataCon
sof's avatar
sof committed
1084
dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
1085 1086
dataConTag (Id _ _ _ (TupleConId _) _ _)	      = fIRST_TAG
dataConTag (Id _ _ _ (SpecId unspec _ _) _ _)	      = dataConTag unspec
1087

1088
dataConTyCon :: DataCon -> TyCon	-- will panic if not a DataCon
sof's avatar
sof committed
1089
dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
1090
dataConTyCon (Id _ _ _ (TupleConId a) _ _)	          = tupleTyCon a
1091

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

sof's avatar
sof committed
1095
dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
sof's avatar
sof committed
1096
  = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
1097

1098
dataConSig (Id _ _ _ (TupleConId arity) _ _)
sof's avatar
sof committed
1099
  = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
1100 1101
  where
    tyvars	= take arity alphaTyVars
1102
    tyvar_tys	= mkTyVarTys tyvars
1103

1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122

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

1123
dataConFieldLabels :: DataCon -> [FieldLabel]
sof's avatar
sof committed
1124
dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
1125
dataConFieldLabels (Id _ _ _ (TupleConId _)		    _ _) = []
1126 1127

dataConStrictMarks :: DataCon -> [StrictnessMark]
sof's avatar
sof committed
1128
dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
1129 1130
dataConStrictMarks (Id _ _ _ (TupleConId arity)		     _ _) 
  = nOfThem arity NotMarkedStrict
1131

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

1135 1136 1137 1138 1139 1140
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
1141 1142
    (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
    tenv 		          = zipEqual "dataConArgTys" tyvars inst_tys
1143 1144 1145
\end{code}

\begin{code}
1146
mkRecordSelId field_label selector_ty
1147 1148
  = addStandardIdInfo $		-- Record selectors have a standard unfolding
    Id (nameUnique name)