Id.lhs 14.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
	idDemandInfo, idNewDemandInfo,
58
	idStrictness, idNewStrictness, idNewStrictness_maybe, 
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
import qualified Demand	( Demand )
93
import NewDemand	( Demand, StrictSig, topSig, isBottomingSig )
sof's avatar
sof committed
94
import Name	 	( Name, OccName,
95
			  mkSysLocalName, mkLocalName,
96
			  getOccName, getSrcLoc
sof's avatar
sof committed
97
			) 
98
import OccName		( UserFS, mkWorkerOcc )
99
import PrimRep		( PrimRep )
100
import TysPrim		( statePrimTyCon )
101
import FieldLabel	( FieldLabel )
102
import Maybes		( orElse )
103
import SrcLoc		( SrcLoc )
104
import Outputable
105
import Unique		( Unique, mkBuiltinUnique )
106

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

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


124

125 126
%************************************************************************
%*									*
127
\subsection{Simple Id construction}
128 129 130
%*									*
%************************************************************************

131 132 133
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.
134

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

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

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

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

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

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

172 173 174 175 176 177 178
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)

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

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

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


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

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

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


%************************************************************************
%*									*
210
\subsection{Special Ids}
211 212 213
%*									*
%************************************************************************

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


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

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

234
isPrimOpId id = case globalIdDetails id of
235 236 237
		    PrimOpId op -> True
		    other	-> False

238
isPrimOpId_maybe id = case globalIdDetails id of
239 240 241
			    PrimOpId op -> Just op
			    other	-> Nothing

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

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

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

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

258
isDataConWrapId_maybe id = case globalIdDetails id of
259 260
				  DataConWrapId con -> Just con
				  other	            -> Nothing
261

262
isDataConWrapId id = case globalIdDetails id of
263 264
			DataConWrapId con -> True
			other	          -> False
265

266 267 268 269 270
-- 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.
271 272
hasNoBinding id = case globalIdDetails id of
			PrimOpId _  -> True
273
			FCallId _   -> True
274
			other	    -> False
275

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

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


301 302
%************************************************************************
%*									*
303
\subsection{IdInfo stuff}
304 305 306
%*									*
%************************************************************************

307
\begin{code}
308 309
	---------------------------------
	-- ARITY
310
idArity :: Id -> Arity
311
idArity id = arityInfo (idInfo id)
312

313 314
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
315

316
	---------------------------------
317
	-- STRICTNESS 
318
idStrictness :: Id -> StrictnessInfo
319
idStrictness id = strictnessInfo (idInfo id)
320

321
setIdStrictness :: Id -> StrictnessInfo -> Id
322
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
323

324 325
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
326 327 328 329 330 331 332 333 334 335
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
336

337 338 339
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

340 341 342 343 344 345 346 347
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

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

348 349
	---------------------------------
	-- WORKER ID
350 351
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
352 353

setIdWorkerInfo :: Id -> WorkerInfo -> Id
354
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
355

356 357
	---------------------------------
	-- UNFOLDING
358 359
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
360

361
setIdUnfolding :: Id -> Unfolding -> Id
362
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
363

364 365
	---------------------------------
	-- DEMAND
366
idDemandInfo :: Id -> Demand.Demand
367
idDemandInfo id = demandInfo (idInfo id)
368

369
setIdDemandInfo :: Id -> Demand.Demand -> Id
370
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
371

372 373 374 375 376 377
idNewDemandInfo :: Id -> NewDemand.Demand
idNewDemandInfo id = newDemandInfo (idInfo id)

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

378 379
	---------------------------------
	-- SPECIALISATION
380 381
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
382

383 384
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
385

386 387 388
	---------------------------------
	-- CG INFO
idCgInfo :: Id -> CgInfo
389 390 391 392 393
#ifdef DEBUG
idCgInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
		  info     -> info
#else
394
idCgInfo id = cgInfo (idInfo id)
395
#endif		
396 397 398 399

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

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

	---------------------------------
	-- CPR INFO
413
idCprInfo :: Id -> CprInfo
414
idCprInfo id = cprInfo (idInfo id)
415 416

setIdCprInfo :: Id -> CprInfo -> Id
417
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
418 419 420

	---------------------------------
	-- Occcurrence INFO
421 422
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
423 424 425

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

sof's avatar
sof committed
428

429 430 431 432
	---------------------------------
	-- 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.
433 434

\begin{code}
435 436
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
437

438
setInlinePragma :: Id -> InlinePragInfo -> Id
439
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
440

441
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
442
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
443
\end{code}
444 445 446 447 448


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
449 450 451
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

452
isOneShotLambda :: Id -> Bool
453 454
isOneShotLambda id = analysis || hack
  where analysis = case idLBVarInfo id of
455
                     LBVarInfo u    | u `eqUsage` usOnce      -> True
456 457 458 459 460
                     other                                    -> False
        hack     = case splitTyConApp_maybe (idType id) of
                     Just (tycon,_) | tycon == statePrimTyCon -> True
                     other                                    -> False

461 462 463 464 465 466 467 468 469 470 471
	-- 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.
472
	--
473 474
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
475 476 477
	--
	-- 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.
478 479

setOneShotLambda :: Id -> Id
480
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
481 482 483 484 485 486 487 488 489

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
490
\end{code}
491 492 493 494 495

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

496 497
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
498