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

	-- 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, setIdType, setIdUnique, setIdLocalExported,
87 88
			  setIdInfo, lazySetIdInfo, modifyIdInfo, 
			  maybeModifyIdInfo,
89
			  globalIdDetails, setGlobalIdDetails
90
			)
91
import qualified Var	( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
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 )
101
import Name	 	( Name, OccName, nameIsLocalOrFrom, 
102
			  mkSystemName, mkSystemNameEncoded, mkInternalName,
103
			  getOccName, getSrcLoc
sof's avatar
sof committed
104
			) 
105
import Module		( Module )
106
import OccName		( EncodedFS, mkWorkerOcc )
107
import PrimRep		( PrimRep )
108
import FieldLabel	( FieldLabel )
109
import Maybes		( orElse )
110
import SrcLoc		( SrcLoc )
111
import Outputable
112
import Unique		( Unique, mkBuiltinUnique )
113

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


131

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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


%************************************************************************
%*									*
224
\subsection{Special Ids}
225 226 227
%*									*
%************************************************************************

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


239
\begin{code}
240
recordSelectorFieldLabel :: Id -> FieldLabel
241 242
recordSelectorFieldLabel id = case globalIdDetails id of
				 RecordSelId lbl -> lbl
243
				 other -> panic "recordSelectorFieldLabel"
sof's avatar
sof committed
244

245
isRecordSelector id = case globalIdDetails id of
246 247
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
248

249
isPrimOpId id = case globalIdDetails id of
250 251 252
		    PrimOpId op -> True
		    other	-> False

253
isPrimOpId_maybe id = case globalIdDetails id of
254 255 256
			    PrimOpId op -> Just op
			    other	-> Nothing

257 258 259 260 261 262 263 264
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

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

265 266 267
isDataConWorkId id = case globalIdDetails id of
			DataConWorkId _ -> True
			other	        -> False
sof's avatar
sof committed
268

269 270 271
isDataConWorkId_maybe id = case globalIdDetails id of
			  DataConWorkId con -> Just con
			  other	            -> Nothing
sof's avatar
sof committed
272

273 274 275 276
-- 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 
277 278
-- them at the CorePrep stage. 
-- EXCEPT: unboxed tuples, which definitely have no binding
279
hasNoBinding id = case globalIdDetails id of
280 281 282 283
			PrimOpId _  	 -> True
			FCallId _   	 -> True
			DataConWorkId dc -> isUnboxedTupleCon dc
			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
	ClassOpId _	-> True
295
        DataConWorkId _ -> True
296 297
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
298
		-- remember that all type and class decls appear in the interface file.
299 300
		-- The dfun id is not an implicit Id; it must *not* be omitted, because 
		-- it carries version info for the instance decl
301
	other		-> False
302 303 304

idIsFrom :: Module -> Id -> Bool
idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
305 306 307 308
\end{code}

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


314 315
%************************************************************************
%*									*
316
\subsection{IdInfo stuff}
317 318 319
%*									*
%************************************************************************

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

326 327
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
328

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

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

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

352 353 354
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

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

setIdWorkerInfo :: Id -> WorkerInfo -> Id
361
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
362

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

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

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

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

381 382 383 384 385
idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
idNewDemandInfo       :: Id -> NewDemand.Demand

idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
386 387

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

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

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

398 399
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
400

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

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

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

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

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

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

sof's avatar
sof committed
434

435 436 437 438
	---------------------------------
	-- 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.
439 440

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

444
setInlinePragma :: Id -> InlinePragInfo -> Id
445
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
446

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


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

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

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

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
474
\end{code}
475 476 477 478 479

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

480 481
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
482