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

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

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

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

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

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

	recordSelectorFieldLabel,
54 55

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

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

96 97 98 99
	-- Specialialisation
	getIdSpecialisation,
	addIdSpecialisation,

100
	-- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
101
	addIdUnfolding,
102 103 104 105 106 107 108 109 110 111 112
	addIdArity,
	addIdDemandInfo,
	addIdStrictness,
	addIdUpdateInfo,
	getIdArity,
	getIdDemandInfo,
	getIdInfo,
	getIdStrictness,
	getIdUnfolding,
	getIdUpdateInfo,
	getPragmaInfo,
113
	replaceIdInfo,
114
	addInlinePragma,
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 148 149
IMP_Ubiq()
IMPORT_DELOOPER(IdLoop)   -- for paranoia checking
IMPORT_DELOOPER(TyLoop)   -- for paranoia checking
150 151

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

data StrictnessMark = MarkedStrict | NotMarkedStrict
219 220 221 222 223

data IdDetails

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

224 225
  = LocalId	Bool		-- Local name; mentioned by the user
				-- True <=> no free type vars
226

227 228
  | SysLocalId	Bool	        -- Local name; made up by the compiler
				-- as for LocalId
229

230 231
  | PrimitiveId PrimOp		-- The Id for a primitive operation

232
  | SpecPragmaId 		-- Local name; introduced by the compiler
233 234
		 (Maybe Id)	-- for explicit specid in pragma
		 Bool		-- as for LocalId
235 236 237

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

238
  | ImportedId			-- Global name (Imported or Implicit); Id imported from an interface
239 240 241

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

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

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

251
  | TupleConId	Int		-- Its arity
252

253
  | RecordSelId FieldLabel
254

255 256 257 258 259 260
  ---------------- Things to do with overloading

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

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

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

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

				-- 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
293
		Module		-- module where instance came from
294

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

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

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

376

377 378 379 380 381 382 383 384 385
%************************************************************************
%*									*
\subsection[Id-documentation]{Documentation}
%*									*
%************************************************************************

[A BIT DATED [WDP]]

The @Id@ datatype describes {\em values}.  The basic things we want to
386
know: (1)~a value's {\em type} (@idType@ is a very common
387 388 389 390 391 392 393 394
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
395
@Type@ (in the usual place), and also in its constituent pieces (in
396 397 398 399 400 401 402 403 404 405 406 407
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@).

%----------------------------------------------------------------------
408
\item[@MethodSelId@:] A selector from a dictionary; it may select either
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 444 445 446 447 448 449 450 451 452 453 454 455 456
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

457
@DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
458
@MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479
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}
480 481 482 483
isDataCon (Id _ _ _ (DataConId _ _ _ _ _ _ _) _ _) = True
isDataCon (Id _ _ _ (TupleConId _) _ _)		   = True
isDataCon (Id _ _ _ (SpecId unspec _ _) _ _)	   = isDataCon unspec
isDataCon other					   = False
484

485 486 487
isTupleCon (Id _ _ _ (TupleConId _) _ _)	 = True
isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _)	 = isTupleCon unspec
isTupleCon other				 = False
488 489

{-LATER:
490
isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
491 492 493 494 495
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
    Just (unspec, ty_maybes)
isSpecId_maybe other_id
  = Nothing

496
isSpecPragmaId_maybe (Id _ _ _ (SpecPragmaId specid _) _ _)
497
  = Just specid
498 499
isSpecPragmaId_maybe other_id
  = Nothing
500
-}
501 502
\end{code}

503 504 505 506
@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}
507 508 509
about something if it returns @True@!

\begin{code}
510 511
toplevelishId	  :: Id -> Bool
idHasNoFreeTyVars :: Id -> Bool
512

513
toplevelishId (Id _ _ _ details _ _)
514 515
  = chk details
  where
516 517
    chk (DataConId _ _ _ _ _ _ _)   = True
    chk (TupleConId _)    	    = True
518
    chk (RecordSelId _)   	    = True
