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

\begin{code}
7
module Id (
8
	Id, DictId,
9

10
	-- Simple construction
11
	mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
12
	mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
13
	mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
14
	mkWorkerId,
15 16

	-- Taking an Id apart
17
	idName, idType, idUnique, idInfo,
18
	idPrimRep, isId, globalIdDetails,
19
	recordSelectorFieldLabel,
20

21
	-- Modifying an Id
22
	setIdName, setIdUnique, setIdType, setIdLocalExported, setGlobalIdDetails,
23
	setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
24
	zapLamIdInfo, zapDemandIdInfo, 
25 26

	-- Predicates
27
	isImplicitId, isDeadBinder,
28 29 30
	isSpecPragmaId,	isExportedId, isLocalId, isGlobalId,
	isRecordSelector,
	isPrimOpId, isPrimOpId_maybe, 
31
	isFCallId, isFCallId_maybe,
32
	isDataConWorkId, isDataConWorkId_maybe, 
33
	isDataConWrapId, isDataConWrapId_maybe,
34
	isBottomingId,
35 36 37 38 39
	hasNoBinding,

	-- Inline pragma stuff
	idInlinePragma, setInlinePragma, modifyInlinePragma, 

40

41
	-- One shot lambda stuff
42
	isOneShotLambda, setOneShotLambda, clearOneShotLambda,
43

44 45
	-- IdInfo stuff
	setIdUnfolding,
46
	setIdArity,
47 48
	setIdNewDemandInfo, 
	setIdNewStrictness, zapIdNewStrictness,
49
	setIdWorkerInfo,
50
	setIdSpecialisation,
51
	setIdCafInfo,
52
	setIdOccInfo,
53

54
#ifdef OLD_STRICTNESS
55 56 57 58 59 60 61 62
	idDemandInfo, 
	idStrictness, 
	idCprInfo,
	setIdStrictness, 
	setIdDemandInfo, 
	setIdCprInfo,
#endif

63
	idArity, 
64
	idNewDemandInfo, idNewDemandInfo_maybe,
65
	idNewStrictness, idNewStrictness_maybe, 
66 67
	idWorkerInfo,
	idUnfolding,
68
	idSpecialisation, idCoreRules,
69 70
	idCafInfo,
	idLBVarInfo,
71
	idOccInfo,
72

73
#ifdef OLD_STRICTNESS
74
	newStrictnessFromOld 	-- Temporary
75
#endif
76

77
    ) where
78

79
#include "HsVersions.h"
sof's avatar
sof committed
80 81


82
import CoreSyn		( Unfolding, CoreRules, IdCoreRule, rulesRules )
83
import BasicTypes	( Arity )
84
import Var		( Id, DictId,
85 86
			  isId, isExportedId, isSpecPragmaId, isLocalId,
			  idName, idType, idUnique, idInfo, isGlobalId,
87
			  setIdName, setVarType, setIdUnique, setIdLocalExported,
88 89
			  setIdInfo, lazySetIdInfo, modifyIdInfo, 
			  maybeModifyIdInfo,
90
			  globalIdDetails, setGlobalIdDetails
91
			)
92
import qualified Var	( mkLocalId, mkGlobalId, mkSpecPragmaId )
93
import Type		( Type, typePrimRep, addFreeTyVars, 
94
                          seqType, splitTyConApp_maybe )
95 96 97

import IdInfo 

98
import qualified Demand	( Demand )
99
import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
sof's avatar
sof committed
100
import Name	 	( Name, OccName,
101
			  mkSystemName, mkSystemNameEncoded, mkInternalName,
102
			  getOccName, getSrcLoc
sof's avatar
sof committed
103
			) 
104
import OccName		( EncodedFS, mkWorkerOcc )
105
import PrimRep		( PrimRep )
106
import FieldLabel	( FieldLabel )
107
import Maybes		( orElse )
108
import SrcLoc		( SrcLoc )
109
import Outputable
110
import Unique		( Unique, mkBuiltinUnique )
111

112
-- infixl so you can say (id `set` a `set` b)
113
infixl 	1 `setIdUnfolding`,
114
	  `setIdArity`,
115 116
	  `setIdNewDemandInfo`,
	  `setIdNewStrictness`,
117
	  `setIdWorkerInfo`,
118
	  `setIdSpecialisation`,
119
	  `setInlinePragma`,
120
	  `idCafInfo`
