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

55
#ifdef OLD_STRICTNESS
56 57 58 59 60 61 62 63
	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 OLD_STRICTNESS
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
			  mkSystemName, mkInternalName,
105
			  getOccName, getSrcLoc
sof's avatar
sof committed
106
			) 
107
import OccName		( EncodedFS, 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
	  `idCafInfo`
126
#ifdef OLD_STRICTNESS
127 128 129 130
	  ,`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
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
mkSysLocal  fs uniq ty      = mkLocalId (mkSystemName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
170
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
171
\end{code}
172 173 174 175

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

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

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

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

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


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

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

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


%************************************************************************
%*									*
220
\subsection{Special Ids}
221 222 223
%*									*
%************************************************************************

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


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

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

244
isPrimOpId id = case globalIdDetails id of
245 246 247
		    PrimOpId op -> True
		    other	-> False

248
isPrimOpId_maybe id = case globalIdDetails id of
249 250 251
			    PrimOpId op -> Just op
			    other	-> Nothing

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

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

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

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

268
isDataConWrapId_maybe id = case globalIdDetails id of
269 270
				  DataConWrapId con -> Just con
				  other	            -> Nothing
271

272
isDataConWrapId id = case globalIdDetails id of
273 274
			DataConWrapId con -> True
			other	          -> False
275

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

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

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


311 312
%************************************************************************
%*									*
313
\subsection{IdInfo stuff}
314 315 316
%*									*
%************************************************************************

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

323 324
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
325

326
#ifdef OLD_STRICTNESS
327
	---------------------------------
328
	-- (OLD) STRICTNESS 
329
idStrictness :: Id -> StrictnessInfo
330
idStrictness id = strictnessInfo (idInfo id)
331

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

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

349 350 351
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

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

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

360 361
	---------------------------------
	-- WORKER ID
362 363
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
364 365

setIdWorkerInfo :: Id -> WorkerInfo -> Id
366
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
367

368 369
	---------------------------------
	-- UNFOLDING
370 371
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
372

373
setIdUnfolding :: Id -> Unfolding -> Id
374
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
375

376
#ifdef OLD_STRICTNESS
377
	---------------------------------
378
	-- (OLD) DEMAND
379
idDemandInfo :: Id -> Demand.Demand
380
idDemandInfo id = demandInfo (idInfo id)
381

382
setIdDemandInfo :: Id -> Demand.Demand -> Id
383
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
384
#endif
385

386 387 388 389 390 391
idNewDemandInfo :: Id -> NewDemand.Demand
idNewDemandInfo id = newDemandInfo (idInfo id)

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

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

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

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

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

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

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

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

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

sof's avatar
sof committed
443

444 445 446 447
	---------------------------------
	-- 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.
448 449

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

453
setInlinePragma :: Id -> InlinePragInfo -> Id
454
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
455

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


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

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

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

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

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

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

511 512
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
513