Id.lhs 14.1 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
	mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
12
	mkSysLocal, mkSysLocalUnencoded, 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, setIdLocalExported, 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
	isFCallId, isFCallId_maybe,
32
	isDataConWorkId, isDataConWorkId_maybe, 
33 34
	isBottomingId, idIsFrom,
	hasNoBinding, 
35 36 37 38

	-- Inline pragma stuff
	idInlinePragma, setInlinePragma, modifyInlinePragma, 

39

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

43 44
	-- IdInfo stuff
	setIdUnfolding,
45
	setIdArity,
46 47
	setIdNewDemandInfo, 
	setIdNewStrictness, zapIdNewStrictness,
48
	setIdWorkerInfo,
49
	setIdSpecialisation,
50
	setIdCafInfo,
51
	setIdOccInfo,
52

53
#ifdef OLD_STRICTNESS
54 55 56 57 58 59 60 61
	idDemandInfo, 
	idStrictness, 
	idCprInfo,
	setIdStrictness, 
	setIdDemandInfo, 
	setIdCprInfo,
#endif

62
	idArity, 
63
	idNewDemandInfo, idNewDemandInfo_maybe,
64
	idNewStrictness, idNewStrictness_maybe, 
65 66
	idWorkerInfo,
	idUnfolding,
67
	idSpecialisation, idCoreRules,
68 69
	idCafInfo,
	idLBVarInfo,
70
	idOccInfo,
71

72
#ifdef OLD_STRICTNESS
73
	newStrictnessFromOld 	-- Temporary
74
#endif
75

76
    ) where
77

78
#include "HsVersions.h"
sof's avatar
sof committed
79 80


81
import CoreSyn		( Unfolding, CoreRules, IdCoreRule, rulesRules )
82
import BasicTypes	( Arity )
83
import Var		( Id, DictId,
84 85
			  isId, isExportedId, isSpecPragmaId, isLocalId,
			  idName, idType, idUnique, idInfo, isGlobalId,
86
			  setIdName, setVarType, setIdUnique, setIdLocalExported,
87 88
			  setIdInfo, lazySetIdInfo, modifyIdInfo, 
			  maybeModifyIdInfo,
89
			  globalIdDetails, setGlobalIdDetails
90
			)
91
import qualified Var	( mkLocalId, mkGlobalId, mkSpecPragmaId )
92
import Type		( Type, typePrimRep, addFreeTyVars, seqType)
93 94 95

import IdInfo 

96
#ifdef OLD_STRICTNESS
97
import qualified Demand	( Demand )
98
#endif
99
import DataCon		( isUnboxedTupleCon )
100
import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
101
import Name	 	( Name, OccName, nameIsLocalOrFrom, 
102
			  mkSystemName, mkSystemNameEncoded, mkInternalName,
103
			  getOccName, getSrcLoc
sof's avatar
sof committed
104
			) 
105
import Module		( Module )
106
import OccName		( EncodedFS, mkWorkerOcc )
107
import PrimRep		( PrimRep )
108
import FieldLabel	( FieldLabel )
109
import Maybes		( orElse )
110
import SrcLoc		( SrcLoc )
111
import Outputable
112
import Unique		( Unique, mkBuiltinUnique )
113

114
-- infixl so you can say (id `set` a `set` b)
115
infixl 	1 `setIdUnfolding`,
116
	  `setIdArity`,
117 118
	  `setIdNewDemandInfo`,
	  `setIdNewStrictness`,
119
	  `setIdWorkerInfo`,
120
	  `setIdSpecialisation`,
121
	  `setInlinePragma`,
122
	  `idCafInfo`
123
#ifdef OLD_STRICTNESS
124 125 126 127
	  ,`idCprInfo`
	  ,`setIdStrictness`
	  ,`setIdDemandInfo`
#endif
128 129 130
\end{code}


131

132 133
%************************************************************************
%*									*
134
\subsection{Simple Id construction}
135 136 137
%*									*
%************************************************************************

138 139 140
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.
141

142
\begin{code}
143 144 145
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info

146 147
mkSpecPragmaId :: Name -> Type -> Id
mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
148 149 150

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

