Id.lhs 12.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
	mkId, mkVanillaId, mkSysLocal, mkUserLocal,
	mkTemplateLocals, mkWildId, mkTemplateLocal,
13 14

	-- Taking an Id apart
15
	idName, idType, idUnique, idInfo,
16
	idPrimRep, isId,
17
	recordSelectorFieldLabel,
18

19
	-- Modifying an Id
20
	setIdName, setIdUnique, setIdType, setIdNoDiscard, 
21
	setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
22
	zapFragileIdInfo, zapLamIdInfo,
23 24

	-- Predicates
25
	omitIfaceSigForId,
26
	exportWithOrigOccName,
27
	externallyVisibleId,
28 29
	idFreeTyVars,
	isIP,
30 31 32 33

	-- Inline pragma stuff
	getInlinePragma, setInlinePragma, modifyInlinePragma, 

34
	isSpecPragmaId,	isRecordSelector,
35
	isPrimitiveId_maybe, isDataConId_maybe,
36
	isConstantId, isConstantId_maybe, isBottomingId, idAppIsBottom,
37
	isExportedId, isUserExportedId,
38
	mayHaveNoBinding,
39

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

43 44 45 46 47
	-- IdInfo stuff
	setIdUnfolding,
	setIdArity,
	setIdDemandInfo,
	setIdStrictness,
48
	setIdWorkerInfo,
49 50 51
	setIdSpecialisation,
	setIdUpdateInfo,
	setIdCafInfo,
52
	setIdCprInfo,
53
	setIdOccInfo,
54

55 56 57
	getIdArity,
	getIdDemandInfo,
	getIdStrictness,
58
	getIdWorkerInfo,
59
	getIdUnfolding,
60
	getIdSpecialisation,
61
	getIdUpdateInfo,
62
	getIdCafInfo,
63 64
	getIdCprInfo,
	getIdOccInfo
65

66
    ) where
67

68
#include "HsVersions.h"
sof's avatar
sof committed
69

sof's avatar
sof committed
70
import {-# SOURCE #-} CoreUnfold ( Unfolding )
71
import {-# SOURCE #-} CoreSyn    ( CoreRules )
sof's avatar
sof committed
72

73 74 75 76
import Var		( Id, DictId,
			  isId, mkIdVar,
			  idName, idType, idUnique, idInfo,
			  setIdName, setVarType, setIdUnique, 
77
			  setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
78 79 80
			  externallyVisibleId
			)
import VarSet
81 82 83 84
import Type		( Type, tyVarsOfType, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )

import IdInfo 

85
import Demand		( Demand, isStrict, wwLazy )
sof's avatar
sof committed
86
import Name	 	( Name, OccName,
87
			  mkSysLocalName, mkLocalName,
88 89
			  isWiredInName, isUserExportedName,
			  getOccName, isIPOcc
sof's avatar
sof committed
90
			) 
91
import OccName		( UserFS )
92 93
import Const		( Con(..) )
import PrimRep		( PrimRep )
94
import PrimOp		( PrimOp )
95
import TysPrim		( statePrimTyCon )
96
import FieldLabel	( FieldLabel(..) )
97
import SrcLoc		( SrcLoc )
98
import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques )
99
import Outputable
100

101 102 103 104
infixl 	1 `setIdUnfolding`,
	  `setIdArity`,
	  `setIdDemandInfo`,
	  `setIdStrictness`,
105
	  `setIdWorkerInfo`,
106 107
	  `setIdSpecialisation`,
	  `setIdUpdateInfo`,
108 109 110 111
	  `setInlinePragma`,
	  `getIdCafInfo`,
	  `getIdCprInfo`

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


116

117 118
%************************************************************************
%*									*
119
\subsection{Simple Id construction}
120 121 122
%*									*
%************************************************************************

123 124 125 126
Absolutely all Ids are made by mkId.  It 
	a) Pins free-tyvar-info onto the Id's type, 
	   where it can easily be found.
	b) Ensures that exported Ids are 
127

128 129 130 131 132 133 134
\begin{code}
mkId :: Name -> Type -> IdInfo -> Id
mkId name ty info = mkIdVar name (addFreeTyVars ty) info'
		  where
		    info' | isUserExportedName name = setNoDiscardInfo info
			  | otherwise		    = info
\end{code}
135

