Id.lhs 13.6 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
	mkId, mkVanillaId, mkSysLocal, mkUserLocal,
12
	mkTemplateLocals, mkTemplateLocalsNum, 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
	isImplicitId, isDeadBinder,
26
	externallyVisibleId,
27
	isIP,
28
	isSpecPragmaId,	isRecordSelector,
29 30 31
	isPrimOpId, isPrimOpId_maybe, isDictFunId,
	isDataConId, isDataConId_maybe, 
	isDataConWrapId, isDataConWrapId_maybe,
32
	isBottomingId,
33
	isExportedId, isLocalId, 
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 51
	setIdSpecialisation,
	setIdCafInfo,
52
	setIdCprInfo,
53
	setIdOccInfo,
54

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

68
    ) where
69

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


73
import CoreSyn		( Unfolding, CoreRules )
74
import BasicTypes	( Arity )
75 76 77 78
import Var		( Id, DictId,
			  isId, mkIdVar,
			  idName, idType, idUnique, idInfo,
			  setIdName, setVarType, setIdUnique, 
79 80
			  setIdInfo, lazySetIdInfo, modifyIdInfo, 
			  maybeModifyIdInfo,
81 82
			  externallyVisibleId
			)
83
import Type		( Type, typePrimRep, addFreeTyVars, 
84
                          usOnce, seqType, splitTyConApp_maybe )
85 86 87

import IdInfo 

88
import Demand		( Demand )
sof's avatar
sof committed
89
import Name	 	( Name, OccName,
90
			  mkSysLocalName, mkLocalName,
91
			  nameIsLocallyDefined,
92
			  getOccName, isIPOcc
sof's avatar
sof committed
93
			) 
94
import OccName		( UserFS )
95
import PrimRep		( PrimRep )
96
import TysPrim		( statePrimTyCon )
97
import FieldLabel	( FieldLabel )
98
import SrcLoc		( SrcLoc )
99 100
import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques, 
			  getNumBuiltinUniques )
101
import Outputable
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 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
\begin{code}
mkId :: Name -> Type -> IdInfo -> Id
132
mkId name ty info = mkIdVar name (addFreeTyVars ty) info
133
\end{code}
134

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

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

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

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

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

163 164 165 166 167
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
mkTemplateLocalsNum n tys = zipWith (mkSysLocal SLIT("tpl"))
			       (getNumBuiltinUniques n (length tys))
			       tys

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


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

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

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


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

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

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

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

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

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

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

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

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

239
hasNoBinding id = case idFlavour id of
240 241 242
			DataConId _ -> True
			PrimOpId _  -> True
			other	    -> False
243
	-- hasNoBinding returns True of an Id which may not have a
244 245 246
	-- binding, even though it is defined in this module.  Notably,
	-- the constructors of a dictionary are in this situation.

247 248 249 250
isDictFunId id = case idFlavour id of
		   DictFunId -> True
		   other     -> False

251 252
-- Don't drop a binding for an exported Id,
-- if it otherwise looks dead.  
253
-- Perhaps a better name would be isDiscardableId
254
isExportedId :: Id -> Bool
255 256 257 258 259 260 261
isExportedId id = case idFlavour id of
			VanillaId  -> False
			other	   -> True

isLocalId :: Id -> Bool
-- True of Ids that are locally defined, but are not constants
-- like data constructors, record selectors, and the like. 
262
-- See comments with CoreFVs.isLocalVar
263 264 265 266 267 268 269 270 271 272
isLocalId id 
#ifdef DEBUG
  | not (isId id) = pprTrace "isLocalid" (ppr id) False
  | otherwise
#endif
  = case idFlavour id of
	 VanillaId    -> True
	 ExportedId   -> True
	 SpecPragmaId -> True
	 other	      -> False
273 274
\end{code}

275

276 277 278
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.
279 280

