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
	setIdArity,
47 48
	setIdDemandInfo, setIdNewDemandInfo, 
	setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
49
        setIdTyGenInfo,
50
	setIdWorkerInfo,
51
	setIdSpecialisation,
52
	setIdCgInfo,
53
	setIdCprInfo,
54
	setIdOccInfo,
55

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

69 70
	newStrictnessFromOld 	-- Temporary

71
    ) where
72

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


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

import IdInfo 

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

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

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


126

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

268 269 270 271 272
-- 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.
273 274
hasNoBinding id = case globalIdDetails id of
			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
idArity :: Id -> Arity
313
idArity id = arityInfo (idInfo id)
314

315 316
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
317

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

327
setIdStrictness :: Id -> StrictnessInfo -> Id
328
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
329

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

357 358 359
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

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
#ifdef DEBUG
idCafInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
		  info     -> cgCafInfo info
#else
428
idCafInfo id = cgCafInfo (idCgInfo id)
429
#endif
430 431 432

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

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

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

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

sof's avatar
sof committed
452

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

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

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

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


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

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

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

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

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

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

520 521
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
522