Id.lhs 8.69 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 11
	-- Simple construction
	mkVanillaId, mkImportedId, mkSysLocal, mkUserLocal,
12
	mkTemplateLocals, mkTemplateLocal, mkWildId, mkUserId,
13 14

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

19
	-- Modifying an Id
20
	setIdName, setIdUnique, setIdType, setIdInfo,
21 22

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

	-- Inline pragma stuff
	getInlinePragma, setInlinePragma, modifyInlinePragma, 
	idWantsToBeINLINEd, idMustBeINLINEd, idMustNotBeINLINEd,
	isSpecPragmaId,
31
	
32 33 34 35

	isRecordSelector,
	isPrimitiveId_maybe, isDataConId_maybe,
	isConstantId,
36
	isBottomingId, idAppIsBottom,
37 38 39 40 41 42 43 44 45 46

	-- IdInfo stuff
	setIdUnfolding,
	setIdArity,
	setIdDemandInfo,
	setIdStrictness,
	setIdSpecialisation,
	setIdUpdateInfo,
	setIdCafInfo,

47 48 49 50
	getIdArity,
	getIdDemandInfo,
	getIdStrictness,
	getIdUnfolding,
51
	getIdSpecialisation,
52 53
	getIdUpdateInfo,
	getIdCafInfo
54

55
    ) where
56

57
#include "HsVersions.h"
sof's avatar
sof committed
58

sof's avatar
sof committed
59
import {-# SOURCE #-} CoreUnfold ( Unfolding )
sof's avatar
sof committed
60

61
import Var		( Id, DictId, VarDetails(..), 
62
			  isId, mkId, 
63
			  idName, idType, idUnique, idInfo, idDetails,
64 65 66 67
			  setIdName, setVarType, setIdUnique, setIdInfo, modifyIdInfo,
			  externallyVisibleId
			)
import VarSet
68
import Type		( Type, tyVarsOfType, typePrimRep, addFreeTyVars )
69
import IdInfo
70
import Demand		( Demand )
sof's avatar
sof committed
71
import Name	 	( Name, OccName,
72
			  mkSysLocalName, mkLocalName,
73
			  isWiredInName
sof's avatar
sof committed
74
			) 
75 76
import Const		( Con(..) )
import PrimRep		( PrimRep )
77
import PrimOp		( PrimOp )
78
import FieldLabel	( FieldLabel(..) )
79
import SrcLoc		( SrcLoc )
80
import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques )
81
import Outputable
82

83 84 85 86 87 88 89 90
infixl 	1 `setIdUnfolding`,
	  `setIdArity`,
	  `setIdDemandInfo`,
	  `setIdStrictness`,
	  `setIdSpecialisation`,
	  `setIdUpdateInfo`,
	  `setInlinePragma`
	-- infixl so you can say (id `set` a `set` b)
91 92 93
\end{code}


94

95 96
%************************************************************************
%*									*
97
\subsection{Simple Id construction}
98 99 100
%*									*
%************************************************************************

101
\begin{code}
102 103
mkVanillaId :: Name -> Type -> Id
mkVanillaId name ty = mkId name (addFreeTyVars ty) VanillaId noIdInfo
104 105

mkImportedId :: Name -> Type -> IdInfo -> Id
106
mkImportedId name ty info = mkId name (addFreeTyVars ty) VanillaId info
107

108
mkUserId :: Name -> Type -> Id
109 110 111 112
mkUserId name ty = mkVanillaId name ty

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

116 117
mkSysLocal  fs uniq ty      = mkVanillaId (mkSysLocalName uniq fs)      ty
mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName    uniq occ loc) ty
118
\end{code}
119 120 121 122 123 124

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}
125 126
-- "Wild Id" typically used when you need a binder that you don't expect to use
mkWildId :: Type -> Id
127
mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
128 129

-- "Template locals" typically used in unfoldings
130
mkTemplateLocals :: [Type] -> [Id]
131
mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
132 133
			       (getBuiltinUniques (length tys))
			       tys
134 135 136

mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
137 138 139
\end{code}


140 141 142 143 144 145 146
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

\begin{code}
147
idFreeTyVars :: Id -> TyVarSet
148
idFreeTyVars id = tyVarsOfType (idType id)
149

150
setIdType :: Id -> Type -> Id
151 152
	-- Add free tyvar info to the type
setIdType id ty = setVarType id (addFreeTyVars ty)
sof's avatar
sof committed
153

154 155
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
156 157
\end{code}

158 159 160 161
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.

162
\begin{code}
163 164 165
omitIfaceSigForId :: Id -> Bool
omitIfaceSigForId id
  | isWiredInName (idName id)
166 167 168
  = True

  | otherwise
169
  = case idDetails id of
170 171 172 173 174 175 176 177
	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!
178 179 180 181
\end{code}

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

sof's avatar
sof committed
186
\begin{code}
187
recordSelectorFieldLabel :: Id -> FieldLabel
188
recordSelectorFieldLabel id = case idDetails id of
189
				RecordSelId lbl -> lbl
