-- Simple construction
mkId, mkVanillaId, mkSysLocal, mkUserLocal,
- mkTemplateLocals, mkWildId, mkTemplateLocal,
+ mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
-- Taking an Id apart
idName, idType, idUnique, idInfo,
zapFragileIdInfo, zapLamIdInfo,
-- Predicates
- omitIfaceSigForId, isDeadBinder,
- exportWithOrigOccName,
+ isImplicitId, isDeadBinder,
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,
- setIdUpdateInfo,
setIdCafInfo,
setIdCprInfo,
setIdOccInfo,
idFlavour,
idDemandInfo,
idStrictness,
+ idTyGenInfo,
idWorkerInfo,
idUnfolding,
idSpecialisation,
- idUpdateInfo,
idCafInfo,
idCprInfo,
idLBVarInfo,
- idOccInfo
+ idOccInfo,
) where
isId, mkIdVar,
idName, idType, idUnique, idInfo,
setIdName, setVarType, setIdUnique,
- setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
+ setIdInfo, lazySetIdInfo, modifyIdInfo,
+ maybeModifyIdInfo,
externallyVisibleId
)
-import VarSet
-import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars, seqType, 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,
- isWiredInName, isUserExportedName,
- getOccName, isIPOcc
+ getOccName
)
import OccName ( UserFS )
import PrimRep ( PrimRep )
-import PrimOp ( PrimOp, primOpIsCheap )
import TysPrim ( statePrimTyCon )
import FieldLabel ( FieldLabel )
import SrcLoc ( SrcLoc )
-import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques )
+import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques,
+ getNumBuiltinUniques )
import Outputable
infixl 1 `setIdUnfolding`,
`setIdArityInfo`,
`setIdDemandInfo`,
`setIdStrictness`,
+ `setIdTyGenInfo`,
`setIdWorkerInfo`,
`setIdSpecialisation`,
- `setIdUpdateInfo`,
`setInlinePragma`,
`idCafInfo`,
`idCprInfo`
\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}
(getBuiltinUniques (length tys))
tys
+mkTemplateLocalsNum :: Int -> [Type] -> [Id]
+-- The Int gives the starting point for unique allocation
+mkTemplateLocalsNum n tys = zipWith (mkSysLocal SLIT("tpl"))
+ (getNumBuiltinUniques n (length tys))
+ tys
+
mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
\end{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}
-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.
+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.
\begin{code}
-omitIfaceSigForId :: Id -> Bool
-omitIfaceSigForId id
- | isWiredInName (idName id)
- = True
-
- | otherwise
+isImplicitId :: Id -> Bool
+isImplicitId id
= case idFlavour id of
RecordSelId _ -> True -- Includes dictionary selectors
PrimOpId _ -> True
-- 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!
-
--- 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
+ other -> False
\end{code}
\begin{code}
isDeadBinder :: Id -> Bool
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
| otherwise = False -- TyVars count as not dead
-
-isIP id = isIPOcc (getOccName id)
\end{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)
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
---------------------------------
- -- UPDATE INFO
-idUpdateInfo :: Id -> UpdateInfo
-idUpdateInfo id = updateInfo (idInfo id)
-
-setIdUpdateInfo :: Id -> UpdateInfo -> Id
-setIdUpdateInfo id upd_info = modifyIdInfo (`setUpdateInfo` upd_info) id
-
- ---------------------------------
-- SPECIALISATION
idSpecialisation :: Id -> CoreRules
idSpecialisation id = specInfo (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
projects / ghc-hetmet.git / blobdiff