Id.lhs 11.4 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 23

	-- Predicates
24
	omitIfaceSigForId,
25
	exportWithOrigOccName,
26
	externallyVisibleId,
27 28 29 30
	idFreeTyVars, 

	-- Inline pragma stuff
	getInlinePragma, setInlinePragma, modifyInlinePragma, 
31
	idMustBeINLINEd, idMustNotBeINLINEd,
32

33
	isSpecPragmaId,	isRecordSelector,
34
	isPrimitiveId_maybe, isDataConId_maybe,
35 36
	isConstantId, isBottomingId, idAppIsBottom,
	isExportedId, isUserExportedId,
37

38 39 40
	-- One shot lambda stuff
	isOneShotLambda, setOneShotLambda,

41 42 43 44 45
	-- IdInfo stuff
	setIdUnfolding,
	setIdArity,
	setIdDemandInfo,
	setIdStrictness,
46
	setIdWorkerInfo,
47 48 49
	setIdSpecialisation,
	setIdUpdateInfo,
	setIdCafInfo,
50
	setIdCprInfo,
51

52 53 54
	getIdArity,
	getIdDemandInfo,
	getIdStrictness,
55
	getIdWorkerInfo,
56
	getIdUnfolding,
57
	getIdSpecialisation,
58
	getIdUpdateInfo,
59 60
	getIdCafInfo,
	getIdCprInfo
61

62
    ) where
63

64
#include "HsVersions.h"
sof's avatar
sof committed
65

sof's avatar
sof committed
66
import {-# SOURCE #-} CoreUnfold ( Unfolding )
67
import {-# SOURCE #-} CoreSyn    ( CoreRules )
sof's avatar
sof committed
68

69 70 71 72
import Var		( Id, DictId,
			  isId, mkIdVar,
			  idName, idType, idUnique, idInfo,
			  setIdName, setVarType, setIdUnique, 
73
			  setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
74 75 76
			  externallyVisibleId
			)
import VarSet
77
import Type		( Type, tyVarsOfType, typePrimRep, addFreeTyVars, seqType )
78
import IdInfo
79
import Demand		( Demand, isStrict, wwLazy )
sof's avatar
sof committed
80
import Name	 	( Name, OccName,
81
			  mkSysLocalName, mkLocalName,
82
			  isWiredInName, isUserExportedName
sof's avatar
sof committed
83
			) 
84 85
import Const		( Con(..) )
import PrimRep		( PrimRep )
86
import PrimOp		( PrimOp )
87
import TysPrim		( realWorldStatePrimTy )
88
import FieldLabel	( FieldLabel(..) )
89
import SrcLoc		( SrcLoc )
90
import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques )
91
import Outputable
92

93 94 95 96
infixl 	1 `setIdUnfolding`,
	  `setIdArity`,
	  `setIdDemandInfo`,
	  `setIdStrictness`,
97
	  `setIdWorkerInfo`,
98 99
	  `setIdSpecialisation`,
	  `setIdUpdateInfo`,
100 101 102 103
	  `setInlinePragma`,
	  `getIdCafInfo`,
	  `getIdCprInfo`

104
	-- infixl so you can say (id `set` a `set` b)
105 106 107
\end{code}


108

109 110
%************************************************************************
%*									*
111
\subsection{Simple Id construction}
112 113 114
%*									*
%************************************************************************

115 116 117 118
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 
119

120 121 122 123 124 125 126
\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}
127

128 129 130
\begin{code}
mkVanillaId :: Name -> Type -> Id
mkVanillaId name ty = mkId name ty vanillaIdInfo
131 132 133

-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
134
mkUserLocal :: OccName     -> Unique -> Type -> SrcLoc -> Id
135
mkSysLocal  :: FAST_STRING -> Unique -> Type -> Id
136

137 138
mkSysLocal  fs uniq ty      = mkVanillaId (mkSysLocalName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName    uniq occ loc) ty
139
\end{code}
140 141 142 143 144 145

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}
146 147
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
148
mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
149 150

-- "Template locals" typically used in unfoldings
151
mkTemplateLocals :: [Type] -> [Id]
152
mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
153 154
			       (getBuiltinUniques (length tys))
			       tys
155 156 157

mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
158 159 160
\end{code}


161 162 163 164 165 166 167
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

\begin{code}
168
idFreeTyVars :: Id -> TyVarSet
169
idFreeTyVars id = tyVarsOfType (idType id)
170

171
setIdType :: Id -> Type -> Id
172
	-- Add free tyvar info to the type
173
setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
sof's avatar
sof committed
174

175 176
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
177 178 179 180 181
\end{code}


%************************************************************************
%*									*
182
\subsection{Special Ids}
183 184 185
%*									*
%************************************************************************

