Id.lhs 22.5 KB
Newer Older
1

2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
3 4 5 6
%
\section[Id]{@Ids@: Value and constructor identifiers}

\begin{code}
7 8
module Id (
	-- TYPES
9 10 11
	GenId,		 	-- Abstract
	Id,
	IdDetails(..),		-- Exposed only to MkId
12
	StrictnessMark(..),
13 14
	ConTag, fIRST_TAG,
	DataCon, DictFun, DictVar,
15

16 17 18
	-- Construction and modification
	mkId, mkIdWithNewUniq, mkIdWithNewName, mkIdWithNewType,
	mkTemplateLocals, 
sof's avatar
sof committed
19 20
	setIdVisibility, mkIdVisible,
	mkVanillaId,
21 22 23

	-- DESTRUCTION (excluding pragmatic info)
	idPrimRep,
24
	idType,
25
	idUnique,
sof's avatar
sof committed
26
	idName,
27

28
	-- Extracting pieces of particular sorts of Ids
29
	dataConRepType,
30 31
	dataConArgTys,
	dataConNumFields,
32
	dataConFieldLabels,
33 34 35 36 37
	dataConRawArgTys,
	dataConSig,
	dataConStrictMarks,
	dataConTag,
	dataConTyCon,
38 39

	recordSelectorFieldLabel,
40 41

	-- PREDICATES
42
	omitIfaceSigForId,
43 44 45
	cmpId,
	externallyVisibleId,
	idHasNoFreeTyVars,
sof's avatar
sof committed
46
	idWantsToBeINLINEd, getInlinePragma, 
sof's avatar
sof committed
47
	idMustBeINLINEd, idMustNotBeINLINEd,
48
	isBottomingId,
49 50
	
	isDataCon, isAlgCon, isNewCon, isTupleCon,
51
	isNullaryDataCon,
52 53

	isRecordSelector, isSpecPragmaId,
54
	isPrimitiveId_maybe,
55

56 57 58
	-- PRINTING and RENUMBERING
	pprId,
	showId,
59

60
	-- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
61
	idInfo,
62
	addIdUnfolding,
63 64 65 66 67 68 69 70 71
	addIdArity,
	addIdDemandInfo,
	addIdStrictness,
	addIdUpdateInfo,
	getIdArity,
	getIdDemandInfo,
	getIdStrictness,
	getIdUnfolding,
	getIdUpdateInfo,
72
	replaceIdInfo,
sof's avatar
sof committed
73
	addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
74 75
	getIdSpecialisation,
	setIdSpecialisation,
76

77
	-- IdEnvs AND IdSets
78
	IdEnv, GenIdSet, IdSet,
79 80 81 82 83 84 85 86 87 88 89 90 91
	addOneToIdEnv,
	addOneToIdSet,
	combineIdEnvs,
	delManyFromIdEnv,
	delOneFromIdEnv,
	elementOfIdSet,
	emptyIdSet,
	growIdEnv,
	growIdEnvList,
	idSetToList,
	intersectIdSets,
	isEmptyIdSet,
	isNullIdEnv,
92
	lookupIdEnv, lookupIdSubst,
93 94 95
	lookupNoFailIdEnv,
	mapIdEnv,
	minusIdSet,
96
	mkIdEnv, elemIdEnv,
97 98
	mkIdSet,
	modifyIdEnv,
99
	modifyIdEnv_Directly,
100 101 102 103 104 105 106
	nullIdEnv,
	rngIdEnv,
	unionIdSets,
	unionManyIdSets,
	unitIdEnv,
	unitIdSet
    ) where
107

108
#include "HsVersions.h"
sof's avatar
sof committed
109