519
    chk ImportedId	    	    = True
520 521 522
    chk (SuperDictSelId _ _)	    = True
    chk (MethodSelId _ _)	    = True
    chk (DefaultMethodId _ _ _)     = True
523
    chk (DictFunId     _ _)	    = True
524
    chk (ConstMethodId _ _ _ _)     = True
525 526 527
    chk (SpecId unspec _ _)	    = toplevelishId unspec
				    -- depends what the unspecialised thing is
    chk (WorkerId unwrkr)	    = toplevelishId unwrkr
528 529 530 531
    chk (InstId	      _)	    = False	-- these are local
    chk (LocalId      _)	    = False
    chk (SysLocalId   _)	    = False
    chk (SpecPragmaId _ _)	    = False
532
    chk (PrimitiveId _)		    = True
533

534
idHasNoFreeTyVars (Id _ _ _ details _ info)
535 536
  = chk details
  where
537 538
    chk (DataConId _ _ _ _ _ _ _) = True
    chk (TupleConId _)    	  = True
539
    chk (RecordSelId _)   	  = True
540
    chk ImportedId	    	  = True
541
    chk (SuperDictSelId _ _)	  = True
542
    chk (MethodSelId _ _)	  = True
543
    chk (DefaultMethodId _ _ _)   = True
544
    chk (DictFunId     _ _)	  = True
545
    chk (ConstMethodId _ _ _ _)   = True
546
    chk (WorkerId unwrkr)	  = idHasNoFreeTyVars unwrkr
547
    chk (SpecId _     _   no_free_tvs) = no_free_tvs
548 549 550 551
    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
552 553
    chk (PrimitiveId _)		    = True

554 555 556 557 558 559
-- 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
560 561
	-> Bool

562 563 564 565 566 567 568 569
omitIfaceSigForId (Id _ name _ details _ _)
  | isWiredInName name
  = True

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

	-- This group is Ids that are implied by their type or class decl;
572 573 574 575 576 577 578 579 580 581 582
	-- 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
        (DataConId _ _ _ _ _ _ _) -> True
        (TupleConId _)    	  -> True
        (RecordSelId _)   	  -> True
        (SuperDictSelId _ _)	  -> True
        (MethodSelId _ _)	  -> True

	other			  -> False	-- Don't omit!
		-- NB DefaultMethodIds are not omitted
583 584 585
\end{code}

\begin{code}
586 587
isImportedId (Id _ _ _ ImportedId _ _) = True
isImportedId other		       = False
588

589
isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
590

591
isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
592 593
isSysLocalId other			   = False

594
isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
595 596
isSpecPragmaId other			         = False

597 598
isMethodSelId_maybe (Id _ _ _ (MethodSelId cls op) _ _) = Just (cls,op)
isMethodSelId_maybe _				        = Nothing
599

600 601
isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
isDefaultMethodId other				         = False
602

603
isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls clsop err) _ _)
604 605 606
  = Just (cls, clsop, err)
isDefaultMethodId_maybe other = Nothing

607 608
isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
isDictFunId other		    	   = False
609

610
isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _) _ _) = True
611 612
isConstMethodId other		    		       = False

613
isConstMethodId_maybe (Id _ _ _ (ConstMethodId cls ty clsop _) _ _)
614 615 616
  = Just (cls, ty, clsop)
isConstMethodId_maybe other = Nothing

617
isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
618 619
isSuperDictSelId_maybe other_id				  = Nothing

620
isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
621 622
isWorkerId other		     = False

623 624
isWrapperId id = workerExists (getIdStrictness id)

625 626
isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
isPrimitiveId_maybe other				= Nothing
627 628 629 630
\end{code}

Tell them who my wrapper function is.
\begin{code}
631
{-LATER:
632 633
myWrapperMaybe :: Id -> Maybe Id

634
myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper) _ _) = Just my_wrapper
635 636
myWrapperMaybe other_id			    	  = Nothing
-}
637 638 639 640 641 642 643 644
\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.

