Id.lhs 14.2 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
#ifdef OLD_STRICTNESS
99
import qualified Demand	( Demand )
100
#endif
101
import DataCon		( isUnboxedTupleCon )
102
import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
sof's avatar
sof committed
103
import Name	 	( Name, OccName,
104
			  mkSystemName, mkSystemNameEncoded, mkInternalName,
105
			  getOccName, getSrcLoc
sof's avatar
sof committed
106
			) 
107
import OccName		( EncodedFS, mkWorkerOcc )
108
import PrimRep		( PrimRep )
109
import FieldLabel	( FieldLabel )
110
import Maybes		( orElse )
111
import SrcLoc		( SrcLoc )
112
import Outputable
113
import Unique		( Unique, mkBuiltinUnique )
114

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


132

133 134
%************************************************************************
%*									*
135
\subsection{Simple Id construction}
136 137 138
%*									*
%************************************************************************

139 140 141
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.
142

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

147 148
mkSpecPragmaId :: Name -> Type -> Id
mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
149 150 151

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

154
\begin{code}
155
mkLocalId :: Name -> Type -> Id
156
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
157 158 159

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

164 165
-- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again.
166 167 168 169 170
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

171
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
172
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
173
\end{code}
174 175 176 177

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

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

191
-- "Template locals" typically used in unfoldings
192
mkTemplateLocals :: [Type] -> [Id]
193
mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
194

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

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


204 205 206 207 208 209 210
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

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

215 216
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
217 218 219 220 221
\end{code}


%************************************************************************
%*									*
222
\subsection{Special Ids}
223 224 225
%*									*
%************************************************************************

226 227 228 229 230 231 232 233 234
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.
235 236


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

242
isRecordSelector id = case globalIdDetails id of
243 244
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
245

246
isPrimOpId id = case globalIdDetails id of
247 248 249
		    PrimOpId op -> True
		    other	-> False

250
isPrimOpId_maybe id = case globalIdDetails id of
251 252 253
			    PrimOpId op -> Just op
			    other	-> Nothing

254 255 256 257 258 259 260 261
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

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

262 263 264
isDataConWorkId id = case globalIdDetails id of
			DataConWorkId _ -> True
			other	        -> False
sof's avatar
sof committed
265

266 267 268
isDataConWorkId_maybe id = case globalIdDetails id of
			  DataConWorkId con -> Just con
			  other	            -> Nothing
sof's avatar
sof committed
269

270
isDataConWrapId_maybe id = case globalIdDetails id of
271 272
				  DataConWrapId con -> Just con
				  other	            -> Nothing
273

274
isDataConWrapId id = case globalIdDetails id of
275 276
			DataConWrapId con -> True
			other	          -> False
277

278 279 280 281
-- 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 
282 283
-- them at the CorePrep stage. 
-- EXCEPT: unboxed tuples, which definitely have no binding
284
hasNoBinding id = case globalIdDetails id of
285 286 287 288
			PrimOpId _  	 -> True
			FCallId _   	 -> True
			DataConWorkId dc -> isUnboxedTupleCon dc
			other	         -> False
289

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

\begin{code}
isDeadBinder :: Id -> Bool
312
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
313
		  | otherwise = False	-- TyVars count as not dead
314 315 316
\end{code}


317 318
%************************************************************************
%*									*
319
\subsection{IdInfo stuff}
320 321 322
%*									*
%************************************************************************

323
\begin{code}
324 325
	---------------------------------
	-- ARITY
326
idArity :: Id -> Arity
327
idArity id = arityInfo (idInfo id)
328

329 330
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
331

332
#ifdef OLD_STRICTNESS
333
	---------------------------------
334
	-- (OLD) STRICTNESS 
335
idStrictness :: Id -> StrictnessInfo
336
idStrictness id = strictnessInfo (idInfo id)
337

338
setIdStrictness :: Id -> StrictnessInfo -> Id
339
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
340
#endif
341

342 343
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
344 345 346 347 348 349 350 351 352 353
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
354

355 356 357
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

358
	---------------------------------
359
	-- WORKER ID
360 361
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
362 363

setIdWorkerInfo :: Id -> WorkerInfo -> Id
364
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
365

366 367
	---------------------------------
	-- UNFOLDING
368 369
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
370

371
setIdUnfolding :: Id -> Unfolding -> Id
372
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
373

374
#ifdef OLD_STRICTNESS
375
	---------------------------------
376
	-- (OLD) DEMAND
377
idDemandInfo :: Id -> Demand.Demand
378
idDemandInfo id = demandInfo (idInfo id)
379

380
setIdDemandInfo :: Id -> Demand.Demand -> Id
381
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
382
#endif
383

384 385 386 387 388
idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
idNewDemandInfo       :: Id -> NewDemand.Demand

idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
389 390

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

393 394
	---------------------------------
	-- SPECIALISATION
395 396
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
397

398 399 400
idCoreRules :: Id -> [IdCoreRule]
idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]

401 402
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
403

404 405
	---------------------------------
	-- CAF INFO
406
idCafInfo :: Id -> CafInfo
407
#ifdef OLD_STRICTNESS
408 409 410 411
idCafInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
		  info     -> cgCafInfo info
#else
412
idCafInfo id = cafInfo (idInfo id)
413
#endif
414 415 416 417

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

418 419
	---------------------------------
	-- CPR INFO
420
#ifdef OLD_STRICTNESS
421
idCprInfo :: Id -> CprInfo
422
idCprInfo id = cprInfo (idInfo id)
423 424

setIdCprInfo :: Id -> CprInfo -> Id
425
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
426
#endif
427 428 429

	---------------------------------
	-- Occcurrence INFO
430 431
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
432 433 434

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

sof's avatar
sof committed
437

438 439 440 441
	---------------------------------
	-- 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.
442 443

\begin{code}
444 445
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
446

447
setInlinePragma :: Id -> InlinePragInfo -> Id
448
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
449

450
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
451
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
452
\end{code}
453 454 455 456 457


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
458 459 460
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

461
isOneShotLambda :: Id -> Bool
462 463 464
isOneShotLambda id = case idLBVarInfo id of
                       IsOneShotLambda  -> True
                       NoLBVarInfo      -> False
465 466

setOneShotLambda :: Id -> Id
467
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
468 469 470 471 472 473 474 475 476

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
477
\end{code}
478 479 480 481 482

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

483 484
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
485