Id.lhs 15.6 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
	mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo, 
12
	mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
13
	mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
14
	mkWorkerId, mkExportedLocalId,
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, Id.setIdType, setIdLocalExported, 
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
	isDataConWorkId, isDataConWorkId_maybe, 
33 34
	isBottomingId, idIsFrom,
	hasNoBinding, 
35 36 37 38

	-- Inline pragma stuff
	idInlinePragma, setInlinePragma, modifyInlinePragma, 

39

40
	-- One shot lambda stuff
41 42
	isOneShotBndr, isOneShotLambda, isStateHackType,
	setOneShotLambda, clearOneShotLambda,
43

44 45
	-- IdInfo stuff
	setIdUnfolding,
46
	setIdArity,
47 48
	setIdNewDemandInfo, 
	setIdNewStrictness, zapIdNewStrictness,
49
	setIdWorkerInfo,
50
	setIdSpecialisation,
51
	setIdCafInfo,
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 70
	idCafInfo,
	idLBVarInfo,
71
	idOccInfo,
72

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

77
    ) where
78

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


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

97
#ifdef OLD_STRICTNESS
98
import qualified Demand	( Demand )
99
#endif
100
import DataCon		( isUnboxedTupleCon )
101
import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
102
import Name	 	( Name, OccName, nameIsLocalOrFrom, 
103
			  mkSystemName, mkSystemNameEncoded, mkInternalName,
104
			  getOccName, getSrcLoc
sof's avatar
sof committed
105
			) 
106
import Module		( Module )
107
import OccName		( EncodedFS, mkWorkerOcc )
108
import PrimRep		( PrimRep )
109
import FieldLabel	( FieldLabel )
110
import Maybes		( orElse )
111
import SrcLoc		( SrcLoc )
112
import Outputable
113
import Unique		( Unique, mkBuiltinUnique )
114
import CmdLineOpts	( opt_NoStateHack )
115

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


133

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

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

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

148 149
mkSpecPragmaId :: Name -> Type -> Id
mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
150

151 152 153
mkExportedLocalId :: Name -> Type -> Id
mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo

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

158
\begin{code}
159
mkLocalId :: Name -> Type -> Id
160
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
161 162 163

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

168 169
-- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again.
170 171 172 173 174
mkSysLocal          fs uniq ty = mkLocalId (mkSystemNameEncoded uniq fs) ty

-- version to use when the faststring needs to be encoded
mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemName uniq fs)        ty

175
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
176
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
177
\end{code}
178 179 180 181

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.
182
 
183
\begin{code}
184 185
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
186
mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
187

188
mkWorkerId :: Unique -> Id -> Type -> Id
189
-- A worker gets a local name.  CoreTidy will externalise it if necessary.
190 191 192
mkWorkerId uniq unwrkr ty
  = mkLocalId wkr_name ty
  where
193
    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
194

195
-- "Template locals" typically used in unfoldings
196
mkTemplateLocals :: [Type] -> [Id]
197
mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
198

199
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
200
-- The Int gives the starting point for unique allocation
201
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
202

203
mkTemplateLocal :: Int -> Type -> Id
204
mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
205 206 207
\end{code}


208 209 210 211 212 213 214
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

\begin{code}
215
setIdType :: Id -> Type -> Id
216
	-- Add free tyvar info to the type
217
setIdType id ty = seqType ty `seq` Var.setIdType id (addFreeTyVars ty)
sof's avatar
sof committed
218

219 220
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
221 222 223 224 225
\end{code}


%************************************************************************
%*									*
226
\subsection{Special Ids}
227 228 229
%*									*
%************************************************************************

230 231 232 233 234 235 236 237 238
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.
239 240


241
\begin{code}
242
recordSelectorFieldLabel :: Id -> FieldLabel
243 244
recordSelectorFieldLabel id = case globalIdDetails id of
				 RecordSelId lbl -> lbl
245
				 other -> panic "recordSelectorFieldLabel"
sof's avatar
sof committed
246

247
isRecordSelector id = case globalIdDetails id of
248 249
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
250

251
isPrimOpId id = case globalIdDetails id of
252 253 254
		    PrimOpId op -> True
		    other	-> False

255
isPrimOpId_maybe id = case globalIdDetails id of
256 257 258
			    PrimOpId op -> Just op
			    other	-> Nothing

259 260 261 262 263 264 265 266
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

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

267 268 269
isDataConWorkId id = case globalIdDetails id of
			DataConWorkId _ -> True
			other	        -> False
sof's avatar
sof committed
270

271 272 273
isDataConWorkId_maybe id = case globalIdDetails id of
			  DataConWorkId con -> Just con
			  other	            -> Nothing
