Id.lhs 13.9 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
	isBottomingId,
34 35 36 37 38
	hasNoBinding,

	-- Inline pragma stuff
	idInlinePragma, setInlinePragma, modifyInlinePragma, 

39

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

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

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

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

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

76
    ) where
77

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


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

import IdInfo 

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

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


130

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

137 138 139
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.
140

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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


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

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


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

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

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

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

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

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

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

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

269 270 271 272
-- 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 
273 274
-- them at the CorePrep stage. 
-- EXCEPT: unboxed tuples, which definitely have no binding
275
hasNoBinding id = case globalIdDetails id of
276 277 278 279
			PrimOpId _  	 -> True
			FCallId _   	 -> True
			DataConWorkId dc -> isUnboxedTupleCon dc
			other	         -> False
280

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

\begin{code}
isDeadBinder :: Id -> Bool
302
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
303
		  | otherwise = False	-- TyVars count as not dead
304 305 306
\end{code}


307 308
%************************************************************************
%*									*
309
\subsection{IdInfo stuff}
310 311 312
%*									*
%************************************************************************

313
\begin{code}
314 315
	---------------------------------
	-- ARITY
316
idArity :: Id -> Arity
317
idArity id = arityInfo (idInfo id)
318

319 320
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
321

322
#ifdef OLD_STRICTNESS
323
	---------------------------------
324
	-- (OLD) STRICTNESS 
325
idStrictness :: Id -> StrictnessInfo
326
idStrictness id = strictnessInfo (idInfo id)
327

328
setIdStrictness :: Id -> StrictnessInfo -> Id
329
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
330
#endif
331

332 333
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
334 335 336 337 338 339 340 341 342 343
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
344

345 346 347
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

348
	---------------------------------
349
	-- WORKER ID
350 351
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
352 353

setIdWorkerInfo :: Id -> WorkerInfo -> Id
354
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
355

356 357
	---------------------------------
	-- UNFOLDING
358 359
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
360

361
setIdUnfolding :: Id -> Unfolding -> Id
362
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
363

364
#ifdef OLD_STRICTNESS
365
	---------------------------------
366
	-- (OLD) DEMAND
367
idDemandInfo :: Id -> Demand.Demand
368
idDemandInfo id = demandInfo (idInfo id)
369

370
setIdDemandInfo :: Id -> Demand.Demand -> Id
371
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
372
#endif
373

374 375 376 377 378
idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
idNewDemandInfo       :: Id -> NewDemand.Demand

idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
379 380

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

383 384
	---------------------------------
	-- SPECIALISATION
385 386
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
387

388 389 390
idCoreRules :: Id -> [IdCoreRule]
idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]

391 392
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
393

394 395
	---------------------------------
	-- CAF INFO
396
idCafInfo :: Id -> CafInfo
397
#ifdef OLD_STRICTNESS
398 399 400 401
idCafInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
		  info     -> cgCafInfo info
#else
402
idCafInfo id = cafInfo (idInfo id)
403
#endif
404 405 406 407

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

408 409
	---------------------------------
	-- CPR INFO
410
#ifdef OLD_STRICTNESS
411
idCprInfo :: Id -> CprInfo
412
idCprInfo id = cprInfo (idInfo id)
413 414

setIdCprInfo :: Id -> CprInfo -> Id
415
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
416
#endif
417 418 419

	---------------------------------
	-- Occcurrence INFO
420 421
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
422 423 424

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

sof's avatar
sof committed
427

428 429 430 431
	---------------------------------
	-- 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.
432 433

\begin{code}
434 435
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
436

437
setInlinePragma :: Id -> InlinePragInfo -> Id
438
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
439

440
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
441
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
442
\end{code}
443 444 445 446 447


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
448 449 450
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

451
isOneShotLambda :: Id -> Bool
452 453 454
isOneShotLambda id = case idLBVarInfo id of
                       IsOneShotLambda  -> True
                       NoLBVarInfo      -> False
455 456

setOneShotLambda :: Id -> Id
457
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
458 459 460 461 462 463 464 465 466

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
467
\end{code}
468 469 470 471 472

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

473 474
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
475