sof's avatar
sof committed
190

191
isRecordSelector id = case idDetails id of
192 193
			RecordSelId lbl -> True
			other	  	-> False
sof's avatar
sof committed
194

195
isPrimitiveId_maybe id = case idDetails id of
196 197
			    ConstantId (PrimOp op) -> Just op
			    other		   -> Nothing
sof's avatar
sof committed
198

199
isDataConId_maybe id = case idDetails id of
200 201
			  ConstantId (DataCon con) -> Just con
			  other		           -> Nothing
sof's avatar
sof committed
202

203
isConstantId id = case idDetails id of
204 205
		    ConstantId _ -> True
		    other	 -> False
206 207
\end{code}

208 209 210

%************************************************************************
%*									*
211
\subsection{IdInfo stuff}
212 213 214
%*									*
%************************************************************************

215
\begin{code}
216 217
	---------------------------------
	-- ARITY
218
getIdArity :: Id -> ArityInfo
219
getIdArity id = arityInfo (idInfo id)
220

221
setIdArity :: Id -> ArityInfo -> Id
222
setIdArity id arity = modifyIdInfo id (arity `setArityInfo`)
223

224 225
	---------------------------------
	-- STRICTNESS
226
getIdStrictness :: Id -> StrictnessInfo
227
getIdStrictness id = strictnessInfo (idInfo id)
228

229
setIdStrictness :: Id -> StrictnessInfo -> Id
230
setIdStrictness id strict_info = modifyIdInfo id (strict_info `setStrictnessInfo`)
231

232 233 234 235 236 237
-- 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
238

239 240
	---------------------------------
	-- UNFOLDING
241
getIdUnfolding :: Id -> Unfolding
242
getIdUnfolding id = unfoldingInfo (idInfo id)
243

244
setIdUnfolding :: Id -> Unfolding -> Id
245
setIdUnfolding id unfolding = modifyIdInfo id (unfolding `setUnfoldingInfo`)
sof's avatar
sof committed
246

247 248
	---------------------------------
	-- DEMAND
249
getIdDemandInfo :: Id -> Demand
250
getIdDemandInfo id = demandInfo (idInfo id)
251

252
setIdDemandInfo :: Id -> Demand -> Id
253
setIdDemandInfo id demand_info = modifyIdInfo id (demand_info `setDemandInfo`)
254

255 256
	---------------------------------
	-- UPDATE INFO
257
getIdUpdateInfo :: Id -> UpdateInfo
258
getIdUpdateInfo id = updateInfo (idInfo id)
259

260
setIdUpdateInfo :: Id -> UpdateInfo -> Id
261
setIdUpdateInfo id upd_info = modifyIdInfo id (upd_info `setUpdateInfo`)
262

263 264
	---------------------------------
	-- SPECIALISATION
265
getIdSpecialisation :: Id -> IdSpecEnv
266
getIdSpecialisation id = specInfo (idInfo id)
267

268
setIdSpecialisation :: Id -> IdSpecEnv -> Id
269
setIdSpecialisation id spec_info = modifyIdInfo id (spec_info `setSpecInfo`)
270

271 272
	---------------------------------
	-- CAF INFO
273
getIdCafInfo :: Id -> CafInfo
274
getIdCafInfo id = cafInfo (idInfo id)
275

276
setIdCafInfo :: Id -> CafInfo -> Id
277
setIdCafInfo id caf_info = modifyIdInfo id (caf_info `setCafInfo`)
278 279
\end{code}

sof's avatar
sof committed
280

281 282 283 284
	---------------------------------
	-- 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.
285 286

\begin{code}
287
getInlinePragma :: Id -> InlinePragInfo
288
getInlinePragma id = inlinePragInfo (idInfo id)
289

290
setInlinePragma :: Id -> InlinePragInfo -> Id
291
setInlinePragma id prag = modifyIdInfo id (setInlinePragInfo prag)
292

293
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
294
modifyInlinePragma id fn = modifyIdInfo id (\info -> setInlinePragInfo (fn (inlinePragInfo info)) info)
295

296
idWantsToBeINLINEd :: Id -> Bool
297 298 299 300
idWantsToBeINLINEd id = case getInlinePragma id of
			  IWantToBeINLINEd -> True
			  IMustBeINLINEd   -> True
			  other		   -> False
301

302 303 304 305 306
idMustNotBeINLINEd id = case getInlinePragma id of
			  IMustNotBeINLINEd -> True
			  IAmASpecPragmaId  -> True
			  IAmALoopBreaker   -> True
			  other		    -> False
307

308 309 310
idMustBeINLINEd id =  case getInlinePragma id of
			IMustBeINLINEd -> True
			other	       -> False
311

312 313 314
isSpecPragmaId id = case getInlinePragma id of
			IAmASpecPragmaId -> True
			other		 -> False
315
\end{code}