Id.lhs 13.7 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 32
	isDataConId, isDataConId_maybe, 
	isDataConWrapId, isDataConWrapId_maybe,
33
	isBottomingId,
34 35 36 37 38
	hasNoBinding,

	-- Inline pragma stuff
	idInlinePragma, setInlinePragma, modifyInlinePragma, 

39

40
	-- One shot lambda stuff
41
	isOneShotLambda, setOneShotLambda, clearOneShotLambda,
42

43 44
	-- IdInfo stuff
	setIdUnfolding,
45
	setIdArityInfo,
46 47
	setIdDemandInfo,
	setIdStrictness,
48
        setIdTyGenInfo,
49
	setIdWorkerInfo,
50
	setIdSpecialisation,
51
	setIdCgInfo,
52
	setIdCprInfo,
53
	setIdOccInfo,
54

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

69
    ) where
70

71
#include "HsVersions.h"
sof's avatar
sof committed
72 73


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

import IdInfo 

90
import Demand		( Demand )
sof's avatar
sof committed
91
import Name	 	( Name, OccName,
92
			  mkSysLocalName, mkLocalName,
93
			  getOccName, getSrcLoc
sof's avatar
sof committed
94
			) 
95
import OccName		( UserFS, mkWorkerOcc )
96
import PrimRep		( PrimRep )
97
import TysPrim		( statePrimTyCon )
98
import FieldLabel	( FieldLabel )
99
import SrcLoc		( SrcLoc )
100 101
import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques, 
			  getNumBuiltinUniques )
102

103
infixl 	1 `setIdUnfolding`,
104
	  `setIdArityInfo`,
105 106
	  `setIdDemandInfo`,
	  `setIdStrictness`,
107
	  `setIdTyGenInfo`,
108
	  `setIdWorkerInfo`,
109
	  `setIdSpecialisation`,
110
	  `setInlinePragma`,
111 112
	  `idCafInfo`,
	  `idCprInfo`
113

114
	-- infixl so you can say (id `set` a `set` b)
115 116 117
\end{code}


118

119 120
%************************************************************************
%*									*
121
\subsection{Simple Id construction}
122 123 124
%*									*
%************************************************************************

125 126 127
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.
128

129
\begin{code}
130 131 132 133 134 135
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)
136
						    vanillaIdInfo
137 138 139

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

142
\begin{code}
143
mkLocalId :: Name -> Type -> Id
144
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
145 146 147

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

152 153 154
mkSysLocal  fs uniq ty      = mkLocalId (mkSysLocalName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName    uniq occ loc) ty
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
155
\end{code}
156 157 158 159

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.
160
 
161
\begin{code}
162 163
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
164
mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
165

166 167 168 169 170 171 172
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)

173
-- "Template locals" typically used in unfoldings
174
mkTemplateLocals :: [Type] -> [Id]
175
mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
176 177
			       (getBuiltinUniques (length tys))
			       tys
178

179
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
180
-- The Int gives the starting point for unique allocation
181
mkTemplateLocalsNum n tys = zipWith (mkSysLocal SLIT("tpl"))
182 183
			    	    (getNumBuiltinUniques n (length tys))
			       	    tys
184

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


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

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

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


%************************************************************************
%*									*
208
\subsection{Special Ids}
209 210 211
%*									*
%************************************************************************

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


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

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

232
isPrimOpId id = case globalIdDetails id of
233 234 235
		    PrimOpId op -> True
		    other	-> False

236
isPrimOpId_maybe id = case globalIdDetails id of
237 238 239
			    PrimOpId op -> Just op
			    other	-> Nothing

240
isDataConId id = case globalIdDetails id of
241 242
			DataConId _ -> True
			other	    -> False
sof's avatar
sof committed
243

244
isDataConId_maybe id = case globalIdDetails id of
245 246
			  DataConId con -> Just con
			  other	        -> Nothing
sof's avatar
sof committed
247

248
isDataConWrapId_maybe id = case globalIdDetails id of
249 250
				  DataConWrapId con -> Just con
				  other	            -> Nothing
251

252
isDataConWrapId id = case globalIdDetails id of
253 254
			DataConWrapId con -> True
			other	          -> False
255

256
	-- hasNoBinding returns True of an Id which may not have a
