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

	-- 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, mkIdVisible,
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 )
71
import Name	 	( Name, OccName, Module,
72
			  mkSysLocalName, mkLocalName,
73
			  isWiredInName, mkNameVisible
sof's avatar
sof committed
74
			) 
75 76
import Const		( Con(..) )
import PrimRep		( PrimRep )
77
import PrimOp		( PrimOp )
78 79
import FieldLabel	( FieldLabel(..) )
import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques )
80
import Outputable
81

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


93

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

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

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

107
mkUserId :: Name -> Type -> Id
108 109 110 111
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...
112 113
mkUserLocal :: OccName     -> Unique -> Type -> Id
mkSysLocal  :: FAST_STRING -> Unique -> Type -> Id
114

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

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

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


136 137 138 139 140 141 142
%************************************************************************
%*									*
\subsection[Id-general-funs]{General @Id@-related functions}
%*									*
%************************************************************************

\begin{code}
143
idFreeTyVars :: Id -> TyVarSet
144
idFreeTyVars id = tyVarsOfType (idType id)
145

146
setIdType :: Id -> Type -> Id
147 148
	-- Add free tyvar info to the type
setIdType id ty = setVarType id (addFreeTyVars ty)
sof's avatar
sof committed
149

150 151
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
152 153
\end{code}

154 155 156 157
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.

158
\begin{code}
159 160 161
omitIfaceSigForId :: Id -> Bool
omitIfaceSigForId id
  | isWiredInName (idName id)
162 163 164
  = True

  | otherwise
165
  = case idDetails id of
166 167 168 169 170 171 172 173
	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!
174 175 176
\end{code}

\begin{code}
sof's avatar
sof committed
177 178
mkIdVisible :: Module -> Id -> Id
mkIdVisible mod id = setIdName id (mkNameVisible mod (idName id))
179
\end{code}
sof's avatar
sof committed
180

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

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

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

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

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

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

209 210 211

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sof's avatar
sof committed
281

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

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

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

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

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

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

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

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