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

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

70 71
	newStrictnessFromOld 	-- Temporary

72
    ) where
73

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


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

import IdInfo 

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

110
infixl 	1 `setIdUnfolding`,
111
	  `setIdArityInfo`,
112 113
	  `setIdDemandInfo`,
	  `setIdStrictness`,
114 115
	  `setIdNewDemandInfo`,
	  `setIdNewStrictness`,
116
	  `setIdTyGenInfo`,
117
	  `setIdWorkerInfo`,
118
	  `setIdSpecialisation`,
119
	  `setInlinePragma`,
120 121
	  `idCafInfo`,
	  `idCprInfo`
122

123
	-- infixl so you can say (id `set` a `set` b)
124 125 126
\end{code}


127

128 129
%************************************************************************
%*									*
130
\subsection{Simple Id construction}
131 132 133
%*									*
%************************************************************************

134 135 136
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.
137

138
\begin{code}
139 140 141 142 143 144
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)
145
						    vanillaIdInfo
146 147 148

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

151
\begin{code}
152
mkLocalId :: Name -> Type -> Id
153
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
154 155 156

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

161 162 163
mkSysLocal  fs uniq ty      = mkLocalId (mkSysLocalName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName    uniq occ loc) ty
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
164
\end{code}
165 166 167 168

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

175 176 177 178 179 180 181
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)

182
-- "Template locals" typically used in unfoldings
183
mkTemplateLocals :: [Type] -> [Id]
184
mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
185

186
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
187
-- The Int gives the starting point for unique allocation
188
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
189

190 191
mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
192 193 194
\end{code}


195 196 197 198 199 200 201
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

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

206 207
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
208 209 210 211 212
\end{code}


%************************************************************************
%*									*
213
\subsection{Special Ids}
214 215 216
%*									*
%************************************************************************

217 218 219 220 221 222 223 224 225
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.
226 227


228
\begin{code}
229
recordSelectorFieldLabel :: Id -> FieldLabel
230 231
recordSelectorFieldLabel id = case globalIdDetails id of
				 RecordSelId lbl -> lbl
sof's avatar
sof committed
232

233
isRecordSelector id = case globalIdDetails id of
234 235
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
236

237
isPrimOpId id = case globalIdDetails id of
238 239 240
		    PrimOpId op -> True
		    other	-> False

241
isPrimOpId_maybe id = case globalIdDetails id of
242 243 244
			    PrimOpId op -> Just op
			    other	-> Nothing

245 246 247 248 249 250 251 252
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

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

253
isDataConId id = case globalIdDetails id of
254 255
			DataConId _ -> True
			other	    -> False
sof's avatar
sof committed
256

257
isDataConId_maybe id = case globalIdDetails id of
258 259
			  DataConId con -> Just con
			  other	        -> Nothing
sof's avatar
sof committed
260

261
isDataConWrapId_maybe id = case globalIdDetails id of
262 263
				  DataConWrapId con -> Just con
				  other	            -> Nothing
264

265
isDataConWrapId id = case globalIdDetails id of
266 267
			DataConWrapId con -> True
			other	          -> False
268

269
	-- hasNoBinding returns True of an Id which may not have a
270 271
	-- binding, even though it is defined in this module.  Notably,
	-- the constructors of a dictionary are in this situation.
272 273 274
hasNoBinding id = case globalIdDetails id of
			DataConId _ -> True
			PrimOpId _  -> True
275
			FCallId _   -> True
276
			other	    -> False
277

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

\begin{code}
isDeadBinder :: Id -> Bool
298
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
299
		  | otherwise = False	-- TyVars count as not dead
300 301 302
\end{code}


303 304
%************************************************************************
%*									*
305
\subsection{IdInfo stuff}
306 307 308
%*									*
%************************************************************************

309
\begin{code}
310 311
	---------------------------------
	-- ARITY
312 313 314 315 316
idArityInfo :: Id -> ArityInfo
idArityInfo id = arityInfo (idInfo id)

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

318
setIdArityInfo :: Id -> Arity -> Id
319
setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
320

321
	---------------------------------
322
	-- STRICTNESS 