sof's avatar
sof committed
186
\begin{code}
187 188 189 190 191 192 193
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

194
recordSelectorFieldLabel :: Id -> FieldLabel
195
recordSelectorFieldLabel id = case idFlavour id of
196
				RecordSelId lbl -> lbl
sof's avatar
sof committed
197

198
isRecordSelector id = case idFlavour id of
199 200
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
201

202
isPrimitiveId_maybe id = case idFlavour id of
203 204
			    ConstantId (PrimOp op) -> Just op
			    other		   -> Nothing
sof's avatar
sof committed
205

206
isDataConId_maybe id = case idFlavour id of
207 208
			  ConstantId (DataCon con) -> Just con
			  other		           -> Nothing
sof's avatar
sof committed
209

210
isConstantId id = case idFlavour id of
211 212
		    ConstantId _ -> True
		    other	 -> False
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228

isSpecPragmaId id = case idFlavour id of
			SpecPragmaId -> True
			other	     -> False

-- 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)
229 230
\end{code}

231

232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
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!
252 253 254 255 256 257

-- 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
258 259 260 261
\end{code}



262 263
%************************************************************************
%*									*
264
\subsection{IdInfo stuff}
265 266 267
%*									*
%************************************************************************

268
\begin{code}
269 270
	---------------------------------
	-- ARITY
271
getIdArity :: Id -> ArityInfo
272
getIdArity id = arityInfo (idInfo id)
273

274
setIdArity :: Id -> ArityInfo -> Id
275
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
276

277 278
	---------------------------------
	-- STRICTNESS
279
getIdStrictness :: Id -> StrictnessInfo
280
getIdStrictness id = strictnessInfo (idInfo id)
281

282
setIdStrictness :: Id -> StrictnessInfo -> Id
283
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
284

285 286 287 288 289 290
-- 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
291

292 293 294 295 296 297
	---------------------------------
	-- WORKER ID
getIdWorkerInfo :: Id -> WorkerInfo
getIdWorkerInfo id = workerInfo (idInfo id)

setIdWorkerInfo :: Id -> WorkerInfo -> Id
298
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
299

300 301
	---------------------------------
	-- UNFOLDING
302
getIdUnfolding :: Id -> Unfolding
303
getIdUnfolding id = unfoldingInfo (idInfo id)
304

305
setIdUnfolding :: Id -> Unfolding -> Id
306
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
307

308 309
	---------------------------------
	-- DEMAND
310
getIdDemandInfo :: Id -> Demand
311
getIdDemandInfo id = demandInfo (idInfo id)
312

313
setIdDemandInfo :: Id -> Demand -> Id
314
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
315

316 317
	---------------------------------
	-- UPDATE INFO
318
getIdUpdateInfo :: Id -> UpdateInfo
319
getIdUpdateInfo id = updateInfo (idInfo id)
320

321
setIdUpdateInfo :: Id -> UpdateInfo -> Id
322
setIdUpdateInfo id upd_info = modifyIdInfo (`setUpdateInfo` upd_info) id
323

324 325
	---------------------------------
	-- SPECIALISATION
326
getIdSpecialisation :: Id -> CoreRules
327
getIdSpecialisation id = specInfo (idInfo id)
328

329 330
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
331

332 333
	---------------------------------
	-- CAF INFO
334
getIdCafInfo :: Id -> CafInfo
335
getIdCafInfo id = cafInfo (idInfo id)
336

337
setIdCafInfo :: Id -> CafInfo -> Id
338
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
339 340 341 342 343 344 345

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

setIdCprInfo :: Id -> CprInfo -> Id
346
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
347 348
\end{code}

sof's avatar
sof committed
349

350 351 352 353
	---------------------------------
	-- 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.
354 355

\begin{code}
356
getInlinePragma :: Id -> InlinePragInfo
357
getInlinePragma id = inlinePragInfo (idInfo id)
358

359
setInlinePragma :: Id -> InlinePragInfo -> Id
360
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
361

362
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
363
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
364

365 366 367 368
idMustNotBeINLINEd id = case getInlinePragma id of
			  IMustNotBeINLINEd -> True
			  IAmALoopBreaker   -> True
			  other		    -> False
369

370 371 372
idMustBeINLINEd id =  case getInlinePragma id of
			IMustBeINLINEd -> True
			other	       -> False
373
\end{code}
374 375 376 377 378 379 380 381


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
isOneShotLambda :: Id -> Bool
isOneShotLambda id = case lbvarInfo (idInfo id) of
			IsOneShotLambda -> True
382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
			NoLBVarInfo	-> idType id == realWorldStatePrimTy
	-- 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.
	--	
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
397 398 399 400

setOneShotLambda :: Id -> Id
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
\end{code}