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
	isOneShotBndr, isOneShotLambda, setOneShotLambda, clearOneShotLambda,
42

43 44
	-- IdInfo stuff
	setIdUnfolding,
45
	setIdArity,
46 47
	setIdNewDemandInfo, 
	setIdNewStrictness, zapIdNewStrictness,
48
	setIdWorkerInfo,
49
	setIdSpecialisation,
50
	setIdCafInfo,
51
	setIdOccInfo,
52

53
#ifdef OLD_STRICTNESS
54 55 56 57 58 59 60 61
	idDemandInfo, 
	idStrictness, 
	idCprInfo,
	setIdStrictness, 
	setIdDemandInfo, 
	setIdCprInfo,
#endif

62
	idArity, 
63
	idNewDemandInfo, idNewDemandInfo_maybe,
64
	idNewStrictness, idNewStrictness_maybe, 
65 66
	idWorkerInfo,
	idUnfolding,
67
	idSpecialisation, idCoreRules,
68 69
	idCafInfo,
	idLBVarInfo,
70
	idOccInfo,
71

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

76
    ) where
77

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


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

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

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


132

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

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

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

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

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

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

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

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

167 168
-- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again.
169 170 171 172 173
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

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

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

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

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

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

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


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

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

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


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

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


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

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

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

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

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

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

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

270 271 272
isDataConWorkId_maybe id = case globalIdDetails id of
			  DataConWorkId con -> Just con
			  other	            -> Nothing
sof's avatar
sof committed
273

274 275 276 277
-- 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 
278 279
-- them at the CorePrep stage. 
-- EXCEPT: unboxed tuples, which definitely have no binding
280
hasNoBinding id = case globalIdDetails id of
281 282 283 284
			PrimOpId _  	 -> True
			FCallId _   	 -> True
			DataConWorkId dc -> isUnboxedTupleCon dc
			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
293
        FCallId _       -> True
294
        PrimOpId _      -> True
295
	ClassOpId _	-> True
296
        DataConWorkId _ -> True
297 298
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
299
		-- remember that all type and class decls appear in the interface file.
300 301
		-- The dfun id is not an implicit Id; it must *not* be omitted, because 
		-- it carries version info for the instance decl
302
	other		-> False
303 304 305

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sof's avatar
sof committed
435

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

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

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

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


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

459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490
isOneShotBndr :: Id -> Bool
-- This one is the "business end", called externally.
-- Its main purpose is to encapsulate the Horrible State Hack
isOneShotBndr id = isOneShotLambda id || (isStateHack id)

isStateHack id 
  | opt_NoStateHack 
  = False
  | otherwise
  = case splitTyConApp_maybe (idType id) of
	Just (tycon,_) | tycon == statePrimTyCon -> True
        other                                    -> False
	-- 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
491
isOneShotLambda :: Id -> Bool
492 493 494
isOneShotLambda id = case idLBVarInfo id of
                       IsOneShotLambda  -> True
                       NoLBVarInfo      -> False
495 496

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

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

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

513 514
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
515