-- Predicates
omitIfaceSigForId, isDeadBinder,
- exportWithOrigOccName,
externallyVisibleId,
- idFreeTyVars,
isIP,
isSpecPragmaId, isRecordSelector,
- isPrimOpId, isPrimOpId_maybe,
- isDataConId, isDataConId_maybe, isDataConWrapId,
- isDataConWrapId_maybe,
+ isPrimOpId, isPrimOpId_maybe, isDictFunId,
+ isDataConId, isDataConId_maybe,
+ isDataConWrapId, isDataConWrapId_maybe,
isBottomingId,
- isExportedId, isUserExportedId,
+ isExportedId, isLocalId,
hasNoBinding,
-- Inline pragma stuff
setIdArityInfo,
setIdDemandInfo,
setIdStrictness,
+ setIdTyGenInfo,
setIdWorkerInfo,
setIdSpecialisation,
setIdCafInfo,
idFlavour,
idDemandInfo,
idStrictness,
+ idTyGenInfo,
idWorkerInfo,
idUnfolding,
idSpecialisation,
#include "HsVersions.h"
-import CoreSyn ( Unfolding, CoreRules, CoreExpr, Expr(..),
- AltCon (..), Alt, mkApps, Arg )
+import CoreSyn ( Unfolding, CoreRules )
import BasicTypes ( Arity )
import Var ( Id, DictId,
isId, mkIdVar,
maybeModifyIdInfo,
externallyVisibleId
)
-import VarSet
-import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars,
- seqType, splitAlgTyConApp_maybe, mkTyVarTy,
- mkTyConApp, splitTyConApp_maybe)
+import Type ( Type, typePrimRep, addFreeTyVars,
+ usOnce, seqType, splitTyConApp_maybe )
import IdInfo
-import Demand ( Demand, isStrict, wwLazy )
+import Demand ( Demand )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
- isUserExportedName, getOccName, isIPOcc
+ nameIsLocallyDefined,
+ getOccName, isIPOcc
)
import OccName ( UserFS )
import PrimRep ( PrimRep )
-import PrimOp ( PrimOp, primOpIsCheap )
import TysPrim ( statePrimTyCon )
import FieldLabel ( FieldLabel )
import SrcLoc ( SrcLoc )
import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques,
getNumBuiltinUniques )
import Outputable
-import TyCon ( TyCon, AlgTyConFlavour(..), ArgVrcs, mkSynTyCon,
- mkAlgTyConRep, tyConName,
- tyConTyVars, tyConDataCons )
-import DataCon ( DataCon, dataConWrapId, dataConOrigArgTys )
-import Var ( Var )
+
infixl 1 `setIdUnfolding`,
`setIdArityInfo`,
`setIdDemandInfo`,
`setIdStrictness`,
+ `setIdTyGenInfo`,
`setIdWorkerInfo`,
`setIdSpecialisation`,
`setInlinePragma`,
\begin{code}
mkId :: Name -> Type -> IdInfo -> Id
-mkId name ty info = mkIdVar name (addFreeTyVars ty) info'
- where
- info' | isUserExportedName name = setNoDiscardInfo info
- | otherwise = info
+mkId name ty info = mkIdVar name (addFreeTyVars ty) info
\end{code}
\begin{code}
%************************************************************************
\begin{code}
-idFreeTyVars :: Id -> TyVarSet
-idFreeTyVars id = tyVarsOfType (idType id)
-
setIdType :: Id -> Type -> Id
-- Add free tyvar info to the type
setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
-- binding, even though it is defined in this module. Notably,
-- the constructors of a dictionary are in this situation.
+isDictFunId id = case idFlavour id of
+ DictFunId -> True
+ other -> False
+
-- Don't drop a binding for an exported Id,
-- if it otherwise looks dead.
+-- Perhaps a better name would be isDiscardableId
isExportedId :: Id -> Bool
isExportedId id = case idFlavour id of
- VanillaId -> False
- other -> True -- All the others are no-discard
-
--- Say if an Id was exported by the user
--- Implies isExportedId (see mkId above)
-isUserExportedId :: Id -> Bool
-isUserExportedId id = isUserExportedName (idName id)
+ 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.
+-- See comments with CoreFVs.isLocalVar
+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
\end{code}
\begin{code}
omitIfaceSigForId :: Id -> Bool
omitIfaceSigForId id
- | otherwise
+ = 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
+ omit = omitIfaceSigForId' id
+
+omitIfaceSigForId' id
= case idFlavour id of
RecordSelId _ -> True -- Includes dictionary selectors
PrimOpId _ -> True
-- The dfun id must *not* be omitted, because it carries version info for
-- the instance decl
- other -> False -- Don't omit!
-
--- Certain names must be exported with their original occ names, because
--- these names are bound by either a class declaration or a data declaration
--- or an explicit user export.
-exportWithOrigOccName :: Id -> Bool
-exportWithOrigOccName id = omitIfaceSigForId id || isUserExportedId id
+ ConstantId -> False -- Ordinary Ids
+ DictFunId -> False
+
+ ExportedId -> False -- I don't think these happen
+ VanillaId -> False -- ditto
+ SpecPragmaId -> False -- ditto
\end{code}
\begin{code}
isBottomingId id = isBottomingStrictness (idStrictness id)
---------------------------------
+ -- TYPE GENERALISATION
+idTyGenInfo :: Id -> TyGenInfo
+idTyGenInfo id = tyGenInfo (idInfo id)
+
+setIdTyGenInfo :: Id -> TyGenInfo -> Id
+setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
+
+ ---------------------------------
-- WORKER ID
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
idLBVarInfo id = lbvarInfo (idInfo id)
isOneShotLambda :: Id -> Bool
-isOneShotLambda id = case idLBVarInfo id of
- IsOneShotLambda -> True
- NoLBVarInfo -> case splitTyConApp_maybe (idType id) of
- Just (tycon,_) -> tycon == statePrimTyCon
- other -> False
+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
+
-- 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
-- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
setOneShotLambda :: Id -> Id
-setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
+setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
clearOneShotLambda :: Id -> Id
clearOneShotLambda id
zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
\end{code}
-
-
-
-
-
-
-
-
-
-
projects / ghc-hetmet.git / blobdiff