sof's avatar
sof committed
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 
279 280
-- them at the CorePrep stage. 
-- EXCEPT: unboxed tuples, which definitely have no binding
281
hasNoBinding id = case globalIdDetails id of
282 283 284 285
			PrimOpId _  	 -> True
			FCallId _   	 -> True
			DataConWorkId dc -> isUnboxedTupleCon dc
			other	         -> False
286

287
isImplicitId :: Id -> Bool
288 289 290
	-- 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.
291
isImplicitId id
292
  = case globalIdDetails id of
293
	RecordSelId _   -> True
294
        FCallId _       -> True
295
        PrimOpId _      -> True
296
	ClassOpId _	-> True
297
        DataConWorkId _ -> True
298 299
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
300
		-- remember that all type and class decls appear in the interface file.
301 302
		-- The dfun id is not an implicit Id; it must *not* be omitted, because 
		-- it carries version info for the instance decl
303
	other		-> False
304 305 306

idIsFrom :: Module -> Id -> Bool
idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
307 308 309 310
\end{code}

\begin{code}
isDeadBinder :: Id -> Bool
311
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
312
		  | otherwise = False	-- TyVars count as not dead
313 314 315
\end{code}


316 317
%************************************************************************
%*									*
318
\subsection{IdInfo stuff}
319 320 321
%*									*
%************************************************************************

322
\begin{code}
323 324
	---------------------------------
	-- ARITY
325
idArity :: Id -> Arity
326
idArity id = arityInfo (idInfo id)
327

328 329
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
330

331
#ifdef OLD_STRICTNESS
332
	---------------------------------
333
	-- (OLD) STRICTNESS 
334
idStrictness :: Id -> StrictnessInfo
335
idStrictness id = strictnessInfo (idInfo id)
336

337
setIdStrictness :: Id -> StrictnessInfo -> Id
338
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
339
#endif
340

341 342
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
343 344 345 346 347 348 349 350 351 352
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
353

354 355 356
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

357
	---------------------------------
358
	-- WORKER ID
359 360
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
361 362

setIdWorkerInfo :: Id -> WorkerInfo -> Id
363
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
364

365 366
	---------------------------------
	-- UNFOLDING
367 368
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
369

370
setIdUnfolding :: Id -> Unfolding -> Id
371
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
372

373
#ifdef OLD_STRICTNESS
374
	---------------------------------
375
	-- (OLD) DEMAND
376
idDemandInfo :: Id -> Demand.Demand
377
idDemandInfo id = demandInfo (idInfo id)
378

379
setIdDemandInfo :: Id -> Demand.Demand -> Id
380
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
381
#endif
382

383 384 385 386 387
idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
idNewDemandInfo       :: Id -> NewDemand.Demand

idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
388 389

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

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

397 398 399
idCoreRules :: Id -> [IdCoreRule]
idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]

400 401
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
402

403 404
	---------------------------------
	-- CAF INFO
405
idCafInfo :: Id -> CafInfo
406
#ifdef OLD_STRICTNESS
407 408 409 410
idCafInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
		  info     -> cgCafInfo info
#else
411
idCafInfo id = cafInfo (idInfo id)
412
#endif
413 414 415 416

setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id

417 418
	---------------------------------
	-- CPR INFO
419
#ifdef OLD_STRICTNESS
420
idCprInfo :: Id -> CprInfo
421
idCprInfo id = cprInfo (idInfo id)
422 423

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

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

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

sof's avatar
sof committed
436

437 438 439 440
	---------------------------------
	-- 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.
441 442

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

446
setInlinePragma :: Id -> InlinePragInfo -> Id
447
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
448

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


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

460 461 462
isOneShotBndr :: Id -> Bool
-- This one is the "business end", called externally.
-- Its main purpose is to encapsulate the Horrible State Hack
463
isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
464

465 466
isStateHackType :: Type -> Bool
isStateHackType ty
467 468 469
  | opt_NoStateHack 
  = False
  | otherwise
470 471 472
  = case splitTyConApp_maybe ty of
	Just (tycon,_) -> tycon == statePrimTyCon
        other          -> False
473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
	-- This 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.
	--
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
	--
	-- 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.


-- The OneShotLambda functions simply fiddle with the IdInfo flag
493
isOneShotLambda :: Id -> Bool
494 495 496
isOneShotLambda id = case idLBVarInfo id of
                       IsOneShotLambda  -> True
                       NoLBVarInfo      -> False
497 498

setOneShotLambda :: Id -> Id
499
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
500 501 502 503 504 505 506 507 508

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
509
\end{code}
510 511 512 513 514

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

515 516
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
517