153
\begin{code}
154
mkLocalId :: Name -> Type -> Id
155
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
156 157 158

-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
159
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
160
mkSysLocal  :: EncodedFS  -> Unique -> Type -> Id
161
mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
162

163 164
-- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again.
165 166 167 168 169
mkSysLocal          fs uniq ty = mkLocalId (mkSystemNameEncoded uniq fs) ty

-- version to use when the faststring needs to be encoded
mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemName uniq fs)        ty

170
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
171
mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
172
\end{code}
173 174 175 176

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.
177
 
178
\begin{code}
179 180
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
181
mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
182

183
mkWorkerId :: Unique -> Id -> Type -> Id
184
-- A worker gets a local name.  CoreTidy will externalise it if necessary.
185 186 187
mkWorkerId uniq unwrkr ty
  = mkLocalId wkr_name ty
  where
188
    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
189

190
-- "Template locals" typically used in unfoldings
191
mkTemplateLocals :: [Type] -> [Id]
192
mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
193

194
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
195
-- The Int gives the starting point for unique allocation
196
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
197

198
mkTemplateLocal :: Int -> Type -> Id
199
mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
200 201 202
\end{code}


203 204 205 206 207 208 209
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

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

214 215
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
216 217 218 219 220
\end{code}


%************************************************************************
%*									*
221
\subsection{Special Ids}
222 223 224
%*									*
%************************************************************************

225 226 227 228 229 230 231 232 233
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.
234 235


236
\begin{code}
237
recordSelectorFieldLabel :: Id -> FieldLabel
238 239
recordSelectorFieldLabel id = case globalIdDetails id of
				 RecordSelId lbl -> lbl
240
				 other -> panic "recordSelectorFieldLabel"
sof's avatar
sof committed
241

242
isRecordSelector id = case globalIdDetails id of
243 244
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
245

246
isPrimOpId id = case globalIdDetails id of
247 248 249
		    PrimOpId op -> True
		    other	-> False

250
isPrimOpId_maybe id = case globalIdDetails id of
251 252 253
			    PrimOpId op -> Just op
			    other	-> Nothing

254 255 256 257 258 259 260 261
isFCallId id = case globalIdDetails id of
		    FCallId call -> True
		    other	 -> False

isFCallId_maybe id = case globalIdDetails id of
			    FCallId call -> Just call
			    other	 -> Nothing

262 263 264
isDataConWorkId id = case globalIdDetails id of
			DataConWorkId _ -> True
			other	        -> False
sof's avatar
sof committed
265

266 267 268
isDataConWorkId_maybe id = case globalIdDetails id of
			  DataConWorkId con -> Just con
			  other	            -> Nothing
sof's avatar
sof committed
269

270 271 272 273
-- hasNoBinding returns True of an Id which may not have a
-- binding, even though it is defined in this module.  
-- Data constructor workers used to be things of this kind, but
-- they aren't any more.  Instead, we inject a binding for 
274 275
-- them at the CorePrep stage. 
-- EXCEPT: unboxed tuples, which definitely have no binding
276
hasNoBinding id = case globalIdDetails id of
277 278 279 280
			PrimOpId _  	 -> True
			FCallId _   	 -> True
			DataConWorkId dc -> isUnboxedTupleCon dc
			other	         -> False
281

282
isImplicitId :: Id -> Bool
283 284 285
	-- 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.
286
isImplicitId id
287
  = case globalIdDetails id of
288
	RecordSelId _   -> True
289
        FCallId _       -> True
290
        PrimOpId _      -> True
291
	ClassOpId _	-> True
292
        DataConWorkId _ -> True
293 294
	DataConWrapId _ -> True
		-- These are are implied by their type or class decl;
295
		-- remember that all type and class decls appear in the interface file.
296 297
		-- The dfun id is not an implicit Id; it must *not* be omitted, because 
		-- it carries version info for the instance decl
298
	other		-> False
299 300 301

idIsFrom :: Module -> Id -> Bool
idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
302 303 304 305
\end{code}

\begin{code}
isDeadBinder :: Id -> Bool
306
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
307
		  | otherwise = False	-- TyVars count as not dead
308 309 310
\end{code}


