Id.lhs 14 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, setIdNoDiscard, 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
	setIdArityInfo,
47 48
	setIdDemandInfo,
	setIdStrictness,
49
        setIdTyGenInfo,
50
	setIdWorkerInfo,
51
	setIdSpecialisation,
52
	setIdCgInfo,
53
	setIdCprInfo,
54
	setIdOccInfo,
55

56 57 58
	idArity, idArityInfo, 
	idDemandInfo,
	idStrictness,
59
        idTyGenInfo,
60 61 62
	idWorkerInfo,
	idUnfolding,
	idSpecialisation,
63
	idCgInfo,
64
	idCafInfo,
65
	idCgArity,
66 67
	idCprInfo,
	idLBVarInfo,
68
	idOccInfo,
69

70
    ) where
71

72
#include "HsVersions.h"
sof's avatar
sof committed
73 74


75
import CoreSyn		( Unfolding, CoreRules )
76
import BasicTypes	( Arity )
77
import Var		( Id, DictId,
78 79 80
			  isId, isExportedId, isSpecPragmaId, isLocalId,
			  idName, idType, idUnique, idInfo, isGlobalId,
			  setIdName, setVarType, setIdUnique, setIdNoDiscard,
81 82
			  setIdInfo, lazySetIdInfo, modifyIdInfo, 
			  maybeModifyIdInfo,
83
			  globalIdDetails, setGlobalIdDetails
84
			)
85
import qualified Var	( mkLocalId, mkGlobalId, mkSpecPragmaId )
86
import Type		( Type, typePrimRep, addFreeTyVars, 
87
                          usOnce, eqUsage, seqType, splitTyConApp_maybe )
88 89 90

import IdInfo 

91
import Demand		( Demand )
sof's avatar
sof committed
92
import Name	 	( Name, OccName,
93
			  mkSysLocalName, mkLocalName,
94
			  getOccName, getSrcLoc
sof's avatar
sof committed
95
			) 
96
import OccName		( UserFS, mkWorkerOcc )
97
import PrimRep		( PrimRep )
98
import TysPrim		( statePrimTyCon )
99
import FieldLabel	( FieldLabel )
100
import SrcLoc		( SrcLoc )
101
import Outputable
102
import Unique		( Unique, mkBuiltinUnique )
103

104
infixl 	1 `setIdUnfolding`,
105
	  `setIdArityInfo`,
106 107
	  `setIdDemandInfo`,
	  `setIdStrictness`,
108
	  `setIdTyGenInfo`,
109
	  `setIdWorkerInfo`,
110
	  `setIdSpecialisation`,
111
	  `setInlinePragma`,
112 113
	  `idCafInfo`,
	  `idCprInfo`
114

115
	-- infixl so you can say (id `set` a `set` b)
116 117 118
\end{code}


119

120 121
%************************************************************************
%*									*
122
\subsection{Simple Id construction}
123 124 125
%*									*
%************************************************************************

126 127 128
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.
129

130
\begin{code}
131 132 133 134 135 136
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info

mkSpecPragmaId :: OccName -> Unique -> Type -> SrcLoc -> Id
mkSpecPragmaId occ uniq ty loc = Var.mkSpecPragmaId (mkLocalName uniq occ loc)
						    (addFreeTyVars ty)
137
						    vanillaIdInfo
138 139 140

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

143
\begin{code}
144
mkLocalId :: Name -> Type -> Id
145
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
146 147 148

-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
149 150
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
mkSysLocal  :: UserFS  -> Unique -> Type -> Id
151
mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
152

153 154 155
mkSysLocal  fs uniq ty      = mkLocalId (mkSysLocalName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName    uniq occ loc) ty
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
156
\end{code}
157 158 159 160

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.
161
 
162
\begin{code}
163 164
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
165
mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
166

167 168 169 170 171 172 173
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)

174
-- "Template locals" typically used in unfoldings
175
mkTemplateLocals :: [Type] -> [Id]
176
mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
177

178
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
179
-- The Int gives the starting point for unique allocation
180
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
181

182 183
mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
184 185 186
\end{code}


187 188 189 190 191 192 193
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

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

198 199
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
200 201 202 203 204
\end{code}


%************************************************************************
%*									*
205
\subsection{Special Ids}
206 207 208
%*									*
%************************************************************************

209 210 211 212 213 214 215 216 217
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.
218 219


220
\begin{code}
221
recordSelectorFieldLabel :: Id -> FieldLabel
222 223
recordSelectorFieldLabel id = case globalIdDetails id of
				 RecordSelId lbl -> lbl
sof's avatar
sof committed
224

225
isRecordSelector id = case globalIdDetails id of
226 227
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
228

229
isPrimOpId id = case globalIdDetails id of
230 231 232
		    PrimOpId op -> True
		    other	-> False

233
isPrimOpId_maybe id = case globalIdDetails id of
234 235 236
			    PrimOpId op -> Just op
			    other	-> Nothing

237 238 239 240 241 242 243 244
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

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

245
isDataConId id = case globalIdDetails id of
246 247
			DataConId _ -> True
			other	    -> False