257 258
	-- binding, even though it is defined in this module.  Notably,
	-- the constructors of a dictionary are in this situation.
259 260 261 262
hasNoBinding id = case globalIdDetails id of
			DataConId _ -> True
			PrimOpId _  -> True
			other	    -> False
263

264
isImplicitId :: Id -> Bool
265 266 267
	-- 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.
268
isImplicitId id
269
  = case globalIdDetails id of
270 271 272 273 274
	RecordSelId _   -> True	-- Includes dictionary selectors
        PrimOpId _      -> True
        DataConId _     -> True
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
275 276 277
		-- 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
278
	other		-> False
279 280 281 282
\end{code}

\begin{code}
isDeadBinder :: Id -> Bool
283
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
284
		  | otherwise = False	-- TyVars count as not dead
285 286 287
\end{code}


288 289
%************************************************************************
%*									*
290
\subsection{IdInfo stuff}
291 292 293
%*									*
%************************************************************************

294
\begin{code}
295 296
	---------------------------------
	-- ARITY
297 298 299 300 301
idArityInfo :: Id -> ArityInfo
idArityInfo id = arityInfo (idInfo id)

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

303 304
setIdArityInfo :: Id -> ArityInfo -> Id
setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
305

306 307
	---------------------------------
	-- STRICTNESS
308 309
idStrictness :: Id -> StrictnessInfo
idStrictness id = strictnessInfo (idInfo id)
310

311
setIdStrictness :: Id -> StrictnessInfo -> Id
312
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
313

314 315
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
316
isBottomingId id = isBottomingStrictness (idStrictness id)
317

318 319 320 321 322 323 324 325
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

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

326 327
	---------------------------------
	-- WORKER ID
328 329
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
330 331

setIdWorkerInfo :: Id -> WorkerInfo -> Id
332
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
333

334 335
	---------------------------------
	-- UNFOLDING
336 337
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
338

339
setIdUnfolding :: Id -> Unfolding -> Id
340
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
341

342 343
	---------------------------------
	-- DEMAND
344 345
idDemandInfo :: Id -> Demand
idDemandInfo id = demandInfo (idInfo id)
346

347
setIdDemandInfo :: Id -> Demand -> Id
348
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
349

350 351
	---------------------------------
	-- SPECIALISATION
352 353
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
354

355 356
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
357

358 359 360 361 362 363 364 365
	---------------------------------
	-- CG INFO
idCgInfo :: Id -> CgInfo
idCgInfo id = cgInfo (idInfo id)

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

366 367
	---------------------------------
	-- CAF INFO
368
idCafInfo :: Id -> CafInfo
369 370 371 372
idCafInfo id = cgCafInfo (idCgInfo id)

	---------------------------------
	-- CG ARITY
373

374 375
idCgArity :: Id -> Arity
idCgArity id = cgArity (idCgInfo id)
376 377 378

	---------------------------------
	-- CPR INFO
379 380
idCprInfo :: Id -> CprInfo
idCprInfo id = cprInfo (idInfo id)
381 382

setIdCprInfo :: Id -> CprInfo -> Id
383
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
384 385 386

	---------------------------------
	-- Occcurrence INFO
387 388
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
389 390 391

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

sof's avatar
sof committed
394

395 396 397 398
	---------------------------------
	-- 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.
399 400

\begin{code}
401 402
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
403

404
setInlinePragma :: Id -> InlinePragInfo -> Id
405
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
406

407
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
408
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
409
\end{code}
410 411 412 413 414


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
415 416 417
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

418
isOneShotLambda :: Id -> Bool
419 420 421 422 423 424 425 426
isOneShotLambda id = analysis || hack
  where analysis = case idLBVarInfo id of
                     LBVarInfo u    | u == usOnce             -> True
                     other                                    -> False
        hack     = case splitTyConApp_maybe (idType id) of
                     Just (tycon,_) | tycon == statePrimTyCon -> True
                     other                                    -> False

427 428 429 430 431 432 433 434 435 436 437
	-- 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.
438
	--
439 440
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
441 442 443
	--
	-- 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.
444 445

setOneShotLambda :: Id -> Id
446
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
447 448 449 450 451 452 453 454 455

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
456
\end{code}
457 458 459 460 461

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

462 463
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}