sof's avatar
sof committed
110
import {-# SOURCE #-} CoreUnfold ( Unfolding )
sof's avatar
sof committed
111

112
import CmdLineOpts      ( opt_PprStyle_All )
113
import Bag
114
import IdInfo
115
import Name	 	( nameUnique, isLocalName, mkSysLocalName,
sof's avatar
sof committed
116 117
			  isWiredInName, setNameVisibility, mkNameVisible,
			  changeUnique,
118
			  ExportFlag(..), Provenance,
119
			  OccName(..), Name, Module,
sof's avatar
sof committed
120 121
			  NamedThing(..)
			) 
122
import PrimOp		( PrimOp )
123
import PrelMods		( pREL_TUP, pREL_BASE )
124
import FieldLabel	( fieldLabelName, FieldLabel(..) )
sof's avatar
sof committed
125
import SrcLoc		( mkBuiltinSrcLoc )
126
import TysWiredIn	( tupleTyCon )
127
import TyCon		( TyCon, isDataTyCon, isNewTyCon )
128
import Type		( mkSigmaTy, mkTyVarTys, mkFunTys,
129 130 131
			  mkTyConApp, instantiateTy, mkForAllTys,
			  tyVarsOfType, instantiateTy, typePrimRep,
			  instantiateTauTy,
132
			  ThetaType, TauType, Type, GenType
133 134 135
			)
import TyVar		( TyVar, alphaTyVars, isEmptyTyVarSet, 
			  TyVarEnv, zipTyVarEnv, mkTyVarEnv
sof's avatar
sof committed
136
			)
137
import UniqFM
138
import UniqSet		-- practically all of it
139
import Unique		( Unique, Uniquable(..), getBuiltinUniques )
140
import Outputable
sof's avatar
sof committed
141
import SrcLoc		( SrcLoc )
142
import Util		( nOfThem, assoc )
143
import GlaExts		( Int# )
144 145 146 147 148 149
\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
150
@Type@, and an @IdInfo@ (non-essential info about it, e.g.,
151 152 153 154 155 156
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}
157 158 159 160 161 162 163
data GenId ty = Id {
	idUnique  :: Unique,		-- Key for fast comparison
	idName    :: Name,
	idType    :: ty,		-- Id's type; used all the time;
	idDetails :: IdDetails,		-- Stuff about individual kinds of Ids.
	idInfo    :: IdInfo		-- Properties of this Id deduced by compiler
	}
164
				   
165
type Id	           = GenId Type
166 167

data StrictnessMark = MarkedStrict | NotMarkedStrict
168 169 170 171 172

data IdDetails

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

173
  = VanillaId	Bool		-- Ordinary Id
174
				-- True <=> no free type vars
175

176
  | PrimitiveId PrimOp		-- The Id for a primitive operation
177
                                
178 179 180

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

sof's avatar
sof committed
181 182 183
  | AlgConId			-- Used for both data and newtype constructors.
				-- You can tell the difference by looking at the TyCon
		ConTag
184
		[StrictnessMark] -- Strict args; length = arity
sof's avatar
sof committed
185 186
		[FieldLabel]	-- Field labels for this constructor; 
				--length = 0 (not a record) or arity
187

188 189
		[TyVar] ThetaType 	-- Type vars and context for the data type decl
		[TyVar] ThetaType 	-- Ditto for the context of the constructor, 
sof's avatar
sof committed
190 191
					-- the existentially quantified stuff
		[Type] TyCon		-- Args and result tycon
192
				-- the type is:
sof's avatar
sof committed
193
				-- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
194
				--    unitype_1 -> ... -> unitype_n -> tycon tyvars
195

196
  | TupleConId	Int		-- Its arity
197

198
  | RecordSelId FieldLabel
199

200 201 202 203 204 205 206 207 208
  | SpecPragmaId		-- This guy exists only to make Ids that are
				-- on the *LHS* of bindings created by SPECIALISE
				-- pragmas; eg:		s = f Int d
				-- The SpecPragmaId is never itself mentioned; it
				-- exists solely so that the specialiser will find
				-- the call to f, and make specialised version of it.
				-- The SpecPragmaId binding is discarded by the specialiser
				-- when it gathers up overloaded calls.
				-- Meanwhile, it is not discarded as dead code.
209

210 211 212 213 214 215


type ConTag	= Int
type DictVar	= Id
type DictFun	= Id
type DataCon	= Id
216 217 218 219 220
\end{code}


%************************************************************************
%*									*
221
\subsection{Construction}
222 223 224
%*									*
%************************************************************************

225 226 227 228 229 230 231 232 233 234 235 236 237
\begin{code}
mkId :: Name -> ty -> IdDetails -> IdInfo -> GenId ty
mkId name ty details info
  = Id {idName = name, idUnique = nameUnique name, idType = ty, 
	idDetails = details, idInfo = info}

mkVanillaId :: Name -> (GenType flexi) -> IdInfo -> GenId (GenType flexi)
mkVanillaId name ty info
  = Id {idName = name, idUnique = nameUnique name, idType = ty, 
	idDetails = VanillaId (isEmptyTyVarSet (tyVarsOfType ty)),
	idInfo = info}

mkIdWithNewUniq :: Id -> Unique -> Id
238
mkIdWithNewUniq id uniq = id {idUnique = uniq, idName = changeUnique (idName id) uniq}
239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255

mkIdWithNewName :: Id -> Name -> Id
mkIdWithNewName id new_name
  = id {idUnique = uniqueOf new_name, idName = new_name}

mkIdWithNewType :: GenId ty1 -> ty2 -> GenId ty2
mkIdWithNewType id ty = id {idType = ty}
\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}
mkTemplateLocals :: [Type] -> [Id]
mkTemplateLocals tys
256
  = zipWith3 mk (getBuiltinUniques (length tys)) tys [1..]
257
  where
258 259
    mk uniq ty n = mkVanillaId (mkSysLocalName uniq (_PK_ ("x"++show n)) mkBuiltinSrcLoc)
			       ty noIdInfo
260 261 262 263 264 265 266 267 268
\end{code}


\begin{code}
-- See notes with setNameVisibility (Name.lhs)
setIdVisibility :: Maybe Module -> Unique -> Id -> Id
setIdVisibility maybe_mod u id 
  = id {idName = setNameVisibility maybe_mod u (idName id)}

sof's avatar
sof committed
269 270 271
mkIdVisible :: Module -> Unique -> Id -> Id
mkIdVisible mod u id = id {idName = mkNameVisible mod u (idName id)}

272 273 274
replaceIdInfo :: GenId ty -> IdInfo -> GenId ty
replaceIdInfo id info = id {idInfo = info}
\end{code}
275 276 277 278 279 280 281 282

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

\begin{code}
283 284 285
fIRST_TAG :: ConTag
fIRST_TAG =  1	-- Tags allocated from here for real constructors

sof's avatar
sof committed
286
-- isDataCon returns False for @newtype@ constructors
287 288 289
isDataCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isDataTyCon tc
isDataCon (Id {idDetails = TupleConId _})		 = True
isDataCon other					         = False
sof's avatar
sof committed
290

291 292
isNewCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isNewTyCon tc
isNewCon other					        = False
sof's avatar
sof committed
293 294

-- isAlgCon returns True for @data@ or @newtype@ constructors
295 296 297
isAlgCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ _}) = True
isAlgCon (Id {idDetails = TupleConId _})	       = True
isAlgCon other					       = False
298