645
unfoldingUnfriendlyId id = not (externallyVisibleId id)
646 647 648
\end{code}

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

652 653
In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
local-ness precisely so that the test here would be easy
654 655 656

\begin{code}
externallyVisibleId :: Id -> Bool
657 658
externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
		     -- not local => global => externally visible
659 660 661 662 663 664 665 666 667 668
\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}
669 670
type TypeEnv = TyVarEnv Type

671 672
applyTypeEnvToId :: TypeEnv -> Id -> Id

673
applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
674 675 676 677 678 679 680 681 682
  | idHasNoFreeTyVars id
  = id
  | otherwise
  = apply_to_Id ( \ ty ->
	applyTypeEnvToTy type_env ty
    ) id
\end{code}

\begin{code}
683
apply_to_Id :: (Type -> Type) -> Id -> Id
684

685
apply_to_Id ty_fn (Id u n ty details prag info)
686 687 688
  = let
	new_ty = ty_fn ty
    in
689
    Id u n new_ty (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
690 691 692 693 694 695
  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
696 697
	SpecId new_unspec new_maybes (no_free_tvs ty)
	-- ToDo: gratuitous recalc no_ftvs???? (also InstId)
698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717
      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}
718
{-LATER:
719 720
applySubstToId :: Subst -> Id -> (Subst, Id)

721
applySubstToId subst id@(Id u n ty info details)
722 723 724 725 726 727
  -- *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) ->
728
    (s4, Id u n new_ty new_info new_details) }}}
729
  where
730
    apply_to_details subst _ (InstId inst no_ftvs)
731
      = case (applySubstToInst subst inst) of { (s2, new_inst) ->
732
	(s2, InstId new_inst no_ftvs{-ToDo:right???-}) }
733 734 735

    apply_to_details subst new_ty (SpecId unspec ty_maybes _)
      = case (applySubstToId subst unspec)  	     of { (s2, new_unspec) ->
736
	case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
737 738 739 740 741 742 743 744 745 746
	(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) ->
747
	(s2, WorkerId new_unwrkr) }
748 749

    apply_to_details subst _ other = (subst, other)
750
-}
751 752 753 754 755 756 757 758 759
\end{code}

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

\begin{code}
760 761
idType :: GenId ty -> ty

762
idType (Id _ _ ty _ _ _) = ty
763 764 765
\end{code}

\begin{code}
766
{-LATER:
767 768 769
getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)

getMentionedTyConsAndClassesFromId id
770 771
 = getMentionedTyConsAndClassesFromType (idType id)
-}
772 773 774
\end{code}

\begin{code}
775
idPrimRep i = typePrimRep (idType i)
776 777 778 779 780 781 782 783 784
\end{code}

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

\begin{code}
785 786 787
mkSuperDictSelId u clas sc ty
  = addStandardIdInfo $
    Id u name ty details NoPragmaInfo noIdInfo
788
  where
789 790 791 792 793 794 795 796 797 798 799
    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

800 801
mkDefaultMethodId dm_name rec_c op gen ty
  = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c op gen) NoPragmaInfo noIdInfo
802

803 804
mkDictFunId dfun_name full_ty clas ity
  = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
805
  where
806
    details  = DictFunId clas ity
807

808 809 810 811 812 813 814
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
815 816

mkWorkerId u unwrkr ty info
817
  = Id u name ty details NoPragmaInfo info
818
  where
819 820
    name    = mkCompoundName name_fn u (getName unwrkr)
    details = WorkerId unwrkr
821
    name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
822

823 824
mkInstId u ty name 
  = Id u (changeUnique name u) ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
825 826 827 828 829 830 831 832 833 834

{-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
835 836
      Nothing -> pprError "ERROR: getConstMethodId:" (ppAboves [
	ppCat [ppr PprDebug ty, ppr PprDebug ops, ppr PprDebug op_ids,
837 838 839 840
	       ppr PprDebug sel_id],
	ppStr "(This can arise if an interface pragma refers to an instance",
	ppStr "but there is no imported interface which *defines* that instance.",
	ppStr "The info above, however ugly, should indicate what else you need to import."
841
	])
842
-}
843 844 845 846 847 848 849 850


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)
    )
