Id.lhs 15 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
        setIdTyGenInfo,
50
	setIdWorkerInfo,
51
	setIdSpecialisation,
52
	setIdCgInfo,
53
	setIdOccInfo,
54

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

64
	idArity, 
65 66
	idNewDemandInfo,
	idNewStrictness, idNewStrictness_maybe, 
67
        idTyGenInfo,
68 69 70
	idWorkerInfo,
	idUnfolding,
	idSpecialisation,
71
	idCgInfo,
72 73
	idCafInfo,
	idLBVarInfo,
74
	idOccInfo,
75

76
#ifdef DEBUG
77
	newStrictnessFromOld 	-- Temporary
78
#endif
79

80
    ) where
81

82
#include "HsVersions.h"
sof's avatar
sof committed
83 84


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

import IdInfo 

101
import qualified Demand	( Demand )
102
import NewDemand	( Demand, StrictSig, topSig, isBottomingSig )
sof's avatar
sof committed
103
import Name	 	( Name, OccName,
104
			  mkSysLocalName, mkLocalName,
105
			  getOccName, getSrcLoc
sof's avatar
sof committed
106
			) 
107
import OccName		( UserFS, mkWorkerOcc )
108
import PrimRep		( PrimRep )
109
import TysPrim		( statePrimTyCon )
110
import FieldLabel	( FieldLabel )
111
import Maybes		( orElse )
112
import SrcLoc		( SrcLoc )
113
import Outputable
114
import Unique		( Unique, mkBuiltinUnique )
115

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


134

135 136
%************************************************************************
%*									*
137
\subsection{Simple Id construction}
138 139 140
%*									*
%************************************************************************

141 142 143
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.
144

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

149 150
mkSpecPragmaId :: Name -> Type -> Id
mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
151 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 163
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
mkSysLocal  :: UserFS  -> Unique -> Type -> Id
164
mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
165

166 167 168
mkSysLocal  fs uniq ty      = mkLocalId (mkSysLocalName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName    uniq occ loc) ty
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
169
\end{code}
170 171 172 173

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

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

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

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

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


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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

350 351 352 353 354 355 356 357
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

setIdTyGenInfo :: Id -> TyGenInfo -> Id
setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) 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 DEBUG
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 389
idNewDemandInfo :: Id -> NewDemand.Demand
idNewDemandInfo id = newDemandInfo (idInfo id)

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

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

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

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

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

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

setIdCprInfo :: Id -> CprInfo -> Id
429
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
430
#endif
431 432 433

	---------------------------------
	-- Occcurrence INFO
434 435
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
436 437 438

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

sof's avatar
sof committed
441

442 443 444 445
	---------------------------------
	-- 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.
446 447

\begin{code}
448 449
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
450

451
setInlinePragma :: Id -> InlinePragInfo -> Id
452
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
453

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


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
462 463 464
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

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

474 475 476 477 478 479 480 481 482 483 484
	-- 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.
485
	--
486 487
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
488 489 490
	--
	-- 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.
491 492

setOneShotLambda :: Id -> Id
493
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
494 495 496 497 498 499 500 501 502

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
503
\end{code}
504 505 506 507 508

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

509 510
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
511