Id.lhs 13.2 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, isDeadBinder,
26
	exportWithOrigOccName,
27
	externallyVisibleId,
28 29
	idFreeTyVars,
	isIP,
30 31

	-- Inline pragma stuff
32
	idInlinePragma, setInlinePragma, modifyInlinePragma, 
33

34
	isSpecPragmaId,	isRecordSelector,
35 36 37
	isPrimOpId, isPrimOpId_maybe, 
	isDataConId, isDataConId_maybe, isDataConWrapId, isDataConWrapId_maybe,
	isBottomingId,
38
	isExportedId, isUserExportedId,
39
	mayHaveNoBinding,
40

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

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

56 57 58 59 60 61 62 63 64 65 66 67
	idArity, idArityInfo, 
	idFlavour,
	idDemandInfo,
	idStrictness,
	idWorkerInfo,
	idUnfolding,
	idSpecialisation,
	idUpdateInfo,
	idCafInfo,
	idCprInfo,
	idLBVarInfo,
	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 77 78 79
import Var		( Id, DictId,
			  isId, mkIdVar,
			  idName, idType, idUnique, idInfo,
			  setIdName, setVarType, setIdUnique, 
80
			  setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
81 82 83
			  externallyVisibleId
			)
import VarSet
84 85 86 87
import Type		( Type, tyVarsOfType, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )

import IdInfo 

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

103
infixl 	1 `setIdUnfolding`,
104
	  `setIdArityInfo`,
105 106
	  `setIdDemandInfo`,
	  `setIdStrictness`,
107
	  `setIdWorkerInfo`,
108 109
	  `setIdSpecialisation`,
	  `setIdUpdateInfo`,
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 128
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 
129

130 131 132 133 134 135 136
\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}
137

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

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

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

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}
156 157
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
158
mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
159 160

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

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


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

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

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

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


%************************************************************************
%*									*
192
\subsection{Special Ids}
193 194 195
%*									*
%************************************************************************

sof's avatar
sof committed
196
\begin{code}
197 198 199 200 201 202 203
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

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

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

212 213 214 215 216 217 218 219 220 221 222
isPrimOpId id = case idFlavour id of
		    PrimOpId op -> True
		    other	-> False

isPrimOpId_maybe id = case idFlavour id of
			    PrimOpId op -> Just op
			    other	-> Nothing

isDataConId id = case idFlavour id of
			DataConId _ -> True
			other	    -> False
sof's avatar
sof committed
223

224
isDataConId_maybe id = case idFlavour id of
225 226
			  DataConId con -> Just con
			  other	        -> Nothing
sof's avatar
sof committed
227

228 229 230
isDataConWrapId_maybe id = case idFlavour id of
				  DataConWrapId con -> Just con
				  other	            -> Nothing
231

232 233 234
isDataConWrapId id = case idFlavour id of
			DataConWrapId con -> True
			other	          -> False
235

236 237 238 239
isSpecPragmaId id = case idFlavour id of
			SpecPragmaId -> True
			other	     -> False

240 241 242 243
mayHaveNoBinding id = case idFlavour id of
			DataConId _ -> True
			PrimOpId _  -> True
			other	    -> False
244 245 246 247 248 249 250
	-- 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.

251 252 253 254 255 256 257 258 259 260 261
-- 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)
262 263
\end{code}

264

265 266 267 268 269 270 271 272 273 274 275 276
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
277 278 279 280 281
	RecordSelId _   -> True	-- Includes dictionary selectors
        PrimOpId _      -> True
        DataConId _     -> True
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
282 283 284 285 286
		-- 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!
287 288 289 290 291 292

-- 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
293 294 295 296 297 298 299 300
\end{code}

\begin{code}
isDeadBinder :: Id -> Bool
isDeadBinder bndr | isId bndr = case idOccInfo bndr of
					IAmDead -> True
					other	-> False
		  | otherwise = False	-- TyVars count as not dead
301 302

isIP id = isIPOcc (getOccName id)
303 304 305
\end{code}


306 307
%************************************************************************
%*									*
308
\subsection{IdInfo stuff}
309 310 311
%*									*
%************************************************************************

312
\begin{code}
313 314
	---------------------------------
	-- ARITY
315 316 317 318 319
idArityInfo :: Id -> ArityInfo
idArityInfo id = arityInfo (idInfo id)

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

321 322
setIdArityInfo :: Id -> ArityInfo -> Id
setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
323

324 325
	---------------------------------
	-- STRICTNESS
326 327
idStrictness :: Id -> StrictnessInfo
idStrictness id = strictnessInfo (idInfo id)
328

329
setIdStrictness :: Id -> StrictnessInfo -> Id
330
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
331

332 333
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
334
isBottomingId id = isBottomingStrictness (idStrictness id)
335

336 337
	---------------------------------
	-- WORKER ID
338 339
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
340 341

setIdWorkerInfo :: Id -> WorkerInfo -> Id
342
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
343

344 345
	---------------------------------
	-- UNFOLDING
346 347
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
348

349
setIdUnfolding :: Id -> Unfolding -> Id
350
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
351

352 353
	---------------------------------
	-- DEMAND
354 355
idDemandInfo :: Id -> Demand
idDemandInfo id = demandInfo (idInfo id)
356

357
setIdDemandInfo :: Id -> Demand -> Id
358
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
359

360 361
	---------------------------------
	-- UPDATE INFO
362 363
idUpdateInfo :: Id -> UpdateInfo
idUpdateInfo id = updateInfo (idInfo id)
364

365
setIdUpdateInfo :: Id -> UpdateInfo -> Id
366
setIdUpdateInfo id upd_info = modifyIdInfo (`setUpdateInfo` upd_info) id
367

368 369
	---------------------------------
	-- SPECIALISATION
370 371
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
372

373 374
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
375

376 377
	---------------------------------
	-- CAF INFO
378 379
idCafInfo :: Id -> CafInfo
idCafInfo id = cafInfo (idInfo id)
380

381
setIdCafInfo :: Id -> CafInfo -> Id
382
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
383 384 385

	---------------------------------
	-- CPR INFO
386 387
idCprInfo :: Id -> CprInfo
idCprInfo id = cprInfo (idInfo id)
388 389

setIdCprInfo :: Id -> CprInfo -> Id
390
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
391 392 393

	---------------------------------
	-- Occcurrence INFO
394 395
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
396 397 398

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

sof's avatar
sof committed
401

402 403 404 405
	---------------------------------
	-- 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.
406 407

\begin{code}
408 409
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
410

411
setInlinePragma :: Id -> InlinePragInfo -> Id
412
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
413

414
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
415
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
416
\end{code}
417 418 419 420 421


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
422 423 424
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

425
isOneShotLambda :: Id -> Bool
426
isOneShotLambda id = case idLBVarInfo id of
427
			IsOneShotLambda -> True
428 429 430
			NoLBVarInfo	-> case splitTyConApp_maybe (idType id) of
						Just (tycon,_) -> tycon == statePrimTyCon
						other	       -> False
431 432 433 434 435 436 437 438 439 440 441
	-- 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.
442
	--
443 444
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
445 446 447
	--
	-- 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.
448 449 450

setOneShotLambda :: Id -> Id
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
451 452 453 454 455 456 457 458 459

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
460
\end{code}
461 462 463 464 465 466 467 468 469

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

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