From 6084fb5517da34f65034370a3695e2af3b85ce2b Mon Sep 17 00:00:00 2001 From: Max Bolingbroke Date: Thu, 31 Jul 2008 01:23:30 +0000 Subject: [PATCH] Split the Id related functions out from Var into Id, document Var and some of Id --- compiler/basicTypes/BasicTypes.lhs | 11 ++ compiler/basicTypes/Id.lhs | 218 ++++++++++++++++++--------- compiler/basicTypes/IdInfo.lhs | 7 +- compiler/basicTypes/MkId.lhs | 2 +- compiler/basicTypes/Var.lhs | 275 ++++++++++++++++++----------------- compiler/basicTypes/VarSet.lhs | 2 +- compiler/codeGen/CgLetNoEscape.lhs | 1 + compiler/coreSyn/CoreLint.lhs | 2 +- compiler/coreSyn/CoreSyn.lhs | 8 +- compiler/coreSyn/CoreSyn.lhs-boot | 18 +++ compiler/coreSyn/MkExternalCore.lhs | 10 +- compiler/deSugar/Coverage.lhs | 2 +- compiler/deSugar/DsArrows.lhs | 1 + compiler/deSugar/DsListComp.lhs | 2 +- compiler/ghci/Debugger.hs | 2 +- compiler/hsSyn/HsDecls.lhs | 1 - compiler/iface/IfaceSyn.lhs | 1 - compiler/iface/IfaceType.lhs | 1 + compiler/iface/TcIface.lhs | 2 +- compiler/main/GHC.hs | 2 +- compiler/main/HscMain.lhs | 2 +- compiler/main/HscTypes.lhs | 2 +- compiler/main/InteractiveEval.hs | 2 +- compiler/main/TidyPgm.lhs | 4 +- compiler/simplCore/FloatIn.lhs | 2 +- compiler/simplCore/SAT.lhs | 2 +- compiler/stgSyn/CoreToStg.lhs | 2 +- compiler/stgSyn/StgSyn.lhs | 3 +- compiler/stranal/WwLib.lhs | 8 +- compiler/typecheck/TcBinds.lhs | 5 +- compiler/typecheck/TcInstDcls.lhs | 1 + compiler/typecheck/TcSimplify.lhs | 1 + compiler/typecheck/TcTyClsDecls.lhs | 1 + compiler/typecheck/TcType.lhs | 1 - compiler/vectorise/VectUtils.hs | 2 +- 35 files changed, 362 insertions(+), 244 deletions(-) create mode 100644 compiler/coreSyn/CoreSyn.lhs-boot diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index aa1741c..8fcf5ca 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -30,6 +30,8 @@ module BasicTypes( RecFlag(..), isRec, isNonRec, boolToRecFlag, + RuleName, + TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), @@ -129,6 +131,15 @@ instance Outputable name => Outputable (IPName name) where ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters \end{code} +%************************************************************************ +%* * + Rules +%* * +%************************************************************************ + +\begin{code} +type RuleName = FastString +\end{code} %************************************************************************ %* * diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index 070526e..95f90a4 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -6,25 +6,25 @@ \begin{code} module Id ( + -- * The main types Id, DictId, - -- Simple construction - mkGlobalId, mkLocalId, mkLocalIdWithInfo, - mkSysLocal, mkUserLocal, mkVanillaGlobal, - mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal, - mkWorkerId, mkExportedLocalId, + -- ** Simple construction + mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo, + mkLocalId, mkLocalIdWithInfo, + mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM, - -- Taking an Id apart + -- ** Taking an Id apart idName, idType, idUnique, idInfo, isId, globalIdDetails, idPrimRep, recordSelectorFieldLabel, - -- Modifying an Id + -- ** Modifying an Id setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, - setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, + globaliseId, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo, - -- Predicates + -- ** Predicates on Ids isImplicitId, isDeadBinder, isDictId, isStrictId, isExportedId, isLocalId, isGlobalId, isRecordSelector, isNaughtyRecordSelector, @@ -36,15 +36,15 @@ module Id ( isTickBoxOp, isTickBoxOp_maybe, hasNoBinding, - -- Inline pragma stuff + -- ** Inline pragma stuff idInlinePragma, setInlinePragma, modifyInlinePragma, - -- One shot lambda stuff + -- ** One shot lambda stuff isOneShotBndr, isOneShotLambda, isStateHackType, setOneShotLambda, clearOneShotLambda, - -- IdInfo stuff + -- ** IdInfo stuff setIdUnfolding, setIdArity, setIdNewDemandInfo, @@ -54,6 +54,7 @@ module Id ( setIdCafInfo, setIdOccInfo, + -- ** Id demand information #ifdef OLD_STRICTNESS idDemandInfo, idStrictness, @@ -81,15 +82,16 @@ module Id ( #include "HsVersions.h" -import CoreSyn +import {-# SOURCE #-} CoreSyn ( CoreRule, Unfolding ) + +import IdInfo import BasicTypes import qualified Var -import Var hiding (mkLocalId, mkGlobalId, mkExportedLocalId) +import Var import TyCon import Type import TcType -import TysPrim -import IdInfo +import TysPrim #ifdef OLD_STRICTNESS import qualified Demand #endif @@ -105,6 +107,7 @@ import Maybes import SrcLoc import Outputable import Unique +import UniqSupply import FastString import StaticFlags @@ -123,8 +126,58 @@ infixl 1 `setIdUnfolding`, ,`setIdDemandInfo` #endif \end{code} +%************************************************************************ +%* * +\subsection{Basic Id manipulation} +%* * +%************************************************************************ + +\begin{code} +idName :: Id -> Name +idName = Var.varName + +idUnique :: Id -> Unique +idUnique = varUnique + +idType :: Id -> Kind +idType = varType + +setIdUnique :: Id -> Unique -> Id +setIdUnique = setVarUnique + +setIdName :: Id -> Name -> Id +setIdName = setVarName + +setIdType :: Id -> Type -> Id +setIdType id ty = seqType ty `seq` Var.setVarType id ty +setIdExported :: Id -> Id +setIdExported = setIdVarExported +setIdNotExported :: Id -> Id +setIdNotExported = setIdVarNotExported + +globaliseId :: GlobalIdDetails -> Id -> Id +globaliseId = globaliseIdVar + +idInfo :: Id -> IdInfo +idInfo = varIdInfo + +lazySetIdInfo :: Id -> IdInfo -> Id +lazySetIdInfo = lazySetVarIdInfo + +setIdInfo :: Id -> IdInfo -> Id +setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info) + -- Try to avoid spack leaks by seq'ing + +modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id +modifyIdInfo fn id = setIdInfo id (fn (idInfo id)) + +-- maybeModifyIdInfo tries to avoid unnecesary thrashing +maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id +maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info +maybeModifyIdInfo Nothing id = id +\end{code} %************************************************************************ %* * @@ -147,33 +200,44 @@ substitution (which changes the free type variables) is more common. Anyway, we removed it in March 2008. \begin{code} -mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id -mkLocalIdWithInfo name ty info = Var.mkLocalId name ty info - -- Note [Free type variables] +-- | Create a global Id. Global identifiers are those that are imported or are data constructors/destructors. +mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id +mkGlobalId = mkGlobalIdVar -mkExportedLocalId :: Name -> Type -> Id -mkExportedLocalId name ty = Var.mkExportedLocalId name ty vanillaIdInfo - -- Note [Free type variables] +mkVanillaGlobal :: Name -> Type -> Id +mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo -mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id -mkGlobalId details name ty info = Var.mkGlobalId details name ty info -\end{code} +mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id +mkVanillaGlobalWithInfo = mkGlobalId VanillaGlobal -\begin{code} + +-- | Create a local Id. Local identifiers are those bound at the top level of the current module or in an expression. mkLocalId :: Name -> Type -> Id mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo --- SysLocal: for an Id being created by the compiler out of thin air... +mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id +mkLocalIdWithInfo = mkLocalIdVar + +-- | Create a local Id that is marked as exported. This prevents things attached to it from being removed as dead code. +mkExportedLocalId :: Name -> Type -> Id +mkExportedLocalId name ty = mkExportedLocalIdVar name ty vanillaIdInfo + -- Note [Free type variables] + + +-- | Create a system local Id. These are local Ids that are created by the compiler out of thin air mkSysLocal :: FastString -> Unique -> Type -> Id mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty +mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id +mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty)) + --- UserLocal: an Id with a name the user might recognize... +-- | Create a user local Id. These are local Id with a name and location that the user might recognize mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id -mkVanillaGlobal :: Name -> Type -> IdInfo -> Id +mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty -mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty -mkVanillaGlobal = mkGlobalId VanillaGlobal +mkUserLocalM :: MonadUnique m => OccName -> Type -> SrcSpan -> m Id +mkUserLocalM occ ty loc = getUniqueM >>= (\uniq -> return (mkUserLocal occ uniq ty loc)) \end{code} Make some local @Ids@ for a template @CoreExpr@. These have bogus @@ -181,27 +245,29 @@ Make some local @Ids@ for a template @CoreExpr@. These have bogus instantiated before use. \begin{code} --- "Wild Id" typically used when you need a binder that you don't expect to use +-- | 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 mkWorkerId :: Unique -> Id -> Type -> Id --- A worker gets a local name. CoreTidy will externalise it if necessary. +-- | Workers get local names. CoreTidy will externalise these if necessary mkWorkerId uniq unwrkr ty = mkLocalId wkr_name ty where wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr) --- "Template locals" typically used in unfoldings +-- | Create a "template local": a family of system local Ids in bijection with Ints, typically used in unfoldings +mkTemplateLocal :: Int -> Type -> Id +mkTemplateLocal i ty = mkSysLocal (fsLit "tpl") (mkBuiltinUnique i) ty + +-- | Create a template local for a series of types mkTemplateLocals :: [Type] -> [Id] -mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys +mkTemplateLocals = mkTemplateLocalsNum 1 +-- | Create a template local for a series of type, but start from a specified template local mkTemplateLocalsNum :: Int -> [Type] -> [Id] -- The Int gives the starting point for unique allocation mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys - -mkTemplateLocal :: Int -> Type -> Id -mkTemplateLocal i ty = mkSysLocal (fsLit "tpl") (mkBuiltinUnique i) ty \end{code} @@ -212,12 +278,23 @@ mkTemplateLocal i ty = mkSysLocal (fsLit "tpl") (mkBuiltinUnique i) ty %************************************************************************ \begin{code} -setIdType :: Id -> Type -> Id - -- Add free tyvar info to the type -setIdType id ty = seqType ty `seq` Var.setIdType id ty - idPrimRep :: Id -> PrimRep idPrimRep id = typePrimRep (idType id) + +globalIdDetails :: Id -> GlobalIdDetails +globalIdDetails = globalIdVarDetails + +isId :: Id -> Bool +isId = isIdVar + +isLocalId :: Id -> Bool +isLocalId = isLocalIdVar + +isGlobalId :: Id -> Bool +isGlobalId = isGlobalIdVar + +isExportedId :: Var -> Bool +isExportedId = isExportedIdVar \end{code} @@ -234,17 +311,16 @@ recordSelectorFieldLabel id RecordSelId { sel_tycon = tycon, sel_label = lbl } -> (tycon,lbl) _ -> panic "recordSelectorFieldLabel" -isRecordSelector :: Var -> Bool -isNaughtyRecordSelector :: Var -> Bool -isPrimOpId :: Var -> Bool -isFCallId :: Var -> Bool -isDataConWorkId :: Var -> Bool -hasNoBinding :: Var -> Bool +isRecordSelector :: Id -> Bool +isNaughtyRecordSelector :: Id -> Bool +isPrimOpId :: Id -> Bool +isFCallId :: Id -> Bool +isDataConWorkId :: Id -> Bool -isClassOpId_maybe :: Var -> Maybe Class -isPrimOpId_maybe :: Var -> Maybe PrimOp -isFCallId_maybe :: Var -> Maybe ForeignCall -isDataConWorkId_maybe :: Var -> Maybe DataCon +isClassOpId_maybe :: Id -> Maybe Class +isPrimOpId_maybe :: Id -> Maybe PrimOp +isFCallId_maybe :: Id -> Maybe ForeignCall +isDataConWorkId_maybe :: Id -> Maybe DataCon isRecordSelector id = case globalIdDetails id of RecordSelId {} -> True @@ -289,20 +365,20 @@ isDataConId_maybe id = case globalIdDetails id of _ -> 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 +-- ^ 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 - _ -> pprPanic "idDataCon" (ppr id) +idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id isDictId :: Id -> Bool isDictId id = isDictTy (idType id) --- hasNoBinding returns True of an Id which may not have a +hasNoBinding :: Id -> Bool +-- ^ 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 -- they aren't any more. Instead, we inject a binding for @@ -315,9 +391,9 @@ hasNoBinding id = case globalIdDetails id of _ -> False isImplicitId :: Id -> Bool - -- 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. +-- ^ 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. isImplicitId id = case globalIdDetails id of RecordSelId {} -> True @@ -396,7 +472,7 @@ setIdStrictness :: Id -> StrictnessInfo -> Id setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id #endif --- isBottomingId returns true if an application to n args would diverge +-- | Returns true if an application to n args would diverge isBottomingId :: Id -> Bool isBottomingId id = isBottomingSig (idNewStrictness id) @@ -411,15 +487,13 @@ setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id zapIdNewStrictness :: Id -> Id zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id -\end{code} -This predicate says whether the id has a strict demand placed on it or -has a type such that it can always be evaluated strictly (e.g., an -unlifted type, but see the comment for isStrictType). We need to -check separately whether has a so-called "strict type" because if -the demand for hasn't been computed yet but has a strict -type, we still want (isStrictId ) to be True. -\begin{code} +-- | This predicate says whether the id has a strict demand placed on it or +-- has a type such that it can always be evaluated strictly (e.g., an +-- unlifted type, but see the comment for 'isStrictType'). We need to +-- check separately whether has a so-called "strict type" because if +-- the demand for hasn't been computed yet but has a strict +-- type, we still want @isStrictId @ to be True. isStrictId :: Id -> Bool isStrictId id = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id ) diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index ad6d247..676ccef 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -77,7 +77,6 @@ module IdInfo ( TickBoxOp(..), TickBoxId, ) where -import CoreSyn import Class import PrimOp import Name @@ -503,9 +502,7 @@ specInfoRules (SpecInfo rules _) = rules setSpecInfoHead :: Name -> SpecInfo -> SpecInfo setSpecInfoHead fn (SpecInfo rules fvs) - = SpecInfo (map set_head rules) fvs - where - set_head rule = rule { ru_fn = fn } + = SpecInfo (map (setRuleIdName fn) rules) fvs seqSpecInfo :: SpecInfo -> () seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs @@ -747,7 +744,7 @@ zapFragileInfo :: IdInfo -> Maybe IdInfo zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo `setWorkerInfo` NoWorker - `setUnfoldingInfo` NoUnfolding + `setUnfoldingInfo` noUnfolding `setOccInfo` if isFragileOcc occ then NoOccInfo else occ) where occ = occInfo info diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 8448409..eb85111 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -1314,7 +1314,7 @@ errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy \begin{code} pcMiscPrelId :: Name -> Type -> IdInfo -> Id pcMiscPrelId name ty info - = mkVanillaGlobal name ty info + = mkVanillaGlobalWithInfo name ty info -- We lie and say the thing is imported; otherwise, we get into -- a mess with dependency analysis; e.g., core2stg may heave in -- random calls to GHCbase.unpackPS__. If GHCbase is the module diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index d9cedf0..0c30ab4 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -5,33 +5,72 @@ \section{@Vars@: Variables} \begin{code} +-- | +-- #name_types# +-- GHC uses several kinds of name internally: +-- +-- * 'OccName.OccName': see "OccName#name_types" +-- +-- * 'RdrName.RdrName': see "RdrName#name_types" +-- +-- * 'Name.Name': see "Name#name_types" +-- +-- * 'Id.Id': see "Id#name_types" +-- +-- * 'Var.Var' is a synonym for the 'Id.Id' type but it may additionally potentially contain type variables, +-- which have a 'TypeRep.Kind' rather than a 'TypeRep.Type' and only contain some extra details during typechecking. +-- These 'Var.Var' names may either be global or local, see "Var#globalvslocal" +-- +-- #globalvslocal# +-- Global 'Id's and 'Var's are those that are imported or correspond to a data constructor, primitive operation, or record selectors. +-- Local 'Id's and 'Var's are those bound within an expression (e.g. by a lambda) or at the top level of the module being compiled. module Var ( - Var, - varName, varUnique, varType, - setVarName, setVarUnique, + -- * The main data type + Var, - -- TyVars - TyVar, mkTyVar, mkTcTyVar, mkWildCoVar, - tyVarName, tyVarKind, + -- ** Constructing 'Var's + mkLocalIdVar, mkExportedLocalIdVar, mkGlobalIdVar, + + -- ** Taking 'Var's apart + varName, varUnique, varType, varIdInfo, globalIdVarDetails, + + -- ** Modifying 'Var's + setVarName, setVarUnique, setVarType, + setIdVarExported, setIdVarNotExported, + globaliseIdVar, lazySetVarIdInfo, + + -- ** Predicates + isCoVar, isIdVar, isTyVar, isTcTyVar, + isLocalVar, isLocalIdVar, + isGlobalIdVar, isExportedIdVar, + mustHaveLocalBinding, + + -- * Type variable data type + TyVar, + + -- ** Constructing 'TyVar's + mkTyVar, mkTcTyVar, mkWildCoVar, + + -- ** Taking 'TyVar's apart + tyVarName, tyVarKind, tcTyVarDetails, + + -- ** Modifying 'TyVar's setTyVarName, setTyVarUnique, setTyVarKind, - tcTyVarDetails, - -- CoVars - CoVar, coVarName, setCoVarUnique, setCoVarName, mkCoVar, isCoVar, + -- * Coercion variable data type + CoVar, - -- Ids - Id, DictId, - idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo, - setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, - setIdExported, setIdNotExported, + -- ** Constructing 'CoVar's + mkCoVar, - globalIdDetails, globaliseId, + -- ** Taking 'CoVar's apart + coVarName, - mkLocalId, mkExportedLocalId, mkGlobalId, + -- ** Modifying 'CoVar's + setCoVarUnique, setCoVarName, - isTyVar, isTcTyVar, isId, isLocalVar, isLocalId, - isGlobalId, isExportedId, - mustHaveLocalBinding + -- * 'Var' type synonyms + Id, DictId ) where #include "HsVersions.h" @@ -39,14 +78,14 @@ module Var ( import {-# SOURCE #-} TypeRep( Type, Kind ) import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails ) import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, - IdInfo, seqIdInfo ) + IdInfo ) import {-# SOURCE #-} TypeRep( isCoercionKind ) import Name hiding (varName) import Unique import FastTypes import FastString -import Outputable +import Outputable \end{code} @@ -63,13 +102,15 @@ strictness). The essential info about different kinds of @Vars@ is in its @VarDetails@. \begin{code} +-- | Essentially a typed 'Name', that may also contain some additional information +-- about the 'Var' and it's use sites. data Var = TyVar { varName :: !Name, realUnique :: FastInt, -- Key for fast comparison -- Identical to the Unique in the name, -- cached here for speed - varType :: Kind, + varType :: Kind, -- ^ The type or kind of the 'Var' in question isCoercionVar :: Bool } @@ -98,10 +139,8 @@ data Var lclDetails :: LocalIdDetails } data LocalIdDetails - = NotExported -- Not exported - | Exported -- Exported - -- Exported Ids are kept alive; - -- NotExported things may be discarded as dead code. + = NotExported -- ^ Not exported: may be discarded as dead code. + | Exported -- ^ Exported: kept alive \end{code} Note [GlobalId/LocalId] @@ -120,7 +159,6 @@ A LocalId is * always treated as a candidate by the free-variable finder After CoreTidy, top-level LocalIds are turned into GlobalIds - \begin{code} instance Outputable Var where @@ -166,6 +204,36 @@ setVarName :: Var -> Name -> Var setVarName var new_name = var { realUnique = getKeyFastInt (getUnique new_name), varName = new_name } + +setVarType :: Id -> Type -> Id +setVarType id ty = id { varType = ty } + +setIdVarExported :: Var -> Var +-- ^ Exports the given local 'Id'. Can also be called on global 'Id's, such as data constructors +-- and class operations, which are born as global 'Id's and automatically exported +setIdVarExported id@(LocalId {}) = id { lclDetails = Exported } +setIdVarExported other_id = ASSERT( isIdVar other_id ) other_id + +setIdVarNotExported :: Id -> Id +-- ^ We can only do this to LocalIds +setIdVarNotExported id = ASSERT( isLocalIdVar id ) id { lclDetails = NotExported } + +globaliseIdVar :: GlobalIdDetails -> Var -> Var +-- ^ If it's a local, make it global +globaliseIdVar details id = GlobalId { varName = varName id, + realUnique = realUnique id, + varType = varType id, + idInfo_ = varIdInfo id, + gblDetails = details } + +-- | Extract 'Id' information from the 'Var' if it represents a global or local 'Id', otherwise panic +varIdInfo :: Var -> IdInfo +varIdInfo (GlobalId {idInfo_ = info}) = info +varIdInfo (LocalId {idInfo_ = info}) = info +varIdInfo other_var = pprPanic "idInfo" (ppr other_var) + +lazySetVarIdInfo :: Var -> IdInfo -> Var +lazySetVarIdInfo id info = id { idInfo_ = info } \end{code} @@ -221,8 +289,9 @@ mkTcTyVar name kind details %************************************************************************ \begin{code} -type CoVar = Var -- A coercion variable is simply a type - -- variable of kind (ty1 :=: ty2) +type CoVar = Var -- ^ A coercion variable is simply a type + -- variable of kind @ty1 :=: ty2@. Hence its + -- 'varType' is always @PredTy (EqPred t1 t2)@ coVarName :: CoVar -> Name coVarName = varName @@ -237,14 +306,12 @@ mkCoVar :: Name -> Kind -> CoVar mkCoVar name kind = ASSERT( isCoercionKind kind ) TyVar { varName = name , realUnique = getKeyFastInt (nameUnique name) - , varType = kind - -- varType is always PredTy (EqPred t1 t2) + , varType = kind , isCoercionVar = True } mkWildCoVar :: Kind -> TyVar --- A type variable that is never referred to, --- so its unique doesn't matter +-- ^ Create a type variable that is never referred to, so its unique doesn't matter mkWildCoVar kind = ASSERT( isCoercionKind kind ) TyVar { varName = mkSysTvName wild_uniq (fsLit "co_wild"), @@ -253,164 +320,112 @@ mkWildCoVar kind isCoercionVar = True } where wild_uniq = mkBuiltinUnique 1 + \end{code} %************************************************************************ %* * -\subsection{Id Construction} +\subsection{Ids} %* * %************************************************************************ -Most Id-related functions are in Id.lhs and MkId.lhs - \begin{code} -type Id = Var -type DictId = Id -\end{code} -\begin{code} -idName :: Id -> Name -idUnique :: Id -> Unique -idType :: Id -> Kind +-- These synonyms are here and not in Id because otherwise we need a very +-- large number of SOURCE imports of Id.hs :-( +type Id = Var +type DictId = Var -idName = varName -idUnique = varUnique -idType = varType - -setIdUnique :: Id -> Unique -> Id -setIdUnique = setVarUnique - -setIdName :: Id -> Name -> Id -setIdName = setVarName - -setIdType :: Id -> Type -> Id -setIdType id ty = id {varType = ty} - -setIdExported :: Id -> Id --- Can be called on GlobalIds, such as data cons and class ops, --- which are "born" as GlobalIds and automatically exported -setIdExported id@(LocalId {}) = id { lclDetails = Exported } -setIdExported other_id = ASSERT( isId other_id ) other_id - -setIdNotExported :: Id -> Id --- We can only do this to LocalIds -setIdNotExported id = ASSERT( isLocalId id ) id { lclDetails = NotExported } - -globaliseId :: GlobalIdDetails -> Id -> Id --- If it's a local, make it global -globaliseId details id = GlobalId { varName = varName id, - realUnique = realUnique id, - varType = varType id, - idInfo_ = idInfo id, - gblDetails = details } - -idInfo :: Id -> IdInfo -idInfo (GlobalId {idInfo_ = info}) = info -idInfo (LocalId {idInfo_ = info}) = info -idInfo other_var = pprPanic "idInfo" (ppr other_var) - -lazySetIdInfo :: Id -> IdInfo -> Id -lazySetIdInfo id info = id {idInfo_ = info} - -setIdInfo :: Id -> IdInfo -> Id -setIdInfo id info = seqIdInfo info `seq` id {idInfo_ = info} - -- Try to avoid spack leaks by seq'ing - -modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id -modifyIdInfo fn id - = seqIdInfo new_info `seq` id {idInfo_ = new_info} - where - new_info = fn (idInfo id) - --- maybeModifyIdInfo tries to avoid unnecesary thrashing -maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id -maybeModifyIdInfo (Just new_info) id = id {idInfo_ = new_info} -maybeModifyIdInfo Nothing id = id \end{code} %************************************************************************ %* * -\subsection{Predicates over variables +\subsection{Predicates over variables} %* * %************************************************************************ \begin{code} -mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id -mkGlobalId details name ty info +-- | For an explanation of global vs. local 'Var's, see "Var#globalvslocal" +mkGlobalIdVar :: GlobalIdDetails -> Name -> Type -> IdInfo -> Var +mkGlobalIdVar details name ty info = GlobalId { varName = name, realUnique = getKeyFastInt (nameUnique name), -- Cache the unique varType = ty, gblDetails = details, idInfo_ = info } -mk_local_id :: Name -> Type -> LocalIdDetails -> IdInfo -> Id -mk_local_id name ty details info +mkLocalIdVar' :: Name -> Type -> LocalIdDetails -> IdInfo -> Var +mkLocalIdVar' name ty details info = LocalId { varName = name, realUnique = getKeyFastInt (nameUnique name), -- Cache the unique varType = ty, lclDetails = details, idInfo_ = info } -mkLocalId :: Name -> Type -> IdInfo -> Id -mkLocalId name ty info = mk_local_id name ty NotExported info +-- | For an explanation of global vs. local 'Var's, see "Var#globalvslocal" +mkLocalIdVar :: Name -> Type -> IdInfo -> Var +mkLocalIdVar name ty info = mkLocalIdVar' name ty NotExported info -mkExportedLocalId :: Name -> Type -> IdInfo -> Id -mkExportedLocalId name ty info = mk_local_id name ty Exported info +-- | Exported 'Var's will not be removed as dead code +mkExportedLocalIdVar :: Name -> Type -> IdInfo -> Var +mkExportedLocalIdVar name ty info = mkLocalIdVar' name ty Exported info \end{code} \begin{code} -isTyVar, isTcTyVar :: Var -> Bool -isId, isLocalVar, isLocalId :: Var -> Bool -isGlobalId, isExportedId :: Var -> Bool -mustHaveLocalBinding :: Var -> Bool -isCoVar :: Var -> Bool - +isTyVar :: Var -> Bool isTyVar (TyVar {}) = True isTyVar (TcTyVar {}) = True isTyVar _ = False +isTcTyVar :: Var -> Bool isTcTyVar (TcTyVar {}) = True isTcTyVar _ = False -isId (LocalId {}) = True -isId (GlobalId {}) = True -isId _ = False +isIdVar :: Var -> Bool +isIdVar (LocalId {}) = True +isIdVar (GlobalId {}) = True +isIdVar _ = False -isLocalId (LocalId {}) = True -isLocalId _ = False +isLocalIdVar :: Var -> Bool +isLocalIdVar (LocalId {}) = True +isLocalIdVar _ = False +isCoVar :: Var -> Bool isCoVar (v@(TyVar {})) = isCoercionVar v isCoVar _ = False --- isLocalVar returns True for type variables as well as local Ids +-- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's -- These are the variables that we need to pay attention to when finding free -- variables, or doing dependency analysis. +isLocalVar :: Var -> Bool isLocalVar (GlobalId {}) = False isLocalVar _ = True --- mustHaveLocalBinding returns True of Ids and TyVars +-- | 'mustHaveLocalBinding' returns @True@ of 'Id's and 'TyVar's -- that must have a binding in this module. The converse --- is not quite right: there are some GlobalIds that must have +-- is not quite right: there are some global 'Id's that must have -- bindings, such as record selectors. But that doesn't matter, -- because it's only used for assertions +mustHaveLocalBinding :: Var -> Bool mustHaveLocalBinding var = isLocalVar var -isGlobalId (GlobalId {}) = True -isGlobalId _ = False +isGlobalIdVar :: Var -> Bool +isGlobalIdVar (GlobalId {}) = True +isGlobalIdVar _ = False --- isExportedId means "don't throw this away" -isExportedId (GlobalId {}) = True -isExportedId (LocalId {lclDetails = details}) +-- | 'isExportedIdVar' means \"don't throw this away\" +isExportedIdVar :: Var -> Bool +isExportedIdVar (GlobalId {}) = True +isExportedIdVar (LocalId {lclDetails = details}) = case details of Exported -> True _ -> False -isExportedId _ = False +isExportedIdVar _ = False \end{code} \begin{code} -globalIdDetails :: Var -> GlobalIdDetails --- Works OK on local Ids too, returning notGlobalId -globalIdDetails (GlobalId {gblDetails = details}) = details -globalIdDetails _ = notGlobalId +globalIdVarDetails :: Var -> GlobalIdDetails +-- ^ Find the global 'Id' information if the 'Var' is a global 'Id', otherwise returns 'notGlobalId' +globalIdVarDetails (GlobalId {gblDetails = details}) = details +globalIdVarDetails _ = notGlobalId \end{code} - diff --git a/compiler/basicTypes/VarSet.lhs b/compiler/basicTypes/VarSet.lhs index f73bf1f..67a3dbf 100644 --- a/compiler/basicTypes/VarSet.lhs +++ b/compiler/basicTypes/VarSet.lhs @@ -22,7 +22,7 @@ module VarSet ( #include "HsVersions.h" -import Var +import Var ( Var, TyVar, Id ) import Unique import UniqSet \end{code} diff --git a/compiler/codeGen/CgLetNoEscape.lhs b/compiler/codeGen/CgLetNoEscape.lhs index b02bc50..a39e76b 100644 --- a/compiler/codeGen/CgLetNoEscape.lhs +++ b/compiler/codeGen/CgLetNoEscape.lhs @@ -36,6 +36,7 @@ import CmmUtils import CLabel import ClosureInfo import CostCentre +import Id import Var import SMRep import BasicTypes diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 5ee89cc..ffccf6f 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -566,7 +566,7 @@ lintAndScopeIds ids linterF lintAndScopeId :: Var -> (Var -> LintM a) -> LintM a lintAndScopeId id linterF = do { ty <- lintTy (idType id) - ; let id' = Var.setIdType id ty + ; let id' = setIdType id ty ; addInScopeVars [id'] $ (linterF id') } diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index ac32bc2..ea22eb5 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -42,13 +42,14 @@ module CoreSyn ( -- Core rules CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only RuleName, seqRules, ruleArity, - isBuiltinRule, ruleName, isLocalRule, ruleIdName + isBuiltinRule, ruleName, isLocalRule, ruleIdName, setRuleIdName ) where #include "HsVersions.h" import CostCentre import Var +import Id import Type import Coercion import Name @@ -205,8 +206,6 @@ A Rule is as the rule itself \begin{code} -type RuleName = FastString - data CoreRule = Rule { ru_name :: RuleName, @@ -262,6 +261,9 @@ ruleIdName = ru_fn isLocalRule :: CoreRule -> Bool isLocalRule = ru_local + +setRuleIdName :: Name -> CoreRule -> CoreRule +setRuleIdName nm ru = ru { ru_fn = nm } \end{code} diff --git a/compiler/coreSyn/CoreSyn.lhs-boot b/compiler/coreSyn/CoreSyn.lhs-boot new file mode 100644 index 0000000..5bdfeae --- /dev/null +++ b/compiler/coreSyn/CoreSyn.lhs-boot @@ -0,0 +1,18 @@ +\begin{code} +module CoreSyn where + +-- Needed by Var.lhs +--data Expr b +--type CoreExpr = Expr Var.Var + + +import Name ( Name ) + +-- Needed by Id +data CoreRule +setRuleIdName :: Name -> CoreRule -> CoreRule +seqRules :: [CoreRule] -> () + +data Unfolding +noUnfolding :: Unfolding +\end{code} diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 34f39a5..717d3d8 100644 --- a/compiler/coreSyn/MkExternalCore.lhs +++ b/compiler/coreSyn/MkExternalCore.lhs @@ -114,7 +114,7 @@ make_tbind :: TyVar -> C.Tbind make_tbind tv = (make_var_id (tyVarName tv), make_kind (tyVarKind tv)) make_vbind :: Var -> C.Vbind -make_vbind v = (make_var_id (Var.varName v), make_ty (idType v)) +make_vbind v = (make_var_id (Var.varName v), make_ty (varType v)) make_vdef :: Bool -> CoreBind -> CoreM C.Vdefg make_vdef topLevel b = @@ -128,7 +128,7 @@ make_vdef topLevel b = let local = not topLevel || localN rhs <- make_exp e -- use local flag to determine where to add the module name - return (local, make_qid local True vName, make_ty (idType v),rhs) + return (local, make_qid local True vName, make_ty (varType v),rhs) where vName = Var.varName v make_exp :: CoreExpr -> CoreM C.Exp @@ -136,11 +136,11 @@ make_exp (Var v) = do let vName = Var.varName v isLocal <- isALocal vName return $ - case globalIdDetails v of + case globalIdVarDetails v of FCallId (CCall (CCallSpec (StaticTarget nm) callconv _)) - -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (idType v)) + -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (varType v)) FCallId (CCall (CCallSpec DynamicTarget callconv _)) - -> C.DynExternal (showSDoc (ppr callconv)) (make_ty (idType v)) + -> C.DynExternal (showSDoc (ppr callconv)) (make_ty (varType v)) FCallId _ -> pprPanic "MkExternalCore died: can't handle non-{static,dynamic}-C foreign call" (ppr v) diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 97c70e5..d640dad 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -16,7 +16,7 @@ import SrcLoc import ErrUtils import Name import Bag -import Var +import Id import VarSet import Data.List import FastString diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs index adc449c..8ce75de 100644 --- a/compiler/deSugar/DsArrows.lhs +++ b/compiler/deSugar/DsArrows.lhs @@ -33,6 +33,7 @@ import CoreUtils import Name import Var +import Id import PrelInfo import DataCon import TysWiredIn diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs index 03da525..def08e1 100644 --- a/compiler/deSugar/DsListComp.lhs +++ b/compiler/deSugar/DsListComp.lhs @@ -28,7 +28,7 @@ import DsUtils import DynFlags import CoreUtils -import Var +import Id import Type import TysWiredIn import Match diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index e10b414..86331da 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -17,7 +17,7 @@ import RtClosureInspect import HscTypes import IdInfo ---import Id +import Id import Name import Var hiding ( varName ) import VarSet diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index 1faaa26..a6dc19e 100644 --- a/compiler/hsSyn/HsDecls.lhs +++ b/compiler/hsSyn/HsDecls.lhs @@ -46,7 +46,6 @@ import HsPat import HsTypes import HsDoc import NameSet -import CoreSyn import {- Kind parts of -} Type import BasicTypes import ForeignCall diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 6659e8b..39a1fd2 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -24,7 +24,6 @@ module IfaceSyn ( #include "HsVersions.h" -import CoreSyn import IfaceType import NewDemand diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs index e6049aa..59fb3e9 100644 --- a/compiler/iface/IfaceType.lhs +++ b/compiler/iface/IfaceType.lhs @@ -25,6 +25,7 @@ module IfaceType ( import TypeRep import TyCon +import Id import Var import TysWiredIn import Name diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index c572afe..2dcdf78 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -354,7 +354,7 @@ tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdI = do { name <- lookupIfaceTop occ_name ; ty <- tcIfaceType iface_type ; info <- tcIdInfo ignore_prags name ty info - ; return (AnId (mkVanillaGlobal name ty info)) } + ; return (AnId (mkVanillaGlobalWithInfo name ty info)) } tcIfaceDecl _ (IfaceData {ifName = occ_name, diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index ef8d98d..5314407 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -223,7 +223,7 @@ import HsSyn hiding ((<.>)) import Type hiding (typeKind) import TcType hiding (typeKind) import Id -import Var hiding (setIdType) +import Var import TysPrim ( alphaTyVars ) import TyCon import Class diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 37a9acc..3242dba 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -51,7 +51,7 @@ import VarSet import VarEnv ( emptyTidyEnv ) #endif -import Var ( Id ) +import Id ( Id ) import Module ( emptyModuleEnv, ModLocation(..), Module ) import RdrName import HsSyn diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 442d6f3..2c6d426 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -90,7 +90,7 @@ import Rules ( RuleBase ) import CoreSyn ( CoreBind ) import VarEnv import VarSet -import Var hiding ( setIdType ) +import Var import Id import Type diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 4fc295b..dd55dd5 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -45,7 +45,7 @@ import TcRnDriver import Type hiding (typeKind) import TcType hiding (typeKind) import InstEnv -import Var hiding (setIdType) +import Var import Id import IdInfo import Name hiding ( varName ) diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index d87b026..16f1402 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -20,7 +20,7 @@ import CoreLint import CoreUtils import VarEnv import VarSet -import Var hiding( mkGlobalId ) +import Var import Id import IdInfo import InstEnv @@ -176,7 +176,7 @@ tidyExternalId :: Id -> Id -- (NB: vanillaIdInfo makes a conservative assumption about Caf-hood.) tidyExternalId id = ASSERT2( isLocalId id && isExternalName (idName id), ppr id ) - mkVanillaGlobal (idName id) (tidyTopType (idType id)) vanillaIdInfo + mkVanillaGlobal (idName id) (tidyTopType (idType id)) \end{code} diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index 0ac4295..d46cb38 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -21,7 +21,7 @@ import CoreSyn import CoreUtils ( exprIsHNF, exprIsDupable ) import CoreLint ( showPass, endPass ) import CoreFVs ( CoreExprWithFVs, freeVars, freeVarsOf, idRuleVars ) -import Id ( isOneShotBndr ) +import Id ( isOneShotBndr, idType ) import Var import Type ( isUnLiftedType ) import VarSet diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs index e6e5ff1..329c95c 100644 --- a/compiler/simplCore/SAT.lhs +++ b/compiler/simplCore/SAT.lhs @@ -53,7 +53,7 @@ essential to make this work well! module SAT ( doStaticArgs ) where import DynFlags -import Var hiding (mkLocalId) +import Var import CoreSyn import CoreLint import CoreUtils diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs index 13509ce..f7347ae 100644 --- a/compiler/stgSyn/CoreToStg.lhs +++ b/compiler/stgSyn/CoreToStg.lhs @@ -18,7 +18,7 @@ import StgSyn import Type import TyCon import Id -import Var ( Var, globalIdDetails, idType ) +import Var ( Var ) import IdInfo import DataCon import CostCentre ( noCCS ) diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs index 78f7447..2530843 100644 --- a/compiler/stgSyn/StgSyn.lhs +++ b/compiler/stgSyn/StgSyn.lhs @@ -48,8 +48,7 @@ module StgSyn ( import CostCentre ( CostCentreStack, CostCentre ) import VarSet ( IdSet, isEmptyVarSet ) -import Var ( isId ) -import Id ( Id, idName, idType, idCafInfo ) +import Id ( Id, idName, idType, idCafInfo, isId ) import IdInfo ( mayHaveCafRefs ) import Packages ( isDllName ) import Literal ( Literal, literalType ) diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 229c2ec..e7bd24f 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -23,7 +23,7 @@ import TysWiredIn ( tupleCon ) import Type import Coercion ( mkSymCoercion, splitNewTypeRepCo_maybe ) import BasicTypes ( Boxity(..) ) -import Var ( Var, isId ) +import Var ( Var, isIdVar ) import UniqSupply import Unique import Util ( zipWithEqual, notNull ) @@ -127,12 +127,12 @@ mkWwBodies fun_ty demands res_info one_shots = do -- Don't do CPR if the worker doesn't have any value arguments -- Then the worker is just a constant, so we don't want to unbox it. (wrap_fn_cpr, work_fn_cpr, _cpr_res_ty) - <- if any isId work_args then + <- if any isIdVar work_args then mkWWcpr res_ty res_info else return (id, id, res_ty) - return ([idNewDemandInfo v | v <- work_call_args, isId v], + return ([idNewDemandInfo v | v <- work_call_args, isIdVar v], Note InlineMe . wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var, mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args) -- We use an INLINE unconditionally, even if the wrapper turns out to be @@ -170,7 +170,7 @@ mkWorkerArgs :: [Var] -> ([Var], -- Lambda bound args [Var]) -- Args at call site mkWorkerArgs args res_ty - | any isId args || not (isUnLiftedType res_ty) + | any isIdVar args || not (isUnLiftedType res_ty) = (args, args) | otherwise = (args ++ [voidArgId], args ++ [realWorldPrimId]) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 1e76698..301a42b 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -31,8 +31,7 @@ import Coercion import VarEnv import TysPrim import Id -import IdInfo -import Var hiding (mkLocalId) +import Var import Name import NameSet import NameEnv @@ -103,7 +102,7 @@ tcHsBootSigs (ValBindsOut binds sigs) where tc_boot_sig (TypeSig (L _ name) ty) = do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty - ; return (mkVanillaGlobal name sigma_ty vanillaIdInfo) } + ; return (mkVanillaGlobal name sigma_ty) } -- Notice that we make GlobalIds, not LocalIds tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s) tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups) diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index daf611a..fc42481 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -31,6 +31,7 @@ import TypeRep import DataCon import Class import Var +import Id import MkId import Name import NameSet diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 9ebae01..4c74262 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -36,6 +36,7 @@ import TcIface import TcTyFuns import DsUtils -- Big-tuple functions import Var +import Id import Name import NameSet import Class diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 4a2a289..b585650 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -31,6 +31,7 @@ import Generics import Class import TyCon import DataCon +import Id import Var import VarSet import Name diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 5f07585..b1862b7 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -147,7 +147,6 @@ import TyCon -- others: import DynFlags -import CoreSyn import Name import NameSet import VarEnv diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index 837a580..9a56e3a 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -420,7 +420,7 @@ buildEnv vvs return (vbody', lbody')) where (vs,ls) = unzip vvs - tys = map idType vs + tys = map varType vs mkVectEnv :: [Type] -> [Var] -> (Type, CoreExpr, CoreExpr -> CoreExpr -> CoreExpr) mkVectEnv [] [] = (unitTy, Var unitDataConId, \_ body -> body) -- 1.7.10.4