136 137 138
\begin{code}
mkVanillaId :: Name -> Type -> Id
mkVanillaId name ty = mkId name ty vanillaIdInfo
139 140 141

-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
142 143
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
mkSysLocal  :: UserFS  -> Unique -> Type -> Id
144

145 146
mkSysLocal  fs uniq ty      = mkVanillaId (mkSysLocalName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName    uniq occ loc) ty
147
\end{code}
148 149 150 151 152 153

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.

\begin{code}
154 155
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
156
mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
157 158

-- "Template locals" typically used in unfoldings
159
mkTemplateLocals :: [Type] -> [Id]
160
mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
161 162
			       (getBuiltinUniques (length tys))
			       tys
163 164 165

mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
166 167 168
\end{code}


169 170 171 172 173 174 175
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

\begin{code}
176
idFreeTyVars :: Id -> TyVarSet
177
idFreeTyVars id = tyVarsOfType (idType id)
178

179
setIdType :: Id -> Type -> Id
180
	-- Add free tyvar info to the type
181
setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
sof's avatar
sof committed
182

183 184
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
185 186 187 188 189
\end{code}


%************************************************************************
%*									*
190
\subsection{Special Ids}
191 192 193
%*									*
%************************************************************************

sof's avatar
sof committed
194
\begin{code}
195 196 197 198 199 200 201
idFlavour :: Id -> IdFlavour
idFlavour id = flavourInfo (idInfo id)

setIdNoDiscard :: Id -> Id
setIdNoDiscard id	-- Make an Id into a NoDiscardId, unless it is already
  = modifyIdInfo setNoDiscardInfo id

202
recordSelectorFieldLabel :: Id -> FieldLabel
203
recordSelectorFieldLabel id = case idFlavour id of
204
				RecordSelId lbl -> lbl
sof's avatar
sof committed
205

206
isRecordSelector id = case idFlavour id of
207 208
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
209

210
isPrimitiveId_maybe id = case idFlavour id of
211 212
			    ConstantId (PrimOp op) -> Just op
			    other		   -> Nothing
sof's avatar
sof committed
213

214
isDataConId_maybe id = case idFlavour id of
215 216
			  ConstantId (DataCon con) -> Just con
			  other		           -> Nothing
sof's avatar
sof committed
217

218
isConstantId id = case idFlavour id of
219 220
		    ConstantId _ -> True
		    other	 -> False
221

222 223 224 225
isConstantId_maybe id = case idFlavour id of
		  	  ConstantId const -> Just const
			  other	           -> Nothing

226 227 228 229
isSpecPragmaId id = case idFlavour id of
			SpecPragmaId -> True
			other	     -> False

230 231 232 233 234 235 236 237
mayHaveNoBinding id = isConstantId id
	-- mayHaveNoBinding returns True of an Id which may not have a
	-- binding, even though it is defined in this module.  Notably,
	-- the constructors of a dictionary are in this situation.
	--	
	-- mayHaveNoBinding returns True of some things that *do* have a local binding,
	-- so it's only an approximation.  That's ok... it's only use for assertions.

238 239 240 241 242 243 244 245 246 247 248
-- Don't drop a binding for an exported Id,
-- if it otherwise looks dead.  
isExportedId :: Id -> Bool
isExportedId id = case idFlavour id of
			VanillaId -> False
			other	  -> True	-- All the others are no-discard

-- Say if an Id was exported by the user
-- Implies isExportedId (see mkId above)
isUserExportedId :: Id -> Bool
isUserExportedId id = isUserExportedName (idName id)
249 250
\end{code}

251

252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271
omitIfaceSigForId 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.

\begin{code}
omitIfaceSigForId :: Id -> Bool
omitIfaceSigForId id
  | isWiredInName (idName id)
  = True

  | otherwise
  = case idFlavour id of
	RecordSelId _  -> True	-- Includes dictionary selectors
        ConstantId _   -> True
		-- ConstantIds are implied by their type or class decl;
		-- 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

	other	       -> False	-- Don't omit!
272 273 274 275 276 277

-- Certain names must be exported with their original occ names, because
-- these names are bound by either a class declaration or a data declaration
-- or an explicit user export.
exportWithOrigOccName :: Id -> Bool
exportWithOrigOccName id = omitIfaceSigForId id || isUserExportedId id
278 279