299 300
isTupleCon (Id {idDetails = TupleConId _}) = True
isTupleCon other			   = False
301 302 303
\end{code}

\begin{code}
304
idHasNoFreeTyVars :: Id -> Bool
305

306
idHasNoFreeTyVars (Id {idDetails = details})
307 308
  = chk details
  where
sof's avatar
sof committed
309
    chk (AlgConId _ _ _ _ _ _ _ _ _) = True
310 311 312 313 314
    chk (TupleConId _)    	   = True
    chk (RecordSelId _)   	   = True
    chk (VanillaId    no_free_tvs) = no_free_tvs
    chk (PrimitiveId _)		   = True
    chk SpecPragmaId		   = False	-- Play safe
315

316 317 318 319 320 321
-- 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
322 323
	-> Bool

324
omitIfaceSigForId (Id {idName = name, idDetails = details})
325 326 327 328 329 330
  | isWiredInName name
  = True

  | otherwise
  = case details of
        (PrimitiveId _)	  -> True		-- Ditto, for primitives
331 332

	-- This group is Ids that are implied by their type or class decl;
333 334 335
	-- 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
336
        (AlgConId _ _ _ _ _ _ _ _ _) -> True
337 338
        (TupleConId _)    	     -> True
        (RecordSelId _)   	     -> True