\begin{code}
281 282
isImplicitId :: Id -> Bool
isImplicitId id
283 284 285 286 287 288
  = ASSERT2( not (omit && nameIsLocallyDefined (idName id)
                       && idTyGenInfo id /= TyGenNever),
             ppr id )
    -- mustn't omit type signature for a name whose type might change!
    omit
  where
289
    omit = isImplicitId' id
290

291
isImplicitId' id
292
  = case idFlavour id of
293 294 295 296 297
	RecordSelId _   -> True	-- Includes dictionary selectors
        PrimOpId _      -> True
        DataConId _     -> True
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
298 299 300 301
		-- 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

302 303 304 305 306 307
	ConstantId -> False	-- Ordinary Ids
	DictFunId  -> False
	
	ExportedId   -> False	-- I don't think these happen
	VanillaId    -> False	-- ditto
	SpecPragmaId -> False 	-- ditto
308 309 310 311
\end{code}

\begin{code}
isDeadBinder :: Id -> Bool
312
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
313
		  | otherwise = False	-- TyVars count as not dead
314 315

isIP id = isIPOcc (getOccName id)
316 317 318
\end{code}


319 320
%************************************************************************
%*									*
321
\subsection{IdInfo stuff}
322 323 324
%*									*
%************************************************************************

325
\begin{code}
326 327
	---------------------------------
	-- ARITY
328 329 330 331 332
idArityInfo :: Id -> ArityInfo
idArityInfo id = arityInfo (idInfo id)

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

334 335
setIdArityInfo :: Id -> ArityInfo -> Id
setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
336

337 338
	---------------------------------
	-- STRICTNESS
339 340
idStrictness :: Id -> StrictnessInfo
idStrictness id = strictnessInfo (idInfo id)
341

342
setIdStrictness :: Id -> StrictnessInfo -> Id
343
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
344

345 346
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
347
isBottomingId id = isBottomingStrictness (idStrictness id)
348

349 350 351 352 353 354 355 356
	---------------------------------
	-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)

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

357 358
	---------------------------------
	-- WORKER ID
359 360
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
361 362

setIdWorkerInfo :: Id -> WorkerInfo -> Id
363
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
364

365 366
	---------------------------------
	-- UNFOLDING
367 368
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
369

370
setIdUnfolding :: Id -> Unfolding -> Id
371
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
372

373 374
	---------------------------------
	-- DEMAND
375 376
idDemandInfo :: Id -> Demand
idDemandInfo id = demandInfo (idInfo id)
377

378
setIdDemandInfo :: Id -> Demand -> Id
379
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
380

381 382
	---------------------------------
	-- SPECIALISATION
383 384
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
385

386 387
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
388

389 390
	---------------------------------
	-- CAF INFO
391 392
idCafInfo :: Id -> CafInfo
idCafInfo id = cafInfo (idInfo id)
393

394
setIdCafInfo :: Id -> CafInfo -> Id
395
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
396 397 398

	---------------------------------
	-- CPR INFO
399 400
idCprInfo :: Id -> CprInfo
idCprInfo id = cprInfo (idInfo id)
401 402

setIdCprInfo :: Id -> CprInfo -> Id
403
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
404 405 406

	---------------------------------
	-- Occcurrence INFO
407 408
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
409 410 411

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

sof's avatar
sof committed
414

415 416 417 418
	---------------------------------
	-- 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.
419 420

\begin{code}
421 422
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
423

424
setInlinePragma :: Id -> InlinePragInfo -> Id
425
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
426

427
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
428
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
429
\end{code}
430 431 432 433 434


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
435 436 437
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

438
isOneShotLambda :: Id -> Bool
439 440 441 442 443 444 445 446
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

447 448 449 450 451 452 453 454 455 456 457
	-- 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.
458
	--
459 460
	-- It would be better to spot that r was one-shot to start with, but
	-- I don't want to rely on that.
461 462 463
	--
	-- 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.
464 465

setOneShotLambda :: Id -> Id
466
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
467 468 469 470 471 472 473 474 475

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
476
\end{code}
477 478 479 480 481 482 483 484 485

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

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