sof's avatar
sof committed
248

249
isDataConId_maybe id = case globalIdDetails id of
250 251
			  DataConId con -> Just con
			  other	        -> Nothing
sof's avatar
sof committed
252

253
isDataConWrapId_maybe id = case globalIdDetails id of
254 255
				  DataConWrapId con -> Just con
				  other	            -> Nothing
256

257
isDataConWrapId id = case globalIdDetails id of
258 259
			DataConWrapId con -> True
			other	          -> False
260

261
	-- hasNoBinding returns True of an Id which may not have a
262 263
	-- binding, even though it is defined in this module.  Notably,
	-- the constructors of a dictionary are in this situation.
264 265 266
hasNoBinding id = case globalIdDetails id of
			DataConId _ -> True
			PrimOpId _  -> True
267
			FCallId _   -> True
268
			other	    -> False
269

270
isImplicitId :: Id -> Bool
271 272 273
	-- 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.
274
isImplicitId id
275
  = case globalIdDetails id of
276
	RecordSelId _   -> True	-- Includes dictionary selectors
277
        FCallId _       -> True
278 279 280 281
        PrimOpId _      -> True
        DataConId _     -> True
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
282 283 284
		-- 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
285
	other		-> False
286 287 288 289
\end{code}

\begin{code}
isDeadBinder :: Id -> Bool
290
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
291
		  | otherwise = False	-- TyVars count as not dead
292 293 294
\end{code}


295 296
%************************************************************************
%*									*
297
\subsection{IdInfo stuff}
298 299 300
%*									*
%************************************************************************

301
\begin{code}
302 303
	---------------------------------
	-- ARITY
304 305 306 307 308
idArityInfo :: Id -> ArityInfo
idArityInfo id = arityInfo (idInfo id)

idArity :: Id -> Arity
idArity id = arityLowerBound (idArityInfo id)
309

310
setIdArityInfo :: Id -> Arity -> Id
311
setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
312

313 314
	---------------------------------
	-- STRICTNESS
315 316
idStrictness :: Id -> StrictnessInfo
idStrictness id = strictnessInfo (idInfo id)
317

318
setIdStrictness :: Id -> StrictnessInfo -> Id
319
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
320

321 322
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
323
isBottomingId id = isBottomingStrictness (idStrictness id)
324

325 326 327 328 329 330 331 332
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

setIdTyGenInfo :: Id -> TyGenInfo -> Id
setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id

333 334
	---------------------------------
	-- WORKER ID
335 336
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
337 338

setIdWorkerInfo :: Id -> WorkerInfo -> Id
339
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
340

341 342
	---------------------------------
	-- UNFOLDING
343 344
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
345

346
setIdUnfolding :: Id -> Unfolding -> Id
347
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
348

349 350
	---------------------------------
	-- DEMAND
351 352
idDemandInfo :: Id -> Demand
idDemandInfo id = demandInfo (idInfo id)
353

354
setIdDemandInfo :: Id -> Demand -> Id
355
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
356

357 358
	---------------------------------
	-- SPECIALISATION
359 360
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
361

362 363
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
364

365 366 367
	---------------------------------
	-- CG INFO
idCgInfo :: Id -> CgInfo
368 369 370 371 372
#ifdef DEBUG
idCgInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
		  info     -> info
#else
373
idCgInfo id = cgInfo (idInfo id)
374
#endif		
375 376 377 378

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

379 380
	---------------------------------
	-- CAF INFO
381
idCafInfo :: Id -> CafInfo
382 383 384 385
idCafInfo id = cgCafInfo (idCgInfo id)

	---------------------------------
	-- CG ARITY
386

387 388
idCgArity :: Id -> Arity
idCgArity id = cgArity (idCgInfo id)
389 390 391

	---------------------------------
	-- CPR INFO
392 393
idCprInfo :: Id -> CprInfo
idCprInfo id = cprInfo (idInfo id)
394 395

setIdCprInfo :: Id -> CprInfo -> Id
396
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
397 398 399

	---------------------------------
	-- Occcurrence INFO
400 401
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
402 403 404

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

sof's avatar
sof committed
407

408 409 410 411
	---------------------------------
	-- 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.
412 413

\begin{code}
414 415
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
416

417
setInlinePragma :: Id -> InlinePragInfo -> Id
418
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
419

420
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
421
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
422
\end{code}
423 424 425 426 427


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
428 429 430
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

431
isOneShotLambda :: Id -> Bool
432 433
isOneShotLambda id = analysis || hack
  where analysis = case idLBVarInfo id of
434
                     LBVarInfo u    | u `eqUsage` usOnce      -> True
435 436 437 438 439
                     other                                    -> False
        hack     = case splitTyConApp_maybe (idType id) of
                     Just (tycon,_) | tycon == statePrimTyCon -> True
                     other                                    -> False

440 441 442 443 444 445 446 447 448 449 450
	-- 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.
451
	--
452 453
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
454 455 456
	--
	-- 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.
457 458

setOneShotLambda :: Id -> Id
459
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
460 461 462 463 464 465 466 467 468

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

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

475 476
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}