311 312
%************************************************************************
%*									*
313
\subsection{IdInfo stuff}
314 315 316
%*									*
%************************************************************************

317
\begin{code}
318 319
	---------------------------------
	-- ARITY
320
idArity :: Id -> Arity
321
idArity id = arityInfo (idInfo id)
322

323 324
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
325

326
#ifdef OLD_STRICTNESS
327
	---------------------------------
328
	-- (OLD) STRICTNESS 
329
idStrictness :: Id -> StrictnessInfo
330
idStrictness id = strictnessInfo (idInfo id)
331

332
setIdStrictness :: Id -> StrictnessInfo -> Id
333
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
334
#endif
335

336 337
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
338 339 340 341 342 343 344 345 346 347
isBottomingId id = isBottomingSig (idNewStrictness id)

idNewStrictness_maybe :: Id -> Maybe StrictSig
idNewStrictness :: Id -> StrictSig

idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig

setIdNewStrictness :: Id -> StrictSig -> Id
setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
348

349 350 351
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id

352
	---------------------------------
353
	-- WORKER ID
354 355
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
356 357

setIdWorkerInfo :: Id -> WorkerInfo -> Id
358
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
359

360 361
	---------------------------------
	-- UNFOLDING
362 363
idUnfolding :: Id -> Unfolding
idUnfolding id = unfoldingInfo (idInfo id)
364

365
setIdUnfolding :: Id -> Unfolding -> Id
366
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
sof's avatar
sof committed
367

368
#ifdef OLD_STRICTNESS
369
	---------------------------------
370
	-- (OLD) DEMAND
371
idDemandInfo :: Id -> Demand.Demand
372
idDemandInfo id = demandInfo (idInfo id)
373

374
setIdDemandInfo :: Id -> Demand.Demand -> Id
375
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
376
#endif
377

378 379 380 381 382
idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
idNewDemandInfo       :: Id -> NewDemand.Demand

idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
383 384

setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
385
setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
386

387 388
	---------------------------------
	-- SPECIALISATION
389 390
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (idInfo id)
391

392 393 394
idCoreRules :: Id -> [IdCoreRule]
idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]

395 396
setIdSpecialisation :: Id -> CoreRules -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
397

398 399
	---------------------------------
	-- CAF INFO
400
idCafInfo :: Id -> CafInfo
401
#ifdef OLD_STRICTNESS
402 403 404 405
idCafInfo id = case cgInfo (idInfo id) of
		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
		  info     -> cgCafInfo info
#else
406
idCafInfo id = cafInfo (idInfo id)
407
#endif
408 409 410 411

setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id

412 413
	---------------------------------
	-- CPR INFO
414
#ifdef OLD_STRICTNESS
415
idCprInfo :: Id -> CprInfo
416
idCprInfo id = cprInfo (idInfo id)
417 418

setIdCprInfo :: Id -> CprInfo -> Id
419
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
420
#endif
421 422 423

	---------------------------------
	-- Occcurrence INFO
424 425
idOccInfo :: Id -> OccInfo
idOccInfo id = occInfo (idInfo id)
426 427 428

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

sof's avatar
sof committed
431

432 433 434 435
	---------------------------------
	-- 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.
436 437

\begin{code}
438 439
idInlinePragma :: Id -> InlinePragInfo
idInlinePragma id = inlinePragInfo (idInfo id)
440

441
setInlinePragma :: Id -> InlinePragInfo -> Id
442
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
443

444
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
445
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
446
\end{code}
447 448 449 450 451


	---------------------------------
	-- ONE-SHOT LAMBDAS
\begin{code}
452 453 454
idLBVarInfo :: Id -> LBVarInfo
idLBVarInfo id = lbvarInfo (idInfo id)

455
isOneShotLambda :: Id -> Bool
456 457 458
isOneShotLambda id = case idLBVarInfo id of
                       IsOneShotLambda  -> True
                       NoLBVarInfo      -> False
459 460

setOneShotLambda :: Id -> Id
461
setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
462 463 464 465 466 467 468 469 470

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
471
\end{code}
472 473 474 475 476

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

477 478
zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
\end{code}
479