339

340
	other			     -> False	-- Don't omit!
341
		-- NB DefaultMethodIds are not omitted
342 343 344
\end{code}

\begin{code}
345
isBottomingId id = bottomIsGuaranteed (strictnessInfo (idInfo id))
346

347 348
isPrimitiveId_maybe (Id {idDetails = PrimitiveId primop}) = Just primop
isPrimitiveId_maybe other				  = Nothing
349

350 351
isSpecPragmaId (Id {idDetails = SpecPragmaId}) = True
isSpecPragmaId _			       = False
352 353 354
\end{code}

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

358 359
In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
local-ness precisely so that the test here would be easy
360 361 362

\begin{code}
externallyVisibleId :: Id -> Bool
363
externallyVisibleId id = not (isLocalName (idName id))
364
		     -- not local => global => externally visible
365 366 367 368
\end{code}


\begin{code}
369
idPrimRep id = typePrimRep (idType id)
370 371 372 373 374 375 376 377 378 379 380 381 382 383
\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}
384
getIdArity :: Id -> ArityInfo
385
getIdArity id = arityInfo (idInfo id)
386

387
addIdArity :: Id -> ArityInfo -> Id
388 389
addIdArity id@(Id {idInfo = info}) arity
  = id {idInfo = arity `setArityInfo` info}
390
\end{code}
sof's avatar
sof committed
391

392 393 394 395 396 397 398
%************************************************************************
%*									*
\subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
%*									*
%************************************************************************


sof's avatar
sof committed
399 400 401 402 403 404 405
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
406 407
  = ASSERT( if (isDataCon id) then True else
	    pprTrace "dataConNumFields" (ppr id) False )
sof's avatar
sof committed
408 409 410 411
    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
412

sof's avatar
sof committed
413 414 415
\end{code}


416
\begin{code}
417
dataConTag :: DataCon -> ConTag	-- will panic if not a DataCon
418 419
dataConTag (Id {idDetails = AlgConId tag _ _ _ _ _ _ _ _}) = tag
dataConTag (Id {idDetails = TupleConId _})	           = fIRST_TAG
420

421
dataConTyCon :: DataCon -> TyCon	-- will panic if not a DataCon
422 423
dataConTyCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tycon}) = tycon
dataConTyCon (Id {idDetails = TupleConId a})	 	       = tupleTyCon a
424

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

428
dataConSig (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
sof's avatar
sof committed
429
  = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
430

431
dataConSig (Id {idDetails = TupleConId arity})
sof's avatar
sof committed
432
  = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
433 434
  where
    tyvars	= take arity alphaTyVars
435
    tyvar_tys	= mkTyVarTys tyvars
436

437 438 439 440

-- 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
441 442
--	   e.g.    data Eq a => T a = MkT a a
--
443
--	b) the constructor may store an unboxed version of a strict field.
444
--
445 446 447 448 449 450 451 452
-- 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!

453
dataConRepType :: Id -> Type
454
dataConRepType (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
455 456 457 458 459
  = mkForAllTys (tyvars++con_tyvars) 
		(mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
dataConRepType other_id
  = ASSERT( isDataCon other_id )
    idType other_id
460

461
dataConFieldLabels :: DataCon -> [FieldLabel]
462 463
dataConFieldLabels (Id {idDetails = AlgConId _ _ fields _ _ _ _ _ _}) = fields
dataConFieldLabels (Id {idDetails = TupleConId _})		      = []
sof's avatar
sof committed
464
#ifdef DEBUG
465
dataConFieldLabels x@(Id {idDetails = idt}) = 
sof's avatar
sof committed
466 467
  panic ("dataConFieldLabel: " ++
    (case idt of
468
      VanillaId _   -> "l"
sof's avatar
sof committed
469
      PrimitiveId _ -> "p"
470
      RecordSelId _ -> "r"))
sof's avatar
sof committed
471
#endif
472 473

dataConStrictMarks :: DataCon -> [StrictnessMark]
474 475
dataConStrictMarks (Id {idDetails = AlgConId _ stricts _ _ _ _ _ _ _}) = stricts
dataConStrictMarks (Id {idDetails = TupleConId arity})		       = nOfThem arity NotMarkedStrict
476

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

480 481 482 483 484 485
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
486
    (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
487
    tenv 		          = zipTyVarEnv tyvars inst_tys
488 489 490 491
\end{code}

\begin{code}
recordSelectorFieldLabel :: Id -> FieldLabel
492
recordSelectorFieldLabel (Id {idDetails = RecordSelId lbl}) = lbl
493

494 495
isRecordSelector (Id {idDetails = RecordSelId lbl}) = True
isRecordSelector other				    = False
496 497
\end{code}

498 499 500 501 502 503 504

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

505 506
\begin{code}
getIdUnfolding :: Id -> Unfolding
507

508
getIdUnfolding id = unfoldingInfo (idInfo id)
509

510
addIdUnfolding :: Id -> Unfolding -> Id
511 512
addIdUnfolding id@(Id {idInfo = info}) unfolding
  = id {idInfo = unfolding `setUnfoldingInfo` info}
513 514 515 516
\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.
517 518

\begin{code}
519 520
getInlinePragma :: Id -> InlinePragInfo
getInlinePragma id = inlinePragInfo (idInfo id)
sof's avatar
sof committed
521

522
idWantsToBeINLINEd :: Id -> Bool
523

524 525 526 527
idWantsToBeINLINEd id = case getInlinePragma id of
			  IWantToBeINLINEd -> True
			  IMustBeINLINEd   -> True
			  other		   -> False
528

529
idMustNotBeINLINEd id = case getInlinePragma id of
530 531 532
			  IDontWantToBeINLINEd -> True
			  IMustNotBeINLINEd    -> True
			  other		       -> False
sof's avatar
sof committed
533

534 535 536
idMustBeINLINEd id =  case getInlinePragma id of
			IMustBeINLINEd -> True
			other	       -> False
sof's avatar
sof committed
537

538
addInlinePragma :: Id -> Id
539 540
addInlinePragma id@(Id {idInfo = info})
  = id {idInfo = setInlinePragInfo IWantToBeINLINEd info}
541

sof's avatar
sof committed
542
nukeNoInlinePragma :: Id -> Id
543 544 545 546
nukeNoInlinePragma id@(Id {idInfo = info})
  = case inlinePragInfo info of
	IMustNotBeINLINEd -> id {idInfo = setInlinePragInfo NoPragmaInfo info}
	other		  -> id
547

548 549 550 551
-- If the user has already marked this binding as NOINLINE, then don't
-- add the IMustNotBeINLINEd tag, since it will get nuked later whereas
-- IDontWantToBeINLINEd is permanent.

sof's avatar
sof committed
552
addNoInlinePragma :: Id -> Id
553
addNoInlinePragma id@(Id {idInfo = info})
554 555 556
  = case inlinePragInfo info of
	IDontWantToBeINLINEd -> id
	other -> id {idInfo = IMustNotBeINLINEd `setInlinePragInfo` info}
557 558 559

mustInlineInfo   = IMustBeINLINEd   `setInlinePragInfo` noIdInfo
wantToInlineInfo = IWantToBeINLINEd `setInlinePragInfo` noIdInfo
560 561
\end{code}

562

sof's avatar
sof committed
563

564 565 566 567 568 569 570 571
%************************************************************************
%*									*
\subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
%*									*
%************************************************************************

\begin{code}
getIdDemandInfo :: Id -> DemandInfo
572
getIdDemandInfo id = demandInfo (idInfo id)
573 574

addIdDemandInfo :: Id -> DemandInfo -> Id
575 576
addIdDemandInfo id@(Id {idInfo = info}) demand_info
  = id {idInfo = demand_info `setDemandInfo` info}
577
\end{code}p
578 579 580

\begin{code}
getIdUpdateInfo :: Id -> UpdateInfo
581
getIdUpdateInfo id = updateInfo (idInfo id)
582 583

addIdUpdateInfo :: Id -> UpdateInfo -> Id
584 585
addIdUpdateInfo id@(Id {idInfo = info}) upd_info
  = id {idInfo = upd_info `setUpdateInfo` info}
586 587 588
\end{code}

\begin{code}
589
getIdSpecialisation :: Id -> IdSpecEnv
590
getIdSpecialisation id = specInfo (idInfo id)
591

592
setIdSpecialisation :: Id -> IdSpecEnv -> Id
593 594
setIdSpecialisation id@(Id {idInfo = info}) spec_info
  = id {idInfo = spec_info `setSpecInfo` info}
595 596 597
\end{code}

\begin{code}
sof's avatar
sof committed
598
getIdStrictness :: Id -> StrictnessInfo
599
getIdStrictness id = strictnessInfo (idInfo id)
600

sof's avatar
sof committed
601
addIdStrictness :: Id -> StrictnessInfo -> Id
602 603
addIdStrictness id@(Id {idInfo = info}) strict_info
  = id {idInfo = strict_info `setStrictnessInfo` info}
604 605 606 607 608 609 610 611 612 613 614
\end{code}

%************************************************************************
%*									*
\subsection[Id-comparison]{Comparison functions for @Id@s}
%*									*
%************************************************************************

Comparison: equality and ordering---this stuff gets {\em hammered}.

\begin{code}
615
cmpId (Id {idUnique = u1}) (Id {idUnique = u2}) = compare u1 u2
616 617 618
\end{code}

\begin{code}
619
instance Eq (GenId ty) where
620 621
    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
622

623
instance Ord (GenId ty) where
624 625 626 627 628
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
    compare a b = cmpId a b
629 630 631 632 633 634 635 636 637
\end{code}

%************************************************************************
%*									*
\subsection[Id-other-instances]{Other instance declarations for @Id@s}
%*									*
%************************************************************************

\begin{code}
638
instance Outputable ty => Outputable (GenId ty) where
639
    ppr id = pprId id
640

641 642
showId :: Id -> String
showId id = showSDoc (pprId id)
643 644 645 646
\end{code}

Default printing code (not used for interfaces):
\begin{code}
647
pprId :: Outputable ty => GenId ty -> SDoc
sof's avatar
sof committed
648

649
pprId Id {idUnique = u, idName = n, idInfo = info}
650
  = hcat [ppr n, pp_prags]
sof's avatar
sof committed
651
  where
sof's avatar
sof committed
652 653 654 655 656 657 658 659 660 661 662
    pp_prags sty 
      | opt_PprStyle_All && not (codeStyle sty) 
      = (case inlinePragInfo info of
	    IMustNotBeINLINEd -> text "{n}"
	    IWantToBeINLINEd  -> text "{i}"
	    IMustBeINLINEd    -> text "{I}"
	    other	      -> empty) sty

      | otherwise        
      = empty sty

663 664 665
\end{code}

\begin{code}
666 667 668
instance Uniquable (GenId ty) where
    uniqueOf = idUnique

669
instance NamedThing (GenId ty) where
670
    getName = idName
671 672
\end{code}

673 674
Note: The code generator doesn't carry a @UniqueSupply@, so it uses
the @Uniques@ out of local @Ids@ given to it.
675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696

%************************************************************************
%*									*
\subsection{@IdEnv@s and @IdSet@s}
%*									*
%************************************************************************

\begin{code}
type IdEnv elt = UniqFM elt

nullIdEnv	  :: IdEnv a
		  
mkIdEnv		  :: [(GenId ty, a)] -> IdEnv a
unitIdEnv	  :: GenId ty -> a -> IdEnv a
addOneToIdEnv	  :: IdEnv a -> GenId ty -> a -> IdEnv a
growIdEnv	  :: IdEnv a -> IdEnv a -> IdEnv a
growIdEnvList	  :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
		  
delManyFromIdEnv  :: IdEnv a -> [GenId ty] -> IdEnv a
delOneFromIdEnv	  :: IdEnv a -> GenId ty -> IdEnv a
combineIdEnvs	  :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
mapIdEnv	  :: (a -> b) -> IdEnv a -> IdEnv b
697
modifyIdEnv	  :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
698 699 700 701 702
rngIdEnv	  :: IdEnv a -> [a]
		  
isNullIdEnv	  :: IdEnv a -> Bool
lookupIdEnv	  :: IdEnv a -> GenId ty -> Maybe a
lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
703
elemIdEnv	  :: Id -> IdEnv a -> Bool
704 705 706
\end{code}

\begin{code}
707
elemIdEnv        = elemUFM
708 709 710 711 712 713 714 715 716 717
addOneToIdEnv	 = addToUFM
combineIdEnvs	 = plusUFM_C
delManyFromIdEnv = delListFromUFM
delOneFromIdEnv	 = delFromUFM
growIdEnv	 = plusUFM
lookupIdEnv	 = lookupUFM
mapIdEnv	 = mapUFM
mkIdEnv		 = listToUFM
nullIdEnv	 = emptyUFM
rngIdEnv	 = eltsUFM
718
unitIdEnv	 = unitUFM
719
isNullIdEnv	 = isNullUFM
720 721 722 723

growIdEnvList	  env pairs = plusUFM env (listToUFM pairs)
lookupNoFailIdEnv env id    = case (lookupIdEnv env id) of { Just xx -> xx }

724 725 726 727 728
lookupIdSubst :: IdEnv Id -> Id -> Id
lookupIdSubst env id = case lookupIdEnv env id of
			 Just id' -> id'	-- Return original if 
			 Nothing  -> id		-- it isn't in subst

729 730 731
-- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
-- modify function, and put it back.

732
modifyIdEnv mangle_fn env key
733 734 735
  = case (lookupIdEnv env key) of
      Nothing -> env
      Just xx -> addOneToIdEnv env key (mangle_fn xx)
736 737 738 739 740

modifyIdEnv_Directly mangle_fn env key
  = case (lookupUFM_Directly env key) of
      Nothing -> env
      Just xx -> addToUFM_Directly env key (mangle_fn xx)
741 742 743 744 745
\end{code}

\begin{code}
type GenIdSet ty = UniqSet (GenId ty)
type IdSet 	 = UniqSet (GenId Type)
746 747 748 749 750 751

emptyIdSet	:: GenIdSet ty
intersectIdSets	:: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
unionIdSets	:: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
unionManyIdSets	:: [GenIdSet ty] -> GenIdSet ty
idSetToList	:: GenIdSet ty -> [GenId ty]
752 753
unitIdSet	:: GenId ty -> GenIdSet ty
addOneToIdSet	:: GenIdSet ty -> GenId ty -> GenIdSet ty
754 755 756 757 758 759
elementOfIdSet	:: GenId ty -> GenIdSet ty -> Bool
minusIdSet	:: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
isEmptyIdSet	:: GenIdSet ty -> Bool
mkIdSet		:: [GenId ty] -> GenIdSet ty

emptyIdSet	= emptyUniqSet
760 761
unitIdSet	= unitUniqSet
addOneToIdSet	= addOneToUniqSet
762 763 764 765 766 767 768 769
intersectIdSets	= intersectUniqSets
unionIdSets	= unionUniqSets
unionManyIdSets	= unionManyUniqSets
idSetToList	= uniqSetToList
elementOfIdSet	= elementOfUniqSet
minusIdSet	= minusUniqSet
isEmptyIdSet	= isEmptyUniqSet
mkIdSet		= mkUniqSet
770
\end{code}