121
#ifdef OLD_STRICTNESS
122 123 124 125
	  ,`idCprInfo`
	  ,`setIdStrictness`
	  ,`setIdDemandInfo`
#endif
126 127 128
\end{code}


129

130 131
%************************************************************************
%*									*
132
\subsection{Simple Id construction}
133 134 135
%*									*
%************************************************************************

136 137 138
Absolutely all Ids are made by mkId.  It is just like Var.mkId,
but in addition it pins free-tyvar-info onto the Id's type, 
where it can easily be found.
139

140
\begin{code}
141 142 143
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info

144 145
mkSpecPragmaId :: Name -> Type -> Id
mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
146 147 148

mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
149
\end{code}
150

151
\begin{code}
152
mkLocalId :: Name -> Type -> Id
153
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
154 155 156

-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
157
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
158
mkSysLocal  :: EncodedFS  -> Unique -> Type -> Id
159
mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
160

161 162
-- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again.
163 164 165 166 167
mkSysLocal          fs uniq ty = mkLocalId (mkSystemNameEncoded uniq fs) ty

-- version to use when the faststring needs to be encoded
mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemName uniq fs)        ty

168
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
169
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
170
\end{code}
171 172 173 174

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.
175
 
176
\begin{code}
177 178
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
179
mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
180

181
mkWorkerId :: Unique -> Id -> Type -> Id
182
-- A worker gets a local name.  CoreTidy will externalise it if necessary.
183 184 185
mkWorkerId uniq unwrkr ty
  = mkLocalId wkr_name ty
  where
186
    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
187

188
-- "Template locals" typically used in unfoldings
189
mkTemplateLocals :: [Type] -> [Id]
190
mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
191

192
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
193
-- The Int gives the starting point for unique allocation
194
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
195

196
mkTemplateLocal :: Int -> Type -> Id
197
mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
198 199 200
\end{code}


201 202 203 204 205 206 207
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

\begin{code}
208
setIdType :: Id -> Type -> Id
209
	-- Add free tyvar info to the type
210
setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
sof's avatar
sof committed
211

212 213
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
214 215 216 217 218
\end{code}


%************************************************************************
%*									*
219
\subsection{Special Ids}
220 221 222
%*									*
%************************************************************************

223 224 225 226 227 228 229 230 231
The @SpecPragmaId@ 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.
232 233


234
\begin{code}
235
recordSelectorFieldLabel :: Id -> FieldLabel
236 237
recordSelectorFieldLabel id = case globalIdDetails id of
				 RecordSelId lbl -> lbl
sof's avatar
sof committed
238

239
isRecordSelector id = case globalIdDetails id of
240 241
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
242

243
isPrimOpId id = case globalIdDetails id of
244 245 246
		    PrimOpId op -> True
		    other	-> False

247
isPrimOpId_maybe id = case globalIdDetails id of
248 249 250
			    PrimOpId op -> Just op
			    other	-> Nothing

251 252 253 254 255 256 257 258
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

isFCallId_maybe id = case globalIdDetails id of
			    FCallId call -> Just call
			    other	 -> Nothing

259 260 261
isDataConWorkId id = case globalIdDetails id of
			DataConWorkId _ -> True
			other	        -> False
sof's avatar
sof committed
262

263 264 265
isDataConWorkId_maybe id = case globalIdDetails id of
			  DataConWorkId con -> Just con
			  other	            -> Nothing
sof's avatar
sof committed
266

267
isDataConWrapId_maybe id = case globalIdDetails id of
268 269
				  DataConWrapId con -> Just con
				  other	            -> Nothing
270

271
isDataConWrapId id = case globalIdDetails id of
272 273
			DataConWrapId con -> True
			other	          -> False
274

275 276 277 278 279
-- hasNoBinding returns True of an Id which may not have a
-- binding, even though it is defined in this module.  
-- Data constructor workers used to be things of this kind, but
-- they aren't any more.  Instead, we inject a binding for 
-- them at the CorePrep stage.
280 281
hasNoBinding id = case globalIdDetails id of
			PrimOpId _  -> True
282
			FCallId _   -> True
283
			other	    -> False
284

285
isImplicitId :: Id -> Bool
286 287 288
	-- isImplicitId 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.
289
isImplicitId id
290
  = case globalIdDetails id of
291
	RecordSelId _   -> True
292
        FCallId _       -> True
293
        PrimOpId _      -> True
