Id.lhs 14.8 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
	setIdDemandInfo, setIdNewDemandInfo, 
	setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
49
        setIdTyGenInfo,
50
	setIdWorkerInfo,
51
	setIdSpecialisation,
52
	setIdCgInfo,
53
	setIdCprInfo,
54
	setIdOccInfo,
55

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

69 70
	newStrictnessFromOld 	-- Temporary

71
    ) where
72

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


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

import IdInfo 

92
import qualified Demand	( Demand )
93
import NewDemand	( Demand, StrictSig, topSig, isBottomingSig )
sof's avatar
sof committed
94
import Name	 	( Name, OccName,
95
			  mkSysLocalName, mkLocalName,
96
			  getOccName, getSrcLoc
sof's avatar
sof committed
97
			) 
98
import OccName		( UserFS, mkWorkerOcc )
99
import PrimRep		( PrimRep )
100
import TysPrim		( statePrimTyCon )
101
import FieldLabel	( FieldLabel )
102
import Maybes		( orElse )
103
import SrcLoc		( SrcLoc )
104
import Outputable
105
import Unique		( Unique, mkBuiltinUnique )
106

107
infixl 	1 `setIdUnfolding`,
108
	  `setIdArity`,
109 110
	  `setIdDemandInfo`,
	  `setIdStrictness`,
111 112
	  `setIdNewDemandInfo`,
	  `setIdNewStrictness`,
113
	  `setIdTyGenInfo`,
114
	  `setIdWorkerInfo`,
115
	  `setIdSpecialisation`,
116
	  `setInlinePragma`,
117 118
	  `idCafInfo`,
	  `idCprInfo`
119

120
	-- infixl so you can say (id `set` a `set` b)
121 122 123
\end{code}


124

125 126
%************************************************************************
%*									*
127
\subsection{Simple Id construction}
128 129 130
%*									*
%************************************************************************

131 132 133
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.
134

135
\begin{code}
136 137 138
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info

139 140
mkSpecPragmaId :: Name -> Type -> Id
mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
141 142 143

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

146
\begin{code}
147
mkLocalId :: Name -> Type -> Id
148
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
149 150 151

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

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

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

170 171 172 173 174 175 176
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)

177
-- "Template locals" typically used in unfoldings
178
mkTemplateLocals :: [Type] -> [Id]
179
mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
180

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

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


190 191 192 193 194 195 196
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

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

201 202
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
203 204 205 206 207
\end{code}


%************************************************************************
%*									*
208
\subsection{Special Ids}
209 210 211
%*									*
%************************************************************************

212 213 214 215 216 217 218 219 220
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.
221 222


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

228
isRecordSelector id = case globalIdDetails id of
229 230
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
231

232
isPrimOpId id = case globalIdDetails id of
233 234 235
		    PrimOpId op -> True
		    other	-> False

236
isPrimOpId_maybe id = case globalIdDetails id of
237 238 239
			    PrimOpId op -> Just op
			    other	-> Nothing

240 241 242 243 244 245 246 247
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

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

248
isDataConId id = case globalIdDetails id of
249 250
			DataConId _ -> True
			other	    -> False
sof's avatar
sof committed
251

252
isDataConId_maybe id = case globalIdDetails id of
253 254
			  DataConId con -> Just con
			  other	        -> Nothing
sof's avatar
sof committed
255

256
isDataConWrapId_maybe id = case globalIdDetails id of
257 258
				  DataConWrapId con -> Just con
				  other	            -> Nothing
259

260
isDataConWrapId id = case globalIdDetails id of
261 262
			DataConWrapId con -> True
			other	          -> False
263

264 265 266 267 268
-- 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.
269 270
hasNoBinding id = case globalIdDetails id of
			PrimOpId _  -> True
271
			FCallId _   -> True
272
			other	    -> False
273

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

\begin{code}
isDeadBinder :: Id -> Bool
294
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
295
		  | otherwise = False	-- TyVars count as not dead
296 297 298
\end{code}


299 300
%************************************************************************
%*									*
301
\subsection{IdInfo stuff}
302 303 304
%*									*
%************************************************************************

305
\begin{code}
306 307
	---------------------------------
	-- ARITY
308
idArity :: Id -> Arity
309
idArity id = arityInfo (idInfo id)
310

311 312
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
313

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

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

322 323
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
324 325 326 327 328 329 330 331 332 333
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
334

335 336 337
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

338 339 340 341 342 343 344 345
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

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

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

setIdWorkerInfo :: Id -> WorkerInfo -> Id
352
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
353

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

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

362 363
	---------------------------------
	-- DEMAND
364
idDemandInfo :: Id -> Demand.Demand
365
idDemandInfo id = demandInfo (idInfo id)
366

367
setIdDemandInfo :: Id -> Demand.Demand -> Id
368
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
369

370 371 372 373 374 375
idNewDemandInfo :: Id -> NewDemand.Demand
idNewDemandInfo id = newDemandInfo (idInfo id)

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

376 377
	---------------------------------
	-- SPECIALISATION
378 379
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
380

381 382
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
383

384 385 386
	---------------------------------
	-- CG INFO
idCgInfo :: Id -> CgInfo
387 388 389 390 391
#ifdef DEBUG
idCgInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
		  info     -> info
#else
392
idCgInfo id = cgInfo (idInfo id)
393
#endif		
394 395 396 397

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

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

	---------------------------------
	-- CPR INFO
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 417 418

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

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

sof's avatar
sof committed
426

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

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

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

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


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

450
isOneShotLambda :: Id -> Bool
451 452
isOneShotLambda id = analysis || hack
  where analysis = case idLBVarInfo id of
453
                     LBVarInfo u    | u `eqUsage` usOnce      -> True
454 455 456 457 458
                     other                                    -> False
        hack     = case splitTyConApp_maybe (idType id) of
                     Just (tycon,_) | tycon == statePrimTyCon -> True
                     other                                    -> False

459 460 461 462 463 464 465 466 467 468 469
	-- 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.
470
	--
471 472
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
473 474 475
	--
	-- 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.
476 477

setOneShotLambda :: Id -> Id
478
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
479 480 481 482 483 484 485 486 487

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
488
\end{code}
489 490 491 492 493

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

494 495
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
496