Id, DictId,
-- Simple construction
- mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
- mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
+ mkGlobalId, mkLocalId, mkLocalIdWithInfo,
+ mkSysLocal, mkUserLocal, mkVanillaGlobal,
mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
mkWorkerId, mkExportedLocalId,
zapLamIdInfo, zapDemandIdInfo,
-- Predicates
- isImplicitId, isDeadBinder,
- isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
- isRecordSelector,
+ isImplicitId, isDeadBinder, isDictId,
+ isExportedId, isLocalId, isGlobalId,
+ isRecordSelector, isNaughtyRecordSelector,
+ isClassOpId_maybe,
isPrimOpId, isPrimOpId_maybe,
isFCallId, isFCallId_maybe,
- isDataConWorkId, isDataConWorkId_maybe,
+ isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
isBottomingId, idIsFrom,
hasNoBinding,
#include "HsVersions.h"
-import CoreSyn ( Unfolding, CoreRules, IdCoreRule(..), rulesRules )
+import CoreSyn ( Unfolding, CoreRule )
import BasicTypes ( Arity )
import Var ( Id, DictId,
- isId, isExportedId, isSpecPragmaId, isLocalId,
+ isId, isExportedId, isLocalId,
idName, idType, idUnique, idInfo, isGlobalId,
setIdName, setIdType, setIdUnique,
setIdExported, setIdNotExported,
maybeModifyIdInfo,
globalIdDetails
)
-import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
+import qualified Var ( mkLocalId, mkGlobalId, mkExportedLocalId )
import TyCon ( FieldLabel, TyCon )
import Type ( Type, typePrimRep, addFreeTyVars, seqType,
splitTyConApp_maybe, PrimRep )
+import TcType ( isDictTy )
import TysPrim ( statePrimTyCon )
import IdInfo
#ifdef OLD_STRICTNESS
import qualified Demand ( Demand )
#endif
-import DataCon ( isUnboxedTupleCon )
+import DataCon ( DataCon, isUnboxedTupleCon )
import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
import Name ( Name, OccName, nameIsLocalOrFrom,
- mkSystemName, mkSystemNameEncoded, mkInternalName,
- getOccName, getSrcLoc
- )
+ mkSystemVarName, mkInternalName, getOccName,
+ getSrcLoc )
import Module ( Module )
-import OccName ( EncodedFS, mkWorkerOcc )
+import OccName ( mkWorkerOcc )
import Maybes ( orElse )
import SrcLoc ( SrcLoc )
import Outputable
import Unique ( Unique, mkBuiltinUnique )
-import CmdLineOpts ( opt_NoStateHack )
+import FastString ( FastString )
+import StaticFlags ( opt_NoStateHack )
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setIdUnfolding`,
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
-mkSpecPragmaId :: Name -> Type -> Id
-mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
-
mkExportedLocalId :: Name -> Type -> Id
mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
-mkSysLocal :: EncodedFS -> Unique -> Type -> Id
+mkSysLocal :: FastString -> Unique -> Type -> Id
mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
--- for SysLocal, we assume the base name is already encoded, to avoid
--- re-encoding the same string over and over again.
-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
+mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
mkVanillaGlobal = mkGlobalId VanillaGlobal
%* *
%************************************************************************
-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.
-
-
\begin{code}
recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
recordSelectorFieldLabel id = case globalIdDetails id of
- RecordSelId tycon lbl -> (tycon,lbl)
+ RecordSelId tycon lbl _ -> (tycon,lbl)
other -> panic "recordSelectorFieldLabel"
isRecordSelector id = case globalIdDetails id of
- RecordSelId _ _ -> True
+ RecordSelId {} -> True
other -> False
+isNaughtyRecordSelector id = case globalIdDetails id of
+ RecordSelId { sel_naughty = n } -> n
+ other -> False
+
+isClassOpId_maybe id = case globalIdDetails id of
+ ClassOpId cls -> Just cls
+ _other -> Nothing
+
isPrimOpId id = case globalIdDetails id of
PrimOpId op -> True
other -> False
DataConWorkId con -> Just con
other -> Nothing
+isDataConId_maybe :: Id -> Maybe DataCon
+isDataConId_maybe id = case globalIdDetails id of
+ DataConWorkId con -> Just con
+ DataConWrapId con -> Just con
+ other -> Nothing
+
+idDataCon :: Id -> DataCon
+-- Get from either the worker or the wrapper to the DataCon
+-- Currently used only in the desugarer
+-- INVARIANT: idDataCon (dataConWrapId d) = d
+-- (Remember, dataConWrapId can return either the wrapper or the worker.)
+idDataCon id = case globalIdDetails id of
+ DataConWorkId con -> con
+ DataConWrapId con -> con
+ other -> pprPanic "idDataCon" (ppr id)
+
+
+isDictId :: Id -> Bool
+isDictId id = isDictTy (idType id)
+
-- 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
-- file, even if it's mentioned in some other interface unfolding.
isImplicitId id
= case globalIdDetails id of
- RecordSelId _ _ -> True
+ RecordSelId {} -> True
FCallId _ -> True
PrimOpId _ -> True
ClassOpId _ -> True
---------------------------------
-- SPECIALISATION
-idSpecialisation :: Id -> CoreRules
+idSpecialisation :: Id -> SpecInfo
idSpecialisation id = specInfo (idInfo id)
-idCoreRules :: Id -> [IdCoreRule]
-idCoreRules id = [IdCoreRule id False rule | rule <- rulesRules (idSpecialisation id)]
+idCoreRules :: Id -> [CoreRule]
+idCoreRules id = specInfoRules (idSpecialisation id)
-setIdSpecialisation :: Id -> CoreRules -> Id
+setIdSpecialisation :: Id -> SpecInfo -> Id
setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
---------------------------------