X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FId.lhs;h=012e42bf1c90d9c3bb09c1947cd94d468461fd57;hp=c3cb9525c8254f57c39c0ebea4e8eed93c8f733c;hb=d95ce839533391e7118257537044f01cbb1d6694;hpb=74e5f1514aac87396f21a67204412badca6c0452 diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index c3cb952..012e42b 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -29,7 +29,7 @@ module Id ( mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo, mkLocalId, mkLocalIdWithInfo, mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM, - mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal, + mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal, mkWorkerId, mkExportedLocalId, -- ** Taking an Id apart @@ -38,9 +38,12 @@ module Id ( recordSelectorFieldLabel, -- ** Modifying an Id - setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, - globaliseId, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, + setIdName, setIdUnique, Id.setIdType, + setIdExported, setIdNotExported, + globaliseId, localiseId, + setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo, + -- ** Predicates on Ids isImplicitId, isDeadBinder, isDictId, isStrictId, @@ -65,7 +68,6 @@ module Id ( idArity, idNewDemandInfo, idNewDemandInfo_maybe, idNewStrictness, idNewStrictness_maybe, - idWorkerInfo, idUnfolding, idSpecialisation, idCoreRules, idHasRules, idCafInfo, @@ -83,10 +85,9 @@ module Id ( setIdArity, setIdNewDemandInfo, setIdNewStrictness, zapIdNewStrictness, - setIdWorkerInfo, setIdSpecialisation, setIdCafInfo, - setIdOccInfo, + setIdOccInfo, zapIdOccInfo, #ifdef OLD_STRICTNESS setIdStrictness, @@ -97,7 +98,7 @@ module Id ( #include "HsVersions.h" -import {-# SOURCE #-} CoreSyn ( CoreRule, Unfolding ) +import CoreSyn ( CoreRule, Unfolding ) import IdInfo import BasicTypes @@ -131,7 +132,6 @@ infixl 1 `setIdUnfolding`, `setIdArity`, `setIdNewDemandInfo`, `setIdNewStrictness`, - `setIdWorkerInfo`, `setIdSpecialisation`, `setInlinePragma`, `idCafInfo` @@ -185,6 +185,17 @@ setIdExported = setIdVarExported setIdNotExported :: Id -> Id setIdNotExported = setIdVarNotExported +localiseId :: Id -> Id +-- Make an with the same unique and type as the +-- incoming Id, but with an *Internal* Name and *LocalId* flavour +localiseId id + | isLocalId id && isInternalName name + = id + | otherwise + = mkLocalIdWithInfo (localiseName name) (idType id) (idInfo id) + where + name = idName id + globaliseId :: GlobalIdDetails -> Id -> Id globaliseId = globaliseIdVar @@ -274,10 +285,6 @@ Make some local @Ids@ for a template @CoreExpr@. These have bogus instantiated before use. \begin{code} --- | Make a /wild Id/. This is typically used when you need a binder that you don't expect to use -mkWildId :: Type -> Id -mkWildId ty = mkSysLocal (fsLit "wild") (mkBuiltinUnique 1) ty - -- | Workers get local names. "CoreTidy" will externalise these if necessary mkWorkerId :: Unique -> Id -> Type -> Id mkWorkerId uniq unwrkr ty @@ -524,14 +531,6 @@ isStrictId id (isStrictType (idType id)) --------------------------------- - -- WORKER ID -idWorkerInfo :: Id -> WorkerInfo -idWorkerInfo id = workerInfo (idInfo id) - -setIdWorkerInfo :: Id -> WorkerInfo -> Id -setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id - - --------------------------------- -- UNFOLDING idUnfolding :: Id -> Unfolding idUnfolding id = unfoldingInfo (idInfo id) @@ -603,6 +602,9 @@ idOccInfo id = occInfo (idInfo id) setIdOccInfo :: Id -> OccInfo -> Id setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id + +zapIdOccInfo :: Id -> Id +zapIdOccInfo b = b `setIdOccInfo` NoOccInfo \end{code}