323
idStrictness :: Id -> StrictnessInfo
324 325 326 327 328
idStrictness id = case strictnessInfo (idInfo id) of
			NoStrictnessInfo -> case idNewStrictness_maybe id of
						Just sig -> oldStrictnessFromNew sig
						Nothing  -> NoStrictnessInfo
			strictness -> strictness
329

330
setIdStrictness :: Id -> StrictnessInfo -> Id
331
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
332

333 334
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
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

getNewStrictness :: Id -> StrictSig
-- First tries the "new-strictness" field, and then
-- reverts to the old one. This is just until we have
-- cross-module info for new strictness
getNewStrictness id = idNewStrictness_maybe id `orElse` newStrictnessFromOld id
		      
newStrictnessFromOld :: Id -> StrictSig
newStrictnessFromOld id = mkNewStrictnessInfo id (idArity id) (idStrictness id) (idCprInfo id)

oldStrictnessFromNew :: StrictSig -> StrictnessInfo
oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
			 where
			   (dmds, res_info) = splitStrictSig sig

setIdNewStrictness :: Id -> StrictSig -> Id
setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
359

360 361 362 363 364 365 366 367
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

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

368 369
	---------------------------------
	-- WORKER ID
370 371
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
372 373

setIdWorkerInfo :: Id -> WorkerInfo -> Id
374
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
375

376 377
	---------------------------------
	-- UNFOLDING
378 379
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
380

381
setIdUnfolding :: Id -> Unfolding -> Id
382
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
383

384 385
	---------------------------------
	-- DEMAND
386
idDemandInfo :: Id -> Demand.Demand
387
idDemandInfo id = demandInfo (idInfo id)
388

389
setIdDemandInfo :: Id -> Demand.Demand -> Id
390
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
391

392 393 394 395 396 397
idNewDemandInfo :: Id -> NewDemand.Demand
idNewDemandInfo id = newDemandInfo (idInfo id)

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

398 399
	---------------------------------
	-- SPECIALISATION
400 401
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
402

403 404
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
405

406 407 408
	---------------------------------
	-- CG INFO
idCgInfo :: Id -> CgInfo
409 410 411 412 413
#ifdef DEBUG
idCgInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
		  info     -> info
#else
414
idCgInfo id = cgInfo (idInfo id)
415
#endif		
416 417 418 419

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

420 421
	---------------------------------
	-- CAF INFO
422
idCafInfo :: Id -> CafInfo
423 424 425 426 427 428
idCafInfo id = cgCafInfo (idCgInfo id)

	---------------------------------
	-- CG ARITY
idCgArity :: Id -> Arity
idCgArity id = cgArity (idCgInfo id)
429 430 431

	---------------------------------
	-- CPR INFO
432
idCprInfo :: Id -> CprInfo
433 434 435 436 437
idCprInfo id = case cprInfo (idInfo id) of
		 NoCPRInfo -> case strictSigResInfo (idNewStrictness id) of
				RetCPR -> ReturnsCPR
				other  -> NoCPRInfo
		 ReturnsCPR -> ReturnsCPR
438 439

setIdCprInfo :: Id -> CprInfo -> Id
440
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
441 442 443

	---------------------------------
	-- Occcurrence INFO
444 445
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
446 447 448

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

sof's avatar
sof committed
451

452 453 454 455
	---------------------------------
	-- 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.
456 457

\begin{code}
458 459
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
460

461
setInlinePragma :: Id -> InlinePragInfo -> Id
462
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
463

464
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
465
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
466
\end{code}
467 468 469 470 471


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
472 473 474
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

475
isOneShotLambda :: Id -> Bool
476 477
isOneShotLambda id = analysis || hack
  where analysis = case idLBVarInfo id of
478
                     LBVarInfo u    | u `eqUsage` usOnce      -> True
479 480 481 482 483
                     other                                    -> False
        hack     = case splitTyConApp_maybe (idType id) of
                     Just (tycon,_) | tycon == statePrimTyCon -> True
                     other                                    -> False

484 485 486 487 488 489 490 491 492 493 494
	-- 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.
495
	--
496 497
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
498 499 500
	--
	-- 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.
501 502

setOneShotLambda :: Id -> Id
503
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
504 505 506 507 508 509 510 511 512

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
513
\end{code}
514 515 516 517 518

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

519 520
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}