294 295
	ClassOpId _	-> True
	GenericOpId _	-> True
296
        DataConWorkId _ -> True
297 298
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
299
		-- remember that all type and class decls appear in the interface file.
300 301
		-- The dfun id is not an implicit Id; it must *not* be omitted, because 
		-- it carries version info for the instance decl
302
	other		-> False
303 304 305 306
\end{code}

\begin{code}
isDeadBinder :: Id -> Bool
307
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
308
		  | otherwise = False	-- TyVars count as not dead
309 310 311
\end{code}


312 313
%************************************************************************
%*									*
314
\subsection{IdInfo stuff}
315 316 317
%*									*
%************************************************************************

318
\begin{code}
319 320
	---------------------------------
	-- ARITY
321
idArity :: Id -> Arity
322
idArity id = arityInfo (idInfo id)
323

324 325
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
326

327
#ifdef OLD_STRICTNESS
328
	---------------------------------
329
	-- (OLD) STRICTNESS 
330
idStrictness :: Id -> StrictnessInfo
331
idStrictness id = strictnessInfo (idInfo id)
332

333
setIdStrictness :: Id -> StrictnessInfo -> Id
334
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
335
#endif
336

337 338
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
339 340 341 342 343 344 345 346 347 348
isBottomingId id = isBottomingSig (idNewStrictness id)

idNewStrictness_maybe :: Id -> Maybe StrictSig
idNewStrictness :: Id -> StrictSig

idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig

setIdNewStrictness :: Id -> StrictSig -> Id
setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
349

350 351 352
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

353
	---------------------------------
354
	-- WORKER ID
355 356
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
357 358

setIdWorkerInfo :: Id -> WorkerInfo -> Id
359
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
360

361 362
	---------------------------------
	-- UNFOLDING
363 364
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
365

366
setIdUnfolding :: Id -> Unfolding -> Id
367
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
368

369
#ifdef OLD_STRICTNESS
370
	---------------------------------
371
	-- (OLD) DEMAND
372
idDemandInfo :: Id -> Demand.Demand
373
idDemandInfo id = demandInfo (idInfo id)
374

375
setIdDemandInfo :: Id -> Demand.Demand -> Id
376
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
377
#endif
378

379 380 381 382 383
idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
idNewDemandInfo       :: Id -> NewDemand.Demand

idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
384 385

setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
386
setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
387

388 389
	---------------------------------
	-- SPECIALISATION
390 391
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
392

393 394 395
idCoreRules :: Id -> [IdCoreRule]
idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]

396 397
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
398

399 400
	---------------------------------
	-- CAF INFO
401
idCafInfo :: Id -> CafInfo
402
#ifdef OLD_STRICTNESS
403 404 405 406
idCafInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
		  info     -> cgCafInfo info
#else
407
idCafInfo id = cafInfo (idInfo id)
408
#endif
409 410 411 412

setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id

413 414
	---------------------------------
	-- CPR INFO
415
#ifdef OLD_STRICTNESS
416
idCprInfo :: Id -> CprInfo
417
idCprInfo id = cprInfo (idInfo id)
418 419

setIdCprInfo :: Id -> CprInfo -> Id
420
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
421
#endif
422 423 424

	---------------------------------
	-- Occcurrence INFO
425 426
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
427 428 429

setIdOccInfo :: Id -> OccInfo -> Id
setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
430 431
\end{code}

sof's avatar
sof committed
432

433 434 435 436
	---------------------------------
	-- INLINING
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.
437 438

\begin{code}
439 440
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
441

442
setInlinePragma :: Id -> InlinePragInfo -> Id
443
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
444

445
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
446
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
447
\end{code}
448 449 450 451 452


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
453 454 455
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

456
isOneShotLambda :: Id -> Bool
457 458 459
isOneShotLambda id = case idLBVarInfo id of
                       IsOneShotLambda  -> True
                       NoLBVarInfo      -> False
460 461

setOneShotLambda :: Id -> Id
462
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
463 464 465 466 467 468 469 470 471

clearOneShotLambda :: Id -> Id
clearOneShotLambda id 
  | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
  | otherwise	       = id			

-- But watch out: this may change the type of something else
--	f = \x -> e
-- If we change the one-shot-ness of x, f's type changes
472
\end{code}
473 474 475 476 477

\begin{code}
zapLamIdInfo :: Id -> Id
zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id

478 479
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
480