851 852 853 854 855 856 857 858 859
\end{code}

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

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

862 863 864
mkPrimitiveId n ty primop 
  = addStandardIdInfo $
    Id (nameUnique n) n ty (PrimitiveId primop) NoPragmaInfo noIdInfo
865

866 867 868
\end{code}

\begin{code}
869

870 871 872 873
type MyTy a b = GenType (GenTyVar a) b
type MyId a b = GenId (MyTy a b)

no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
874 875 876

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

mkSysLocal str uniq ty loc
881
  = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
882

883 884
mkUserLocal occ uniq ty loc
  = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
885

886
mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
887
mkUserId name ty pragma_info
888
  = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
889 890 891 892 893
\end{code}


\begin{code}
{-LATER:
894

895
-- for a SpecPragmaId being created by the compiler out of thin air...
896
mkSpecPragmaId :: OccName -> Unique -> Type -> Maybe Id -> SrcLoc -> Id
897
mkSpecPragmaId str uniq ty specid loc
898
  = Id uniq (mkShortName str loc) ty noIdInfo (SpecPragmaId specid (no_free_tvs ty))
899

900
-- for new SpecId
901 902
mkSpecId u unspec ty_maybes ty info
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
903
    Id u n ty info (SpecId unspec ty_maybes (no_free_tvs ty))
904 905 906 907

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

908
mkSameSpecCon ty_maybes unspec@(Id u n ty info details)
909 910
  = ASSERT(isDataCon unspec)
    ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
911
    Id u n new_ty info (SpecId unspec ty_maybes (no_free_tvs new_ty))
912 913 914 915
  where
    new_ty = specialiseTy ty ty_maybes 0

localiseId :: Id -> Id
916 917
localiseId id@(Id u n ty info details)
  = Id u (mkShortName name loc) ty info (LocalId (no_free_tvs ty))
918
  where
919
    name = getOccName id
920
    loc  = getSrcLoc id
921
-}
922

923 924 925 926
-- 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
927

928
mkIdWithNewUniq :: Id -> Unique -> Id
929 930
mkIdWithNewUniq (Id _ n ty details prag info) u
  = Id u (changeUnique n u) ty details prag info
931 932 933 934 935 936
\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}
937
mkTemplateLocals :: [Type] -> [Id]
938
mkTemplateLocals tys
939
  = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
940 941 942 943 944
	    (getBuiltinUniques (length tys))
	    tys
\end{code}

\begin{code}
945 946
getIdInfo     :: GenId ty -> IdInfo
getPragmaInfo :: GenId ty -> PragmaInfo
947

948 949
getIdInfo     (Id _ _ _ _ _ info) = info
getPragmaInfo (Id _ _ _ _ info _) = info
950 951 952

replaceIdInfo :: Id -> IdInfo -> Id

953
replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
954

955
{-LATER:
956 957 958
selectIdInfoForSpecId :: Id -> IdInfo
selectIdInfoForSpecId unspec
  = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
959
    noIdInfo `addUnfoldInfo` getIdUnfolding unspec
960
-}
961 962 963 964 965 966 967 968 969 970 971 972 973
\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}
974
getIdArity :: Id -> ArityInfo
975 976
getIdArity id@(Id _ _ _ _ _ id_info)
  = --ASSERT( not (isDataCon id))
977
    arityInfo id_info
978 979

dataConArity, dataConNumFields :: DataCon -> Int
980

981
dataConArity id@(Id _ _ _ _ _ id_info)
982
  = ASSERT(isDataCon id)
983 984 985
    case arityInfo id_info of
      ArityExactly a -> a
      other	     -> pprPanic "dataConArity:Nothing:" (pprId PprDebug id)
986