isIP id = isIPOcc (getOccName id)
280 281 282 283
\end{code}



284 285
%************************************************************************
%*									*
286
\subsection{IdInfo stuff}
287 288 289
%*									*
%************************************************************************

290
\begin{code}
291 292
	---------------------------------
	-- ARITY
293
getIdArity :: Id -> ArityInfo
294
getIdArity id = arityInfo (idInfo id)
295

296
setIdArity :: Id -> ArityInfo -> Id
297
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
298

299 300
	---------------------------------
	-- STRICTNESS
301
getIdStrictness :: Id -> StrictnessInfo
302
getIdStrictness id = strictnessInfo (idInfo id)
303

304
setIdStrictness :: Id -> StrictnessInfo -> Id
305
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
306

307 308 309 310 311 312
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
isBottomingId id = isBottomingStrictness (strictnessInfo (idInfo id))

idAppIsBottom :: Id -> Int -> Bool
idAppIsBottom id n = appIsBottom (strictnessInfo (idInfo id)) n
313

314 315 316 317 318 319
	---------------------------------
	-- WORKER ID
getIdWorkerInfo :: Id -> WorkerInfo
getIdWorkerInfo id = workerInfo (idInfo id)

setIdWorkerInfo :: Id -> WorkerInfo -> Id
320
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
321

322 323
	---------------------------------
	-- UNFOLDING
324
getIdUnfolding :: Id -> Unfolding
325
getIdUnfolding id = unfoldingInfo (idInfo id)
326

327
setIdUnfolding :: Id -> Unfolding -> Id
328
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
329

330 331
	---------------------------------
	-- DEMAND
332
getIdDemandInfo :: Id -> Demand
333
getIdDemandInfo id = demandInfo (idInfo id)
334

335
setIdDemandInfo :: Id -> Demand -> Id
336
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
337

338 339
	---------------------------------
	-- UPDATE INFO
340
getIdUpdateInfo :: Id -> UpdateInfo
341
getIdUpdateInfo id = updateInfo (idInfo id)
342

343
setIdUpdateInfo :: Id -> UpdateInfo -> Id
344
setIdUpdateInfo id upd_info = modifyIdInfo (`setUpdateInfo` upd_info) id
345

346 347
	---------------------------------
	-- SPECIALISATION
348
getIdSpecialisation :: Id -> CoreRules
349
getIdSpecialisation id = specInfo (idInfo id)
350

351 352
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
353

354 355
	---------------------------------
	-- CAF INFO
356
getIdCafInfo :: Id -> CafInfo
357
getIdCafInfo id = cafInfo (idInfo id)
358

359
setIdCafInfo :: Id -> CafInfo -> Id
360
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
361 362 363 364 365 366 367

	---------------------------------
	-- CPR INFO
getIdCprInfo :: Id -> CprInfo
getIdCprInfo id = cprInfo (idInfo id)

setIdCprInfo :: Id -> CprInfo -> Id
368
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
369 370 371 372 373 374 375 376

	---------------------------------
	-- Occcurrence INFO
getIdOccInfo :: Id -> OccInfo
getIdOccInfo id = occInfo (idInfo id)

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

sof's avatar
sof committed
379

380 381 382 383
	---------------------------------
	-- 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.
384 385

\begin{code}
386
getInlinePragma :: Id -> InlinePragInfo
387
getInlinePragma id = inlinePragInfo (idInfo id)
388

389
setInlinePragma :: Id -> InlinePragInfo -> Id
390
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
391

392
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
393
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
394
\end{code}
395 396 397 398 399 400 401 402


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
isOneShotLambda :: Id -> Bool
isOneShotLambda id = case lbvarInfo (idInfo id) of
			IsOneShotLambda -> True
403 404 405
			NoLBVarInfo	-> case splitTyConApp_maybe (idType id) of
						Just (tycon,_) -> tycon == statePrimTyCon
						other	       -> False
406 407 408 409 410 411 412 413 414 415 416
	-- 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.
417
	--
418 419
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
420 421 422
	--
	-- 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.
423 424 425

setOneShotLambda :: Id -> Id
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
426 427 428 429 430 431 432 433 434

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
435
\end{code}
436 437 438 439 440 441 442 443 444

\begin{code}
zapFragileIdInfo :: Id -> Id
zapFragileIdInfo id = maybeModifyIdInfo zapFragileInfo id

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