Id.lhs 15.9 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
	setIdArityInfo,
47 48
	setIdDemandInfo, setIdNewDemandInfo, 
	setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
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
			  isId, isExportedId, isSpecPragmaId, isLocalId,
			  idName, idType, idUnique, idInfo, isGlobalId,
82
			  setIdName, setVarType, setIdUnique, setIdLocalExported,
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
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

363 364 365 366 367 368 369 370
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

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

371 372
	---------------------------------
	-- WORKER ID
373 374
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
375 376

setIdWorkerInfo :: Id -> WorkerInfo -> Id
377
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
378

379 380
	---------------------------------
	-- UNFOLDING
381 382
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
383

384
setIdUnfolding :: Id -> Unfolding -> Id
385
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
386

387 388
	---------------------------------
	-- DEMAND
389
idDemandInfo :: Id -> Demand.Demand
390
idDemandInfo id = demandInfo (idInfo id)
391

392
setIdDemandInfo :: Id -> Demand.Demand -> Id
393
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
394

395 396 397 398 399 400
idNewDemandInfo :: Id -> NewDemand.Demand
idNewDemandInfo id = newDemandInfo (idInfo id)

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

401 402
	---------------------------------
	-- SPECIALISATION
403 404
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
405

406 407
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
408

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

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

423 424
	---------------------------------
	-- CAF INFO
425
idCafInfo :: Id -> CafInfo
426 427 428 429 430 431
idCafInfo id = cgCafInfo (idCgInfo id)

	---------------------------------
	-- CG ARITY
idCgArity :: Id -> Arity
idCgArity id = cgArity (idCgInfo id)
432 433 434

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

setIdCprInfo :: Id -> CprInfo -> Id
443
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
444 445 446

	---------------------------------
	-- Occcurrence INFO
447 448
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
449 450 451

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

sof's avatar
sof committed
454

455 456 457 458
	---------------------------------
	-- 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.
459 460

\begin{code}
461 462
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
463

464
setInlinePragma :: Id -> InlinePragInfo -> Id
465
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
466

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


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
475 476 477
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

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

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

setOneShotLambda :: Id -> Id
506
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
507 508 509 510 511 512 513 514 515

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
516
\end{code}
517 518 519 520 521

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

522 523
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}