987 988 989 990 991 992
dataConNumFields id
  = ASSERT(isDataCon id)
    case (dataConSig id) of { (_, _, arg_tys, _) ->
    length arg_tys }

isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
993

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

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

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

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

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

1029
    data_con_ty
1030
      = mkSigmaTy tvs ctxt
1031
	(mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
1032 1033


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

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

\begin{code}
1048
dataConTag :: DataCon -> ConTag	-- will panic if not a DataCon
1049 1050 1051
dataConTag (Id _ _ _ (DataConId tag _ _ _ _ _ _) _ _) = tag
dataConTag (Id _ _ _ (TupleConId _) _ _)	      = fIRST_TAG
dataConTag (Id _ _ _ (SpecId unspec _ _) _ _)	      = dataConTag unspec
1052

1053
dataConTyCon :: DataCon -> TyCon	-- will panic if not a DataCon
1054
dataConTyCon (Id _ _ _ (DataConId _ _ _ _ _ _ tycon) _ _) = tycon
1055
dataConTyCon (Id _ _ _ (TupleConId a) _ _)	          = tupleTyCon a
1056

1057
dataConSig :: DataCon -> ([TyVar], ThetaType, [TauType], TyCon)
1058 1059
					-- will panic if not a DataCon

1060
dataConSig (Id _ _ _ (DataConId _ _ _ tyvars theta_ty arg_tys tycon) _ _)
1061 1062
  = (tyvars, theta_ty, arg_tys, tycon)

1063
dataConSig (Id _ _ _ (TupleConId arity) _ _)
1064
  = (tyvars, [], tyvar_tys, tupleTyCon arity)
1065 1066
  where
    tyvars	= take arity alphaTyVars
1067
    tyvar_tys	= mkTyVarTys tyvars
1068

1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087

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

1088
dataConFieldLabels :: DataCon -> [FieldLabel]
1089 1090
dataConFieldLabels (Id _ _ _ (DataConId _ _ fields _ _ _ _) _ _) = fields
dataConFieldLabels (Id _ _ _ (TupleConId _)		    _ _) = []
1091 1092

dataConStrictMarks :: DataCon -> [StrictnessMark]
1093 1094 1095
dataConStrictMarks (Id _ _ _ (DataConId _ stricts _ _ _ _ _) _ _) = stricts
dataConStrictMarks (Id _ _ _ (TupleConId arity)		     _ _) 
  = nOfThem arity NotMarkedStrict
1096

1097 1098 1099
dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
dataConRawArgTys con = case (dataConSig con) of { (_,_, arg_tys,_) -> arg_tys }

1100 1101 1102 1103 1104 1105 1106
dataConArgTys :: DataCon 
	      -> [Type] 	-- Instantiated at these types
	      -> [Type]		-- Needs arguments of these types
dataConArgTys con_id inst_tys
 = map (instantiateTy tenv) arg_tys
 where
    (tyvars, _, arg_tys, _) = dataConSig con_id
1107
    tenv 		    = zipEqual "dataConArgTys" tyvars inst_tys
1108 1109 1110
\end{code}

\begin{code}
1111
mkRecordSelId field_label selector_ty
1112 1113
  = addStandardIdInfo $		-- Record selectors have a standard unfolding
    Id (nameUnique name)
1114
       name
1115
       selector_ty
1116
       (RecordSelId field_label)
1117 1118 1119 1120 1121 1122
       NoPragmaInfo
       noIdInfo
  where
    name = fieldLabelName field_label

recordSelectorFieldLabel :: Id -> FieldLabel
1123
recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1124 1125 1126

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

1129 1130 1131 1132 1133 1134 1135 1136

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}
1137
fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1138
\end{verbatim}
1139
Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1140 1141 1142 1143 1144 1145 1146 1147
2nd-order polymorphic lambda calculus with explicit types.

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

1148 1149
\begin{code}
getIdUnfolding :: Id -> Unfolding
1150

1151
getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1152

1153 1154 1155 1156 1157 1158 1159
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.