Id.lhs 22.1 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 19
	-- Construction and modification
	mkId, mkIdWithNewUniq, mkIdWithNewName, mkIdWithNewType,
	mkTemplateLocals, 
	setIdVisibility, mkVanillaId,
20 21 22

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

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

	recordSelectorFieldLabel,
39 40

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

	isRecordSelector, isSpecPragmaId,
53
	isPrimitiveId_maybe,
54

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

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

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

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

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

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

data StrictnessMark = MarkedStrict | NotMarkedStrict
166 167 168 169 170

data IdDetails

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

171
  = VanillaId	Bool		-- Ordinary Id
172
				-- True <=> no free type vars
173

174
  | PrimitiveId PrimOp		-- The Id for a primitive operation
175
                                
176 177 178

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

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

186 187
		[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
188 189
					-- the existentially quantified stuff
		[Type] TyCon		-- Args and result tycon
190
				-- the type is:
sof's avatar
sof committed
191
				-- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
192
				--    unitype_1 -> ... -> unitype_n -> tycon tyvars
193

194
  | TupleConId	Int		-- Its arity
195

196
  | RecordSelId FieldLabel
197

198 199 200 201 202 203 204 205 206
  | 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.
207

208 209 210 211 212 213


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


%************************************************************************
%*									*
219
\subsection{Construction}
220 221 222
%*									*
%************************************************************************

223 224 225 226 227 228 229 230 231 232 233 234 235
\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
236
mkIdWithNewUniq id uniq = id {idUnique = uniq, idName = changeUnique (idName id) uniq}
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253

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
254
  = zipWith3 mk (getBuiltinUniques (length tys)) tys [1..]
255
  where
256 257
    mk uniq ty n = mkVanillaId (mkSysLocalName uniq (_PK_ ("x"++show n)) mkBuiltinSrcLoc)
			       ty noIdInfo
258 259 260 261 262 263 264 265 266 267 268 269
\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)}

replaceIdInfo :: GenId ty -> IdInfo -> GenId ty
replaceIdInfo id info = id {idInfo = info}
\end{code}
270 271 272 273 274 275 276 277

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

\begin{code}
278 279 280
fIRST_TAG :: ConTag
fIRST_TAG =  1	-- Tags allocated from here for real constructors

sof's avatar
sof committed
281
-- isDataCon returns False for @newtype@ constructors
282 283 284
isDataCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isDataTyCon tc
isDataCon (Id {idDetails = TupleConId _})		 = True
isDataCon other					         = False
sof's avatar
sof committed
285

286 287
isNewCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isNewTyCon tc
isNewCon other					        = False
sof's avatar
sof committed
288 289

-- isAlgCon returns True for @data@ or @newtype@ constructors
290 291 292
isAlgCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ _}) = True
isAlgCon (Id {idDetails = TupleConId _})	       = True
isAlgCon other					       = False
293

294 295
isTupleCon (Id {idDetails = TupleConId _}) = True
isTupleCon other			   = False
296 297 298
\end{code}

\begin{code}
299
idHasNoFreeTyVars :: Id -> Bool
300

301
idHasNoFreeTyVars (Id {idDetails = details})
302 303
  = chk details
  where
sof's avatar
sof committed
304
    chk (AlgConId _ _ _ _ _ _ _ _ _) = True
305 306 307 308 309
    chk (TupleConId _)    	   = True
    chk (RecordSelId _)   	   = True
    chk (VanillaId    no_free_tvs) = no_free_tvs
    chk (PrimitiveId _)		   = True
    chk SpecPragmaId		   = False	-- Play safe
310

311 312 313 314 315 316
-- 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
317 318
	-> Bool

319
omitIfaceSigForId (Id {idName = name, idDetails = details})
320 321 322 323 324 325
  | isWiredInName name
  = True

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

	-- This group is Ids that are implied by their type or class decl;
328 329 330
	-- 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
331
        (AlgConId _ _ _ _ _ _ _ _ _) -> True
332 333
        (TupleConId _)    	     -> True
        (RecordSelId _)   	     -> True
334

335
	other			     -> False	-- Don't omit!
336
		-- NB DefaultMethodIds are not omitted
337 338 339
\end{code}

\begin{code}
340
isBottomingId id = bottomIsGuaranteed (strictnessInfo (idInfo id))
341

342 343
isPrimitiveId_maybe (Id {idDetails = PrimitiveId primop}) = Just primop
isPrimitiveId_maybe other				  = Nothing
344

345 346
isSpecPragmaId (Id {idDetails = SpecPragmaId}) = True
isSpecPragmaId _			       = False
347 348 349
\end{code}

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

353 354
In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
local-ness precisely so that the test here would be easy
355 356 357

\begin{code}
externallyVisibleId :: Id -> Bool
358
externallyVisibleId id = not (isLocalName (idName id))
359
		     -- not local => global => externally visible
360 361 362 363
\end{code}


\begin{code}
364
idPrimRep id = typePrimRep (idType id)
365 366 367 368 369 370 371 372 373 374 375 376 377 378
\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}
379
getIdArity :: Id -> ArityInfo
380
getIdArity id = arityInfo (idInfo id)
381

382
addIdArity :: Id -> ArityInfo -> Id
383 384
addIdArity id@(Id {idInfo = info}) arity
  = id {idInfo = arity `setArityInfo` info}
385
\end{code}
sof's avatar
sof committed
386

387 388 389 390 391 392 393
%************************************************************************
%*									*
\subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
%*									*
%************************************************************************


sof's avatar
sof committed
394 395 396 397 398 399 400
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
401 402
  = ASSERT( if (isDataCon id) then True else
	    pprTrace "dataConNumFields" (ppr id) False )
sof's avatar
sof committed
403 404 405 406
    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
407

sof's avatar
sof committed
408 409 410
\end{code}


411
\begin{code}
412
dataConTag :: DataCon -> ConTag	-- will panic if not a DataCon
413 414
dataConTag (Id {idDetails = AlgConId tag _ _ _ _ _ _ _ _}) = tag
dataConTag (Id {idDetails = TupleConId _})	           = fIRST_TAG
415

416
dataConTyCon :: DataCon -> TyCon	-- will panic if not a DataCon
417 418
dataConTyCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tycon}) = tycon
dataConTyCon (Id {idDetails = TupleConId a})	 	       = tupleTyCon a
419

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

423
dataConSig (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
sof's avatar
sof committed
424
  = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
425

426
dataConSig (Id {idDetails = TupleConId arity})
sof's avatar
sof committed
427
  = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
428 429
  where
    tyvars	= take arity alphaTyVars
430
    tyvar_tys	= mkTyVarTys tyvars
431

432 433 434 435

-- 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
436 437
--	   e.g.    data Eq a => T a = MkT a a
--
438
--	b) the constructor may store an unboxed version of a strict field.
439
--
440 441 442 443 444 445 446 447
-- 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!

448
dataConRepType :: Id -> Type
449
dataConRepType (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
450 451 452 453 454
  = mkForAllTys (tyvars++con_tyvars) 
		(mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
dataConRepType other_id
  = ASSERT( isDataCon other_id )
    idType other_id
455

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

dataConStrictMarks :: DataCon -> [StrictnessMark]
469 470
dataConStrictMarks (Id {idDetails = AlgConId _ stricts _ _ _ _ _ _ _}) = stricts
dataConStrictMarks (Id {idDetails = TupleConId arity})		       = nOfThem arity NotMarkedStrict
471

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

475 476 477 478 479 480
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
481
    (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
482
    tenv 		          = zipTyVarEnv tyvars inst_tys
483 484 485 486
\end{code}

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

489 490
isRecordSelector (Id {idDetails = RecordSelId lbl}) = True
isRecordSelector other				    = False
491 492
\end{code}

493 494 495 496 497 498 499

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

500 501
\begin{code}
getIdUnfolding :: Id -> Unfolding
502

503
getIdUnfolding id = unfoldingInfo (idInfo id)
504

505
addIdUnfolding :: Id -> Unfolding -> Id
506 507
addIdUnfolding id@(Id {idInfo = info}) unfolding
  = id {idInfo = unfolding `setUnfoldingInfo` info}
508 509 510 511
\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.
512 513

\begin{code}
514 515
getInlinePragma :: Id -> InlinePragInfo
getInlinePragma id = inlinePragInfo (idInfo id)
sof's avatar
sof committed
516

517
idWantsToBeINLINEd :: Id -> Bool
518

519 520 521 522
idWantsToBeINLINEd id = case getInlinePragma id of
			  IWantToBeINLINEd -> True
			  IMustBeINLINEd   -> True
			  other		   -> False
523

524 525 526
idMustNotBeINLINEd id = case getInlinePragma id of
			  IMustNotBeINLINEd -> True
			  other		    -> False
sof's avatar
sof committed
527

528 529 530
idMustBeINLINEd id =  case getInlinePragma id of
			IMustBeINLINEd -> True
			other	       -> False
sof's avatar
sof committed
531

532
addInlinePragma :: Id -> Id
533 534
addInlinePragma id@(Id {idInfo = info})
  = id {idInfo = setInlinePragInfo IWantToBeINLINEd info}
535

sof's avatar
sof committed
536
nukeNoInlinePragma :: Id -> Id
537 538 539 540
nukeNoInlinePragma id@(Id {idInfo = info})
  = case inlinePragInfo info of
	IMustNotBeINLINEd -> id {idInfo = setInlinePragInfo NoPragmaInfo info}
	other		  -> id
541

sof's avatar
sof committed
542
addNoInlinePragma :: Id -> Id
543 544 545 546 547
addNoInlinePragma id@(Id {idInfo = info})
  = id {idInfo = IMustNotBeINLINEd `setInlinePragInfo` info}

mustInlineInfo   = IMustBeINLINEd   `setInlinePragInfo` noIdInfo
wantToInlineInfo = IWantToBeINLINEd `setInlinePragInfo` noIdInfo
548 549
\end{code}

550

sof's avatar
sof committed
551

552 553 554 555 556 557 558 559
%************************************************************************
%*									*
\subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
%*									*
%************************************************************************

\begin{code}
getIdDemandInfo :: Id -> DemandInfo
560
getIdDemandInfo id = demandInfo (idInfo id)
561 562

addIdDemandInfo :: Id -> DemandInfo -> Id
563 564
addIdDemandInfo id@(Id {idInfo = info}) demand_info
  = id {idInfo = demand_info `setDemandInfo` info}
565
\end{code}p
566 567 568

\begin{code}
getIdUpdateInfo :: Id -> UpdateInfo
569
getIdUpdateInfo id = updateInfo (idInfo id)
570 571

addIdUpdateInfo :: Id -> UpdateInfo -> Id
572 573
addIdUpdateInfo id@(Id {idInfo = info}) upd_info
  = id {idInfo = upd_info `setUpdateInfo` info}
574 575 576
\end{code}

\begin{code}
577
getIdSpecialisation :: Id -> IdSpecEnv
578
getIdSpecialisation id = specInfo (idInfo id)
579

580
setIdSpecialisation :: Id -> IdSpecEnv -> Id
581 582
setIdSpecialisation id@(Id {idInfo = info}) spec_info
  = id {idInfo = spec_info `setSpecInfo` info}
583 584 585
\end{code}

\begin{code}
sof's avatar
sof committed
586
getIdStrictness :: Id -> StrictnessInfo
587
getIdStrictness id = strictnessInfo (idInfo id)
588

sof's avatar
sof committed
589
addIdStrictness :: Id -> StrictnessInfo -> Id
590 591
addIdStrictness id@(Id {idInfo = info}) strict_info
  = id {idInfo = strict_info `setStrictnessInfo` info}
592 593 594 595 596 597 598 599 600 601 602
\end{code}

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

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

\begin{code}
603
cmpId (Id {idUnique = u1}) (Id {idUnique = u2}) = compare u1 u2
604 605 606
\end{code}

\begin{code}
607
instance Eq (GenId ty) where
608 609
    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
610

611
instance Ord (GenId ty) where
612 613 614 615 616
    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
617 618 619 620 621 622 623 624 625
\end{code}

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

\begin{code}
626
instance Outputable ty => Outputable (GenId ty) where
627
    ppr id = pprId id
628

629 630
showId :: Id -> String
showId id = showSDoc (pprId id)
631 632 633 634
\end{code}

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

637
pprId Id {idUnique = u, idName = n, idInfo = info}
638
  = hcat [ppr n, pp_prags]
sof's avatar
sof committed
639
  where
sof's avatar
sof committed
640 641 642 643 644 645 646 647 648 649 650
    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

651 652 653
\end{code}

\begin{code}
654 655 656
instance Uniquable (GenId ty) where
    uniqueOf = idUnique

657
instance NamedThing (GenId ty) where
658
    getName = idName
659 660
\end{code}

661 662
Note: The code generator doesn't carry a @UniqueSupply@, so it uses
the @Uniques@ out of local @Ids@ given to it.
663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684

%************************************************************************
%*									*
\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
685
modifyIdEnv	  :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
686 687 688 689 690
rngIdEnv	  :: IdEnv a -> [a]
		  
isNullIdEnv	  :: IdEnv a -> Bool
lookupIdEnv	  :: IdEnv a -> GenId ty -> Maybe a
lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
691
elemIdEnv	  :: Id -> IdEnv a -> Bool
692 693 694
\end{code}

\begin{code}
695
elemIdEnv        = elemUFM
696 697 698 699 700 701 702 703 704 705
addOneToIdEnv	 = addToUFM
combineIdEnvs	 = plusUFM_C
delManyFromIdEnv = delListFromUFM
delOneFromIdEnv	 = delFromUFM
growIdEnv	 = plusUFM
lookupIdEnv	 = lookupUFM
mapIdEnv	 = mapUFM
mkIdEnv		 = listToUFM
nullIdEnv	 = emptyUFM
rngIdEnv	 = eltsUFM
706
unitIdEnv	 = unitUFM
707
isNullIdEnv	 = isNullUFM
708 709 710 711

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

712 713 714 715 716
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

717 718 719
-- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
-- modify function, and put it back.

720
modifyIdEnv mangle_fn env key
721 722 723
  = case (lookupIdEnv env key) of
      Nothing -> env
      Just xx -> addOneToIdEnv env key (mangle_fn xx)
724 725 726 727 728

modifyIdEnv_Directly mangle_fn env key
  = case (lookupUFM_Directly env key) of
      Nothing -> env
      Just xx -> addToUFM_Directly env key (mangle_fn xx)
729 730 731 732 733
\end{code}

\begin{code}
type GenIdSet ty = UniqSet (GenId ty)
type IdSet 	 = UniqSet (GenId Type)
734 735 736 737 738 739

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]
740 741
unitIdSet	:: GenId ty -> GenIdSet ty
addOneToIdSet	:: GenIdSet ty -> GenId ty -> GenIdSet ty
742 743 744 745 746 747
elementOfIdSet	:: GenId ty -> GenIdSet ty -> Bool
minusIdSet	:: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
isEmptyIdSet	:: GenIdSet ty -> Bool
mkIdSet		:: [GenId ty] -> GenIdSet ty

emptyIdSet	= emptyUniqSet
748 749
unitIdSet	= unitUniqSet
addOneToIdSet	= addOneToUniqSet
750 751 752 753 754 755 756 757
intersectIdSets	= intersectUniqSets
unionIdSets	= unionUniqSets
unionManyIdSets	= unionManyUniqSets
idSetToList	= uniqSetToList
elementOfIdSet	= elementOfUniqSet
minusIdSet	= minusUniqSet
isEmptyIdSet	= isEmptyUniqSet
mkIdSet		= mkUniqSet
758
\end{code}