Id.lhs 15.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 12
	mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
	mkSysLocal, 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 33
	isDataConId, isDataConId_maybe, 
	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
	setIdCgInfo,
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
	idCgInfo,
70 71
	idCafInfo,
	idLBVarInfo,
72
	idOccInfo,
73

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

78
    ) where
79

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


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

import IdInfo 

99
import qualified Demand	( Demand )
100
import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
sof's avatar
sof committed
101
import Name	 	( Name, OccName,
102
			  mkSystemName, mkInternalName,
103
			  getOccName, getSrcLoc
sof's avatar
sof committed
104
			) 
105
import OccName		( EncodedFS, mkWorkerOcc )
106
import PrimRep		( PrimRep )
107
import TysPrim		( statePrimTyCon )
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

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

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

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

163 164
-- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again.
165 166
mkSysLocal  fs uniq ty      = mkLocalId (mkSystemName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
167
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
168
\end{code}
169 170 171 172

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

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

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

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

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


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

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

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


%************************************************************************
%*									*
217
\subsection{Special Ids}
218 219 220
%*									*
%************************************************************************

221 222 223 224 225 226 227 228 229
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.
230 231


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

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

241
isPrimOpId id = case globalIdDetails id of
242 243 244
		    PrimOpId op -> True
		    other	-> False

245
isPrimOpId_maybe id = case globalIdDetails id of
246 247 248
			    PrimOpId op -> Just op
			    other	-> Nothing

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

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

257
isDataConId id = case globalIdDetails id of
258 259
			DataConId _ -> True
			other	    -> False
sof's avatar
sof committed
260

261
isDataConId_maybe id = case globalIdDetails id of
262 263
			  DataConId con -> Just con
			  other	        -> Nothing
sof's avatar
sof committed
264

265
isDataConWrapId_maybe id = case globalIdDetails id of
266 267
				  DataConWrapId con -> Just con
				  other	            -> Nothing
268

269
isDataConWrapId id = case globalIdDetails id of
270 271
			DataConWrapId con -> True
			other	          -> False
272

273 274 275 276 277
-- 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.
278 279
hasNoBinding id = case globalIdDetails id of
			PrimOpId _  -> True
280
			FCallId _   -> True
281
			other	    -> False
282

283
isImplicitId :: Id -> Bool
284 285 286
	-- 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.
287
isImplicitId id
288
  = case globalIdDetails id of
289
	RecordSelId _   -> True	-- Includes dictionary selectors
290
        FCallId _       -> True
291 292 293 294
        PrimOpId _      -> True
        DataConId _     -> True
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
295 296 297
		-- 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
298
	other		-> False
299 300 301 302
\end{code}

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

395 396 397
	---------------------------------
	-- CG INFO
idCgInfo :: Id -> CgInfo
398
#ifdef OLD_STRICTNESS
399 400 401 402
idCgInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
		  info     -> info
#else
403
idCgInfo id = cgInfo (idInfo id)
404
#endif		
405 406 407 408

setIdCgInfo :: Id -> CgInfo -> Id
setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id

409 410
	---------------------------------
	-- CAF INFO
411
idCafInfo :: Id -> CafInfo
412
#ifdef OLD_STRICTNESS
413 414 415 416
idCafInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
		  info     -> cgCafInfo info
#else
417
idCafInfo id = cgCafInfo (idCgInfo id)
418
#endif
419 420
	---------------------------------
	-- CPR INFO
421
#ifdef OLD_STRICTNESS
422
idCprInfo :: Id -> CprInfo
423
idCprInfo id = cprInfo (idInfo id)
424 425

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

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

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

sof's avatar
sof committed
438

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

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

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

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


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

462
isOneShotLambda :: Id -> Bool
463 464
isOneShotLambda id = analysis || hack
  where analysis = case idLBVarInfo id of
465
                     LBVarInfo u    | u `eqUsage` usOnce      -> True
466 467 468 469 470
                     other                                    -> False
        hack     = case splitTyConApp_maybe (idType id) of
                     Just (tycon,_) | tycon == statePrimTyCon -> True
                     other                                    -> False

471 472 473 474 475 476 477 478 479 480 481
	-- The last clause is a gross hack.  It claims that 
	-- every function over realWorldStatePrimTy is a one-shot
	-- function.  This is pretty true in practice, and makes a big
	-- difference.  For example, consider
	--	a `thenST` \ r -> ...E...
	-- The early full laziness pass, if it doesn't know that r is one-shot
	-- will pull out E (let's say it doesn't mention r) to give
	--	let lvl = E in a `thenST` \ r -> ...lvl...
	-- When `thenST` gets inlined, we end up with
	--	let lvl = E in \s -> case a s of (r, s') -> ...lvl...
	-- and we don't re-inline E.
482
	--
483 484
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
485 486 487
	--
	-- Another good example is in fill_in in PrelPack.lhs.  We should be able to
	-- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
488 489

setOneShotLambda :: Id -> Id
490
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
491 492 493 494 495 496 497 498 499

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
500
\end{code}
501 502 503 504 505

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

506 507
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
508