import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
import Class ( Class, classTyCon )
-import Name ( Name, NamedThing(..), nameUnique, isLocallyDefined )
+import Name ( Name, NamedThing(..), nameUnique )
import Var ( TyVar, Id )
import FieldLabel ( FieldLabel )
import BasicTypes ( Arity )
unbox_strict_arg_ty tycon strict_mark ty
| case strict_mark of
NotMarkedStrict -> False
- MarkedUnboxed _ _ -> True
- MarkedStrict -> opt_UnboxStrictFields &&
- isLocallyDefined tycon &&
+ MarkedUnboxed _ _ -> True -- !! From interface file
+ MarkedStrict -> opt_UnboxStrictFields && -- ! From source
maybeToBool maybe_product &&
not (isRecursiveTyCon tycon) &&
isDataTyCon arg_tycon
isDataConId, isDataConId_maybe, isDataConWrapId,
isDataConWrapId_maybe,
isBottomingId,
- isExportedId, isUserExportedId,
+ isExportedId, isLocalId,
hasNoBinding,
-- Inline pragma stuff
import Demand ( Demand )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
- isUserExportedName, nameIsLocallyDefined,
+ nameIsLocallyDefined,
getOccName, isIPOcc
)
import OccName ( UserFS )
\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
+
+mkImportedId :: Name -> Type -> IdInfo -> Id
+mkImportedId name ty info = mkId name ty (info `setFlavourInfo` ImportedId)
\end{code}
\begin{code}
-- 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 = isUserExportedId id -- Try this
-{-
- 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)
+isExportedId id = case idFlavour id of
+ 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 CoreSyn.isLocalVar
+isLocalId id = case idFlavour id of
+ VanillaId -> True
+ ExportedId -> True
+ SpecPragmaId -> True
+ other -> False
\end{code}
-- 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
+exportWithOrigOccName id = omitIfaceSigForId id || isExportedId id
\end{code}
\begin{code}
-- Flavour
IdFlavour(..), flavourInfo,
- setNoDiscardInfo,
+ setNoDiscardInfo, setFlavourInfo,
ppFlavourInfo,
-- Arity
Setters
\begin{code}
+setFlavourInfo info fl = fl `seq` info { flavourInfo = wk }
setWorkerInfo info wk = wk `seq` info { workerInfo = wk }
setSpecInfo info sp = PSEQ sp (info { specInfo = sp })
setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg }
\begin{code}
data IdFlavour
- = VanillaId -- Most Ids are like this
+ = VanillaId -- Locally defined, not exported
+ | ExportedId -- Locally defined, exported
+ | SpecPragmaId -- Locally defined, RHS holds specialised call
+
+ | ImportedId -- Imported from elsewhere
+
| DataConId DataCon -- The Id for a data constructor *worker*
| DataConWrapId DataCon -- The Id for a data constructor *wrapper*
-- [the only reasons we need to know is so that
-- Id back to the data con]
| PrimOpId PrimOp -- The Id for a primitive operator
| RecordSelId FieldLabel -- The Id for a record selector
- | SpecPragmaId -- Don't discard these
- | NoDiscardId -- Don't discard these either
+
ppFlavourInfo :: IdFlavour -> SDoc
ppFlavourInfo VanillaId = empty
+ppFlavourInfo ExportedId = ptext SLIT("[Exported]")
+ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]")
+ppFlavourInfo ImportedId = ptext SLIT("[Imported]")
ppFlavourInfo (DataConId _) = ptext SLIT("[DataCon]")
ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
ppFlavourInfo (PrimOpId _) = ptext SLIT("[PrimOp]")
ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]")
-ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]")
-ppFlavourInfo NoDiscardId = ptext SLIT("[NoDiscard]")
seqFlavour :: IdFlavour -> ()
seqFlavour f = f `seq` ()
-- The Name type
Name, -- Abstract
- mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName,
+ mkLocalName, mkSysLocalName, mkCCallName,
mkTopName, mkIPName,
mkDerivedName, mkGlobalName, mkKnownKeyGlobal, mkWiredInName,
- nameUnique, setNameUnique, setLocalNameSort,
+ nameUnique, setNameUnique,
tidyTopName,
nameOccName, nameModule, nameModule_maybe,
setNameOcc, nameRdrName, setNameModuleAndLoc,
toRdrName, hashName,
- isUserExportedName,
nameSrcLoc, nameIsLocallyDefined, isDllName, nameIsFrom, nameIsLocalOrFrom,
isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
-- Class NamedThing and overloaded friends
NamedThing(..),
- getSrcLoc, isLocallyDefined, getOccString, toRdrName,
+ getSrcLoc, getOccString, toRdrName,
isFrom, isLocalOrFrom
) where
data NameSort
= Global Module -- (a) TyCon, Class, their derived Ids, dfun Id
- -- (b) imported Id
+ -- (b) Imported Id
+ -- (c) Top-level Id in the original source, even if
+ -- locally defined
- | Exported -- An exported Ids defined in the module being compiled
-
- | Local -- A user-defined, but non-exported Id or TyVar,
+ | Local -- A user-defined Id or TyVar
-- defined in the module being compiled
| System -- A system-defined Id or TyVar. Typically the
Notes about the NameSorts:
-1. An Exported Id is changed to Global right at the
- end in the tidyCore pass, so that an importer sees a Global
- Similarly, Local Ids that are visible to an importer (e.g. when
- optimisation is on) are changed to Globals.
+1. Initially, top-level Ids (including locally-defined ones) get Global names,
+ and all other local Ids get Local names
2. Things with a @Global@ name are given C static labels, so they finally
appear in the .o file's symbol table. They appear in the symbol table
in the form M.n. If originally-local things have this property they
must be made @Global@ first.
-3. A System Name differs in the following ways:
+3. In the tidy-core phase, a Global that is not visible to an importer
+ is changed to Local, and a Local that is visible is changed to Global
+
+4. A System Name differs in the following ways:
a) has unique attached when printing dumps
b) unifier eliminates sys tyvars in favour of user provs where possible
nameIsLocallyDefined :: Name -> Bool
nameIsFrom :: Module -> Name -> Bool
nameIsLocalOrFrom :: Module -> Name -> Bool
-isUserExportedName :: Name -> Bool
isLocalName :: Name -> Bool -- Not globals
isGlobalName :: Name -> Bool
isSystemName :: Name -> Bool
-- Global names are by definition those that are visible
-- outside the module, *as seen by the linker*. Externally visible
--- does not mean visible at the source level (that's isUserExported).
+-- does not mean visible at the source level
isExternallyVisibleName name = isGlobalName name
--- Constructors, selectors and suchlike Globals, and are all exported
--- Other Local things may or may not be exported
-isUserExportedName (Name { n_sort = Exported }) = True
-isUserExportedName (Name { n_sort = Global _ }) = True
-isUserExportedName other = False
-
isSystemName (Name {n_sort = System}) = True
isSystemName other = False
\end{code}
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
-mkImportedLocalName :: Unique -> OccName -> SrcLoc -> Name
- -- Just the same as mkLocalName, except the provenance is different
- -- Reason: this flags the name as one that came in from an interface
- -- file. This is useful when trying to decide which of two type
- -- variables should 'win' when unifying them.
- -- NB: this is only for non-top-level names, so we use ImplicitImport
- --
- -- Oct 00: now that Names lack Provenances, mkImportedLocalName doesn't make
- -- sense any more, so it's just the same as mkLocalName
-mkImportedLocalName uniq occ loc = mkLocalName uniq occ loc
-
-
mkGlobalName :: Unique -> Module -> OccName -> SrcLoc -> Name
mkGlobalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = Global mod,
n_occ = occ, n_loc = loc }
setNameModuleAndLoc name mod loc = name {n_sort = set (n_sort name), n_loc = loc}
where
set (Global _) = Global mod
-
-setLocalNameSort :: Name -> Bool -> Name
- -- Set the name's sort to Local or Exported, depending on the boolean
-setLocalNameSort name is_exported = name { n_sort = if is_exported then Exported
- else Local }
\end{code}
top-level defns externally visible
\begin{code}
-tidyTopName :: Module -> TidyOccEnv -> Name -> (TidyOccEnv, Name)
-tidyTopName mod env
+tidyTopName :: Module -> TidyOccEnv -> Bool -> Name -> (TidyOccEnv, Name)
+tidyTopName mod env is_exported
name@(Name { n_occ = occ, n_sort = sort, n_uniq = uniq, n_loc = loc })
= case sort of
- System -> localise -- System local Ids
- Local -> localise -- User non-exported Ids
- Exported -> globalise -- User-exported things
- Global _ -> no_op -- Constructors, class selectors, default methods
+ Global _ | is_exported -> (env, name)
+ | otherwise -> (env, name { n_sort = new_sort })
+ other | is_exported -> (env', name { n_sort = Global mod, n_occ = occ' })
+ | otherwise -> (env', name { n_sort = new_sort, n_occ = occ' })
where
- no_op = (env, name)
-
- globalise = (env, name { n_sort = Global mod }) -- Don't change occurrence name
-
- localise = (env', name')
(env', occ') = tidyOccName env occ
- name' = name { n_occ = occ', n_sort = mkLocalTopSort mod }
+ new_sort = mkLocalTopSort mod
mkTopName :: Unique -> Module -> FAST_STRING -> Name
-- Make a top-level name; make it Global if top-level
isDllName :: Name -> Bool
-- Does this name refer to something in a different DLL?
isDllName nm = not opt_Static &&
- not (nameIsLocallyDefined nm) && -- isLocallyDefinedName test needed 'cos
+ not (isLocalName nm) && -- isLocalName test needed 'cos
not (isModuleInThisPackage (nameModule nm)) -- nameModule won't work on local names
case sort of
Global mod -> pprGlobal sty name uniq mod occ
System -> pprSysLocal sty uniq occ
- Local -> pprLocal sty uniq occ empty
- Exported -> pprLocal sty uniq occ (char 'x')
+ Local -> pprLocal sty uniq occ
-pprLocal sty uniq occ pp_export
+pprLocal sty uniq occ
| codeStyle sty = pprUnique uniq
| debugStyle sty = pprOccName occ <>
- text "{-" <> pp_export <+> pprUnique10 uniq <> text "-}"
+ text "{-" <> pprUnique10 uniq <> text "-}"
| otherwise = pprOccName occ
pprGlobal sty name uniq mod occ
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
-isLocallyDefined :: NamedThing a => a -> Bool
getOccString :: NamedThing a => a -> String
toRdrName :: NamedThing a => a -> RdrName
isFrom :: NamedThing a => Module -> a -> Bool
isLocalOrFrom :: NamedThing a => Module -> a -> Bool
getSrcLoc = nameSrcLoc . getName
-isLocallyDefined = nameIsLocallyDefined . getName
getOccString = occNameString . getOccName
toRdrName = nameRdrName . getName
isFrom mod x = nameIsFrom mod (getName x)
isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x)
\end{code}
-\begin{code}
-{-# SPECIALIZE isLocallyDefined :: Name -> Bool #-}
-\end{code}
import VarSet ( varSetElems )
import Literal ( Literal )
import Maybes ( catMaybes, maybeToBool )
-import Name ( isLocallyDefined, NamedThing(..) )
+import Name ( isLocalName, NamedThing(..) )
#ifdef DEBUG
import PprAbsC ( pprAmode )
#endif
getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
getCAddrModeAndInfo id
- | not (isLocallyDefined name) || isDataConWrapId id
+ | not (isLocalName name) || isDataConWrapId id
-- Why the isDataConWrapId? Because CoreToStg changes a call to
-- a nullary constructor worker fn to a call to its wrapper,
-- which may not be defined until later
import Id ( Id, idFreeTyVars, hasNoBinding, idSpecialisation )
import VarSet
import Var ( Var, isId )
-import Name ( isLocallyDefined )
import Type ( tyVarsOfType )
import Util ( mapAndUnzip )
import Outputable
\end{code}
-%************************************************************************
-%* *
-\section{Utilities}
-%* *
-%************************************************************************
-
-\begin{code}
-mustHaveLocalBinding :: Var -> Bool
--- True <=> the variable must have a binding in this module
-mustHaveLocalBinding v
- | isId v = isLocallyDefined v && not (hasNoBinding v)
- | otherwise = True -- TyVars etc must
-\end{code}
-
%************************************************************************
%* *
\begin{code}
exprFreeVars :: CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
-exprFreeVars = exprSomeFreeVars isLocallyDefined
+exprFreeVars = exprSomeFreeVars isLocalVar
exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
ruleRhsFreeVars :: CoreRule -> VarSet
ruleRhsFreeVars (BuiltinRule _) = noFVs
ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
- = rule_fvs isLocallyDefined emptyVarSet
+ = rule_fvs isLocalVar emptyVarSet
where
rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
-- Actually [June 98] I don't think it's necessary
-- fvs = fvs_v `unionVarSet` idSpecVars v
- fvs | isLocallyDefined v = aFreeVar v
- | otherwise = noFVs
+ fvs | isLocalVar v = aFreeVar v
+ | otherwise = noFVs
freeVars (Lit lit) = (noFVs, AnnLit lit)
freeVars (Lam b body)
mkConApp,
varToCoreExpr,
- bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, isTyVar, isId,
+ isTyVar, isId, isLocalVar, mustHaveLocalBinding,
+ bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
collectArgs, collectBindersIgnoringNotes,
coreExprCc,
%************************************************************************
%* *
+\subsection{isLocalVar}
+%* *
+%************************************************************************
+
+@isLocalVar@ returns True of all TyVars, and of Ids that are defined in
+this module and are not constants like data constructors and record selectors.
+These are the variables that we need to pay attention to when finding free
+variables, or doing dependency analysis.
+
+\begin{code}
+isLocalVar :: Var -> Bool
+isLocalVar v = isTyVar v || isLocalId v
+\end{code}
+
+\begin{code}
+mustHaveLocalBinding :: Var -> Bool
+-- True <=> the variable must have a binding in this module
+mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Transformation rules}
%* *
%************************************************************************
tidyTopId mod env@(tidy_env, var_env) env_idinfo id
= -- Top level variables
let
- (tidy_env', name') = tidyTopName mod tidy_env (idName id)
+ (tidy_env', name') = tidyTopName mod tidy_env (idIsExported id) (idName id)
ty' = tidyTopType (idType id)
idinfo' = tidyIdInfo env_idinfo (idInfo id)
id' = mkId name' ty' idinfo'
import CmdLineOpts ( opt_AutoSccsOnAllToplevs, opt_AutoSccsOnExportedToplevs )
import CostCentre ( mkAutoCC, IsCafCC(..) )
-import Id ( idType, idName, isUserExportedId, isSpecPragmaId, Id )
+import Id ( idType, idName, isExportedId, isSpecPragmaId, Id )
import NameSet
import VarSet
import Type ( mkTyVarTy )
addSccs TopLevel exports
= TopLevelAddSccs (\id -> case [ exp | (_,exp,loc) <- exports, loc == id ] of
(exp:_) | opt_AutoSccsOnAllToplevs ||
- (isUserExportedId exp &&
+ (isExportedId exp &&
opt_AutoSccsOnExportedToplevs)
-> Just exp
_ -> Nothing)
toUfApp (Var v) as
= case isDataConId_maybe v of
-- We convert the *worker* for tuples into UfTuples
- Just dc | isTupleTyCon tc && saturated -> UfTuple (HsTupCon (getName dc) (tupleTyConBoxity tc)) tup_args
+ Just dc | isTupleTyCon tc && saturated
+ -> UfTuple (HsTupCon (getName dc) (tupleTyConBoxity tc)) tup_args
where
val_args = dropWhile isTypeArg as
saturated = length val_args == idArity v
import TypeRep ( Type(..), TyNote(..) ) -- toHsType sees the representation
import TyCon ( isTupleTyCon, tupleTyConBoxity, tyConArity, getSynTyConDefn )
import RdrName ( RdrName, mkUnqual )
-import Name ( Name, getName, setLocalNameSort )
+import Name ( Name, getName )
import OccName ( NameSpace, tvName )
import Var ( TyVar, tyVarKind )
import Subst ( mkTyVarSubst, substTy )
hsUsMany = HsTyVar (mkUnqual tvName SLIT("!")) -- deep magic
hsUsOnce_Name, hsUsMany_Name :: HsType Name
--- Fudge the TyConName so that it prints unqualified
--- I hate it! I hate it!
-hsUsOnce_Name = HsTyVar (setLocalNameSort usOnceTyConName False)
-hsUsMany_Name = HsTyVar (setLocalNameSort usManyTyConName False)
+hsUsOnce_Name = HsTyVar usOnceTyConName
+hsUsMany_Name = HsTyVar usManyTyConName
-----------------------
data HsTupCon name = HsTupCon name Boxity
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.21 2000/11/13 17:12:37 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.22 2000/11/14 08:07:12 simonpj Exp $
--
-- GHC Driver
--
#ifdef mingw32_TARGET_OS
let extra_os = if static || no_hs_main
then []
- else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
- head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
+-- else [ head (lib_paths (head rts_pkg)) ++ "/Main.dll_o",
+-- head (lib_paths (head std_pkg)) ++ "/PrelMain.dll_o" ]
+ else []
#endif
(md_c_flags, _) <- machdepCCOpts
run_something "Linker"
<- renameModule dflags hit hst pcs_ch this_mod rdr_module
; case maybe_rn_result of {
Nothing -> return (HscFail pcs_rn);
- Just (print_unqualified, new_iface, rn_hs_decls) -> do {
+ Just (print_unqualified, is_exported, new_iface, rn_hs_decls) -> do {
-------------------
-- TYPECHECK
-------------------
-- We grab the the unfoldings at this point.
; simpl_result <- dsThenSimplThenTidy dflags (pcs_rules pcs_tc) this_mod
- print_unqualified tc_result hst
+ print_unqualified is_exported tc_result hst
; let (tidy_binds, orphan_rules, foreign_stuff) = simpl_result
-------------------
(ppr nm)
-dsThenSimplThenTidy dflags rule_base this_mod print_unqual tc_result hst
+dsThenSimplThenTidy dflags rule_base this_mod print_unqual is_exported tc_result hst
= do -------------------------- Desugaring ----------------
-- _scc_ "DeSugar"
(desugared, rules, h_code, c_code, fe_binders)
-------------------------- Main Core-language transformations ----------------
-- _scc_ "Core2Core"
(simplified, orphan_rules)
- <- core2core dflags rule_base hst desugared rules
+ <- core2core dflags rule_base hst is_exported desugared rules
-- Do the final tidy-up
(tidy_binds, tidy_orphan_rules)
WhetherHasOrphans, ImportVersion, WhatsImported(..),
PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
- IfaceInsts, IfaceRules, GatedDecl,
+ IfaceInsts, IfaceRules, GatedDecl, IsExported,
OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
AvailEnv, AvailInfo, GenAvailInfo(..),
PersistentCompilerState(..),
#include "HsVersions.h"
import RdrName ( RdrNameEnv, emptyRdrEnv, rdrEnvToList )
-import Name ( Name, NamedThing, isLocallyDefined,
- getName, nameModule, nameSrcLoc )
+import Name ( Name, NamedThing, getName, nameModule, nameSrcLoc )
import Name -- Env
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
Simple lookups in the symbol table.
\begin{code}
-lookupIface :: HomeIfaceTable -> PackageIfaceTable
- -> Module -> Name -- The module is to use for locally-defined names
- -> Maybe ModIface
+lookupIface :: HomeIfaceTable -> PackageIfaceTable -> Name -> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
-lookupIface hit pit this_mod name
- | isLocallyDefined name = lookupModuleEnv hit this_mod
- | otherwise = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
+lookupIface hit pit name
+ = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
where
mod = nameModule name
-lookupIfaceByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
--- We often have two Symbol- or IfaceTables, and want to do a lookup
-lookupIfaceByModName ht pt mod
+lookupIfaceByModName :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
+-- We often have two IfaceTables, and want to do a lookup
+lookupIfaceByModName hit pit mod
= lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
\end{code}
\begin{code}
lookupType :: HomeSymbolTable -> PackageTypeEnv -> Name -> Maybe TyThing
lookupType hst pte name
- = ASSERT2( not (isLocallyDefined name), ppr name )
- case lookupModuleEnv hst (nameModule name) of
+ = case lookupModuleEnv hst (nameModule name) of
Just details -> lookupNameEnv (md_types details) name
Nothing -> lookupNameEnv pte name
\end{code}
-- we imported the module without saying exactly what we imported
-- We need to recompile if the module exports changes, because we might
-- now have a name clash in the importing module.
+
+type IsExported = Name -> Bool -- True for names that are exported from this module
\end{code}
)
import CmdLineOpts
-import Id ( Id, idType, idInfo, omitIfaceSigForId, isUserExportedId, hasNoBinding,
+import Id ( Id, idType, idInfo, omitIfaceSigForId, isExportedId, hasNoBinding,
idSpecialisation, idName, setIdInfo
)
import Var ( isId )
import IdInfo -- Lots
import CoreSyn ( CoreExpr, CoreBind, Bind(..), CoreRule(..), IdCoreRule,
isBuiltinRule, rulesRules, rulesRhsFreeVars, emptyCoreRules,
- bindersOfBinds
+ bindersOfBinds, mustHaveLocalBinding
)
import CoreFVs ( exprSomeFreeVars, ruleSomeLhsFreeVars, ruleSomeFreeVars )
import CoreUnfold ( okToUnfoldInHiFile, mkTopUnfolding, neverUnfold, unfoldingTemplate, noUnfolding )
-import Name ( isLocallyDefined, getName, nameModule,
- Name, NamedThing(..)
- )
+import Name ( getName, nameModule, Name, NamedThing(..) )
import Name -- Env
import OccName ( pprOccName )
import TyCon ( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
-- The 'needed' set contains the Ids that are needed by earlier
-- interface file emissions. If the Id isn't in this set, and isn't
-- exported, there's no need to emit anything
- need_id needed_set id = id `elemVarSet` needed_set || isUserExportedId id
+ need_id needed_set id = id `elemVarSet` needed_set || isExportedId id
go needed [] emitted
| not (isEmptyVarSet needed) = pprTrace "ifaceBinds: free vars:"
find_fvs expr = exprSomeFreeVars interestingId expr
-interestingId id = isId id && isLocallyDefined id && not (hasNoBinding id)
+interestingId id = isId id && mustHaveLocalBinding id
\end{code}
tcQual mod str uq = mkKnownKeyGlobal (tcQual_RDR mod str) uq
clsQual mod str uq = mkKnownKeyGlobal (clsQual_RDR mod str) uq
-kindQual str uq = mkKnownKeyGlobal (mkRdrOrig pREL_GHC_Name (mkKindOccFS tcName str)) uq
+kindQual str uq = mkLocalName (mkKindOccFS tcName str) uq
-- Kinds are not z-encoded in interface file, hence mkKindOccFS
- -- And they all come from PrelGHC
+ -- And they don't come from any particular module; indeed we always
+ -- want to print them unqualified. Hence the LocalName
varQual_RDR mod str = mkOrig varName mod str
tcQual_RDR mod str = mkOrig tcName mod str
---------------
do_arg ids bindings arg@(StgVarArg old_var)
- | (not (isLocallyDefined old_var) || elemVarSet old_var ids)
+ | (not (isLocalVar old_var) || elemVarSet old_var ids)
&& isFunType var_type
= -- make a trivial let-binding for the top-level function
getUniqueMM `thenMM` \ uniq ->
\end{code}
\begin{code}
-rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, ModIface, [RenamedHsDecl]))
+rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
= pushSrcLocRn loc $
-- FIND THE GLOBAL NAME ENVIRONMENT
- getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
- export_avails, global_avail_env) ->
+ getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
-- Exit if we've found any errors
checkErrsRn `thenRn` \ no_errs_so_far ->
returnRn Nothing
else
+ -- PROCESS EXPORT LIST (but not if we've had errors already)
+ exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
+
traceRn (text "Local top-level environment" $$
nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
mod_iface = ModIface { mi_module = this_module,
mi_version = initialVersionInfo,
- mi_usages = my_usages,
+ mi_usages = my_usages,
mi_boot = False,
mi_orphan = is_orphan,
mi_exports = my_exports,
}
print_unqualified = unQualInScope gbl_env
+ is_exported name = name `elemNameSet` exported_names
+ exported_names = availsToNameSet export_avails
in
-- REPORT UNUSED NAMES, AND DEBUG DUMP
imports global_avail_env
source_fvs export_avails rn_imp_decls `thenRn_`
- returnRn (Just (print_unqualified, mod_iface, final_decls))
+ returnRn (Just (print_unqualified, is_exported, mod_iface, final_decls))
where
mod_name = moduleName this_module
\end{code}
| nameIsLocalOrFrom this_mod n
= lookupDeprec my_deprecs n
| otherwise
- = case lookupIface hit pit this_mod n of
+ = case lookupIface hit pit n of
Just iface -> lookupDeprec (mi_deprecs iface) n
Nothing -> pprPanic "warnDeprecations:" (ppr n)
import RnMonad
import Name ( Name, NamedThing(..),
getSrcLoc,
- mkLocalName, mkImportedLocalName, mkGlobalName,
+ mkLocalName, mkGlobalName,
mkIPName, nameOccName, nameModule_maybe,
setNameModuleAndLoc
)
\fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
-For List and Tuple types it's important to get the correct
-@isLocallyDefined@ flag, which is used in turn when deciding
-whether there are any instance decls in this module are ``special''.
-The name cache should have the correct provenance, though.
\begin{code}
lookupOrigNames :: [RdrName] -> RnM d NameSet
let
(us', us1) = splitUniqSupply us
uniq = uniqFromSupply us1
- name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
+ name = mkLocalName uniq (rdrNameOcc rdr_name) loc
in
setNameSupplyRn (us', cache, ipcache) `thenRn_`
let
import Bag ( bagToList )
import Module ( ModuleName, moduleName, WhereFrom(..) )
import NameSet
-import Name ( Name, nameSrcLoc,
- setLocalNameSort, nameOccName, nameEnvElts )
+import Name ( Name, nameSrcLoc, nameOccName, nameEnvElts )
import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv,
GenAvailInfo(..), AvailInfo, Avails, AvailEnv )
import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual )
getGlobalNames :: Module -> RdrNameHsModule
-> RnMG (GlobalRdrEnv, -- Maps all in-scope things
GlobalRdrEnv, -- Maps just *local* things
- Avails, -- The exported stuff
- AvailEnv) -- Maps a name to its parent AvailInfo
- -- Just for in-scope things only
+ ExportAvails) -- The exported stuff
getGlobalNames this_mod (HsModule _ _ exports imports decls _ mod_loc)
- = -- These two fix-loops are to get the right
- -- provenance information into a Name
- fixRn ( \ ~(rec_gbl_env, _, rec_export_avails, _) ->
-
- let
- rec_exp_fn :: Name -> Bool
- rec_exp_fn = mk_export_fn (availsToNameSet rec_export_avails)
- in
-
- -- PROCESS LOCAL DECLS
+ = -- PROCESS LOCAL DECLS
-- Do these *first* so that the correct provenance gets
-- into the global name cache.
- importsFromLocalDecls this_mod rec_exp_fn decls `thenRn` \ (local_gbl_env, local_mod_avails) ->
+ importsFromLocalDecls this_mod decls `thenRn` \ (local_gbl_env, local_mod_avails) ->
-- PROCESS IMPORT DECLS
-- Do the non {- SOURCE -} ones first, so that we get a helpful
all_avails :: ExportAvails
all_avails = foldr plusExportAvails local_mod_avails (imp_avails_s2 ++ imp_avails_s1)
-
- (_, global_avail_env) = all_avails
in
- -- PROCESS EXPORT LIST (but not if we've had errors already)
- checkErrsRn `thenRn` \ no_errs_so_far ->
- (if no_errs_so_far then
- exportsFromAvail this_mod_name exports all_avails gbl_env
- else
- returnRn []
- ) `thenRn` \ export_avails ->
-
-- ALL DONE
- returnRn (gbl_env, local_gbl_env, export_avails, global_avail_env)
- )
+ returnRn (gbl_env, local_gbl_env, all_avails)
where
this_mod_name = moduleName this_mod
\begin{code}
-importsFromLocalDecls this_mod rec_exp_fn decls
- = mapRn (getLocalDeclBinders this_mod rec_exp_fn) decls `thenRn` \ avails_s ->
+importsFromLocalDecls this_mod decls
+ = mapRn (getLocalDeclBinders this_mod) decls `thenRn` \ avails_s ->
let
avails = concat avails_s
---------------------------
getLocalDeclBinders :: Module
- -> (Name -> Bool) -- Whether exported
-> RdrNameHsDecl -> RnMG Avails
-getLocalDeclBinders mod rec_exp_fn (TyClD tycl_decl)
+getLocalDeclBinders mod (TyClD tycl_decl)
= -- For type and class decls, we generate Global names, with
-- no export indicator. They need to be global because they get
-- permanently bound into the TyCons and Classes. They don't need
getTyClDeclBinders mod tycl_decl `thenRn` \ avail ->
returnRn [avail]
-getLocalDeclBinders mod rec_exp_fn (ValD binds)
- = mapRn (newLocalBinder mod rec_exp_fn)
- (bagToList (collectTopBinders binds))
+getLocalDeclBinders mod (ValD binds)
+ = mapRn new (bagToList (collectTopBinders binds))
+ where
+ new (rdr_name, loc) = newTopBinder mod rdr_name loc `thenRn` \ name ->
+ returnRn (Avail name)
-getLocalDeclBinders mod rec_exp_fn (ForD (ForeignDecl nm kind _ ext_nm _ loc))
+getLocalDeclBinders mod (ForD (ForeignDecl nm kind _ ext_nm _ loc))
| binds_haskell_name kind
- = newLocalBinder mod rec_exp_fn (nm, loc) `thenRn` \ avail ->
- returnRn [avail]
+ = newTopBinder mod nm loc `thenRn` \ name ->
+ returnRn [Avail name]
| otherwise -- a foreign export
= returnRn []
binds_haskell_name FoLabel = True
binds_haskell_name FoExport = isDynamicExtName ext_nm
-getLocalDeclBinders mod rec_exp_fn (FixD _) = returnRn []
-getLocalDeclBinders mod rec_exp_fn (DeprecD _) = returnRn []
-getLocalDeclBinders mod rec_exp_fn (DefD _) = returnRn []
-getLocalDeclBinders mod rec_exp_fn (InstD _) = returnRn []
-getLocalDeclBinders mod rec_exp_fn (RuleD _) = returnRn []
-
----------------------------
-newLocalBinder mod rec_exp_fn (rdr_name, loc)
- = -- Generate a local name, and with a suitable export indicator
- newTopBinder mod rdr_name loc `thenRn` \ name ->
- returnRn (Avail (setLocalNameSort name (rec_exp_fn name)))
+getLocalDeclBinders mod (FixD _) = returnRn []
+getLocalDeclBinders mod (DeprecD _) = returnRn []
+getLocalDeclBinders mod (DefD _) = returnRn []
+getLocalDeclBinders mod (InstD _) = returnRn []
+getLocalDeclBinders mod (RuleD _) = returnRn []
\end{code}
failWithRn occs (exportClashErr name_occ ie ie')
where
name_occ = nameOccName name
-
-mk_export_fn :: NameSet -> (Name -> Bool) -- True => exported
-mk_export_fn exported_names = \name -> name `elemNameSet` exported_names
\end{code}
%************************************************************************
import Id ( isDataConId, isOneShotLambda, setOneShotLambda,
idOccInfo, setIdOccInfo,
isExportedId, modifyIdInfo, idInfo,
- idSpecialisation,
+ idSpecialisation, isLocalId,
idType, idUnique, Id
)
import IdInfo ( OccInfo(..), shortableIdInfo, copyIdInfo )
import VarSet
import VarEnv
-import Name ( isLocallyDefined )
import Type ( splitFunTy_maybe, splitForAllTys )
import Maybes ( maybeToBool )
import Digraph ( stronglyConnCompR, SCC(..) )
-- Add occ info to tpl_vars, rhs
= Rule str tpl_vars' tpl_args rhs'
where
- (rhs_uds, rhs') = occurAnalyseExpr isLocallyDefined rhs
+ (rhs_uds, rhs') = occurAnalyseExpr isLocalId rhs
(_, tpl_vars') = tagBinders rhs_uds tpl_vars
\end{code}
other -> -- Ho ho! The normal case
(final_usage, ind_env, new_binds ++ binds')
-initialTopEnv = OccEnv isLocallyDefined -- Anything local is interesting
+initialTopEnv = OccEnv isLocalId -- Anything local is interesting
emptyVarSet
[]
-- how often I don't get shorting out becuase of IdInfo stuff
= if isExportedId exported_id && -- Only if this is exported
- isLocallyDefined local_id && -- Only if this one is defined in this
+ isLocalId local_id && -- Only if this one is defined in this
-- module, so that we *can* change its
-- binding to be the exported thing!
import ErrUtils ( dumpIfSet, dumpIfSet_dyn )
import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
-import Id ( Id, isDataConWrapId, setIdNoDiscard )
+import Id ( Id, isDataConWrapId, setIdNoDiscard, isLocalId )
import VarSet
import LiberateCase ( liberateCase )
import SAT ( doStaticArgs )
core2core :: DynFlags -- includes spec of what core-to-core passes to do
-> PackageRuleBase -- Rule-base accumulated from imported packages
-> HomeSymbolTable
+ -> IsExported
-> [CoreBind] -- Binds in
-> [IdCoreRule] -- Rules in
-> IO ([CoreBind], [IdCoreRule]) -- binds, local orphan rules out
-core2core dflags pkg_rule_base hst binds rules
+core2core dflags pkg_rule_base hst is_exported binds rules
= do
let core_todos = dopt_CoreToDo dflags
us <- mkSplitUniqSupply 's'
let (cp_us, ru_us) = splitUniqSupply us
-- COMPUTE THE RULE BASE TO USE
- (rule_base, binds1, orphan_rules)
- <- prepareRules dflags pkg_rule_base hst ru_us binds rules
+ (rule_base, local_rule_stuff, orphan_rules)
+ <- prepareRules dflags pkg_rule_base hst ru_us rules
+ -- PREPARE THE BINDINGS
+ let binds1 = updateBinders local_rule_stuff is_exported binds
-- DO THE BUSINESS
(stats, processed_binds)
\begin{code}
prepareRules :: DynFlags -> PackageRuleBase -> HomeSymbolTable
-> UniqSupply
- -> [CoreBind] -> [IdCoreRule] -- Local bindings and rules
- -> IO (RuleBase, -- Full rule base
- [CoreBind], -- Bindings augmented with rules
- [IdCoreRule]) -- Orphan rules
+ -> [IdCoreRule] -- Local rules
+ -> IO (RuleBase, -- Full rule base
+ (IdSet,IdSet), -- Local rule Ids, and RHS fvs
+ [IdCoreRule]) -- Orphan rules
prepareRules dflags pkg_rule_base hst us binds rules
= do { let (better_rules,_) = initSmpl dflags sw_chkr us local_ids black_list_all
; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
(vcat (map pprIdCoreRule better_rules))
- ; let (local_id_rules, orphan_rules) = partition ((`elemVarSet` local_ids) . fst) better_rules
- (binds1, local_rule_fvs) = addRulesToBinds binds local_id_rules
+ ; let (local_id_rules, orphan_rules) = partition (isLocalId . fst) better_rules
+ local_rule_rhs_fvs = unionVarSets (map ruleRhsFreeVars local_id_rules)
+ local_rule_base = extendRuleBaseList emptyRuleBase local_id_rules
+ local_rule_ids = ruleBaseIds local_rule_base -- Local Ids with rules attached
imp_rule_base = foldl add_rules pkg_rule_base (moduleEnvElts hst)
rule_base = extendRuleBaseList imp_rule_base orphan_rules
- final_rule_base = addRuleBaseFVs rule_base local_rule_fvs
+ final_rule_base = addRuleBaseFVs rule_base (ruleBaseFVs local_rule_base)
-- The last step black-lists the free vars of local rules too
- ; return (final_rule_base, binds1, orphan_rules)
+ ; return (final_rule_base, (local_rule_ids, local_rule_rhs_fvs), orphan_rules)
}
where
sw_chkr any = SwBool False -- A bit bogus
-- simpVar fails if it isn't right, and it might conceiveably matter
local_ids = foldr (unionVarSet . mkVarSet . bindersOf) emptyVarSet binds
-addRulesToBinds :: [CoreBind] -> [(Id,CoreRule)] -> ([CoreBind], IdSet)
+
+updateBinders :: IdSet -- Locally defined ids with their Rules attached
+ -> IdSet -- Ids free in the RHS of local rules
+ -> [CoreBind] -> [CoreBind]
-- A horrible function
- -- Attach the rules for each locally-defined Id to that Id.
- -- - This makes the rules easier to look up
- -- - It means that transformation rules and specialisations for
- -- locally defined Ids are handled uniformly
- -- - It keeps alive things that are referred to only from a rule
- -- (the occurrence analyser knows about rules attached to Ids)
- -- - It makes sure that, when we apply a rule, the free vars
- -- of the RHS are more likely to be in scope
- --
- -- Both the LHS and RHS Ids are marked 'no-discard'.
- -- This means that the binding won't be discarded EVEN if the binding
- -- ends up being trivial (v = w) -- the simplifier would usually just
- -- substitute w for v throughout, but we don't apply the substitution to
- -- the rules (maybe we should?), so this substitution would make the rule
- -- bogus.
-
-addRulesToBinds binds local_rules
- = (map zap_bind binds, rule_lhs_fvs)
+-- Update the binders of top-level bindings as follows
+-- a) Attach the rules for each locally-defined Id to that Id.
+-- b) Set the no-discard flag if either the Id is exported,
+-- or it's mentoined in the RHS of a rule
+--
+-- Reason for (a)
+-- - It makes the rules easier to look up
+-- - It means that transformation rules and specialisations for
+-- locally defined Ids are handled uniformly
+-- - It keeps alive things that are referred to only from a rule
+-- (the occurrence analyser knows about rules attached to Ids)
+-- - It makes sure that, when we apply a rule, the free vars
+-- of the RHS are more likely to be in scope
+--
+-- Reason for (b)
+-- It means that the binding won't be discarded EVEN if the binding
+-- ends up being trivial (v = w) -- the simplifier would usually just
+-- substitute w for v throughout, but we don't apply the substitution to
+-- the rules (maybe we should?), so this substitution would make the rule
+-- bogus.
+
+updateBinders rule_ids rule_rhs_fvs is_exported binds
+ = map update_bndrs binds
where
- -- rule_fvs is the set of all variables mentioned in this module's rules
- rule_fvs = unionVarSets [ ruleSomeFreeVars isId rule | (_,rule) <- local_rules ]
-
- rule_base = extendRuleBaseList emptyRuleBase local_rules
- rule_lhs_fvs = ruleBaseFVs rule_base
- rule_ids = ruleBaseIds rule_base
-
- zap_bind (NonRec b r) = NonRec (zap_bndr b) r
- zap_bind (Rec prs) = Rec [(zap_bndr b, r) | (b,r) <- prs]
-
- zap_bndr bndr = case lookupVarSet rule_ids bndr of
- Just bndr' -> setIdNoDiscard bndr'
- Nothing | bndr `elemVarSet` rule_fvs -> setIdNoDiscard bndr
- | otherwise -> bndr
+ update_bndrs (NonRec b r) = NonRec (update_bndr b) r
+ update_bndrs (Rec prs) = Rec [(update_bndr b, r) | (b,r) <- prs]
+
+ update_bndr bndr
+ | is_exported (getName bndr)
+ || bndr `elemVarSet` rule_rhs_fvs = setIdNoDiscard bndr'
+ | otherwise = bndr'
+ where
+ bndr' = lookupVarSet rule_ids bndr `orElse` bndr
\end{code}
import StgSyn
-import Id ( setIdArityInfo, idArity, setIdOccInfo, Id )
+import Id ( isLocalId, setIdArityInfo, idArity, setIdOccInfo, Id )
import VarSet
import VarEnv
import Var
import PrimOp ( PrimOp(..), ccallMayGC )
import TysWiredIn ( isForeignObjTy )
import Maybes ( maybeToBool, orElse )
-import Name ( isLocallyDefined, getOccName )
+import Name ( isLocalName, getOccName )
import OccName ( occNameUserString )
import BasicTypes ( Arity )
import Outputable
sw env lvs_cont
where
do_one v
- = if isLocallyDefined v then
+ = if isLocalId v then
case (lookupVarEnv env v) of
Just (_, LetrecBound _ lvs) -> extendVarSet lvs v
- Just _ -> unitVarSet v
+ Just _ -> unitVarSet v
Nothing -> pprPanic "lookupVarEnv/do_one:" (ppr v)
else
emptyVarSet
= getUniqSM `thenSM` \ uniq ->
let
-- Give the new Id a similar occurrence name to the old one
- -- We used to add setIdNoDiscard if the old id was exported, to
- -- avoid it being dropped as dead code, but that's not necessary any more.
name = idName old_id
new_id = mkUserLocal (mkSpecOcc (nameOccName name)) uniq new_ty (getSrcLoc name)
in
import StgSyn
import Bag ( Bag, emptyBag, isEmptyBag, snocBag )
-import Id ( Id, idType )
+import Id ( Id, idType, isLocalId )
import VarSet
import DataCon ( DataCon, dataConArgTys, dataConRepType )
import PrimOp ( primOpType )
import Literal ( literalType, Literal )
import Maybes ( catMaybes )
-import Name ( isLocallyDefined, getSrcLoc )
+import Name ( getSrcLoc )
import ErrUtils ( ErrMsg, Message, addErrLocHdrLine, pprBagOfErrors, dontAddErrLoc )
import Type ( mkFunTys, splitFunTys, splitAlgTyConApp_maybe,
isUnLiftedType, isTyVarTy, splitForAllTys, Type
\begin{code}
checkInScope :: Id -> LintM ()
checkInScope id loc scope errs
- = if isLocallyDefined id && not (id `elemVarSet` scope) then
+ = if isLocalId id && not (id `elemVarSet` scope) then
((), addErr errs (hsep [ppr id, ptext SLIT("is out of scope")]) loc)
else
((), errs)
import TcMonad
import TcType ( zonkTcTypeToType, zonkTcTyVarToTyVar, zonkTcType, zonkTcSigTyVars
)
-import Name ( isLocallyDefined )
import CoreSyn ( Expr )
import CoreUnfold( unfoldingTemplate )
import BasicTypes ( RecFlag(..) )
zonkIdOcc :: TcId -> NF_TcM Id
zonkIdOcc id
- | not (isLocallyDefined id) || omitIfaceSigForId id || isIP id
- -- The omitIfaceSigForId thing may look wierd but it's quite
- -- sensible really. We're avoiding looking up superclass selectors
+ | not (isLocalId id) || isIP id
+ -- We're avoiding looking up superclass selectors
-- and constructors; zonking them is a no-op anyway, and the
-- superclass selectors aren't in the environment anyway.
= returnNF_Tc id
import CoreLint ( lintUnfolding )
import WorkWrap ( mkWrapper )
-import Id ( Id, mkId, mkVanillaId, isDataConWrapId_maybe )
+import Id ( Id, mkId, mkImportedId, isDataConWrapId_maybe )
import MkId ( mkCCallOpId )
import IdInfo
import DataCon ( dataConSig, dataConArgTys )
import Type ( mkTyVarTys, splitAlgTyConApp_maybe )
import Var ( mkTyVar, tyVarKind )
-import Name ( Name, isLocallyDefined )
+import Name ( Name )
import Demand ( wwLazy )
import ErrUtils ( pprBagOfErrors )
import Outputable
| TyClD (IfaceSig name ty id_infos src_loc) <- decls]
where
in_scope_vars = [] -- I think this will be OK
- -- If so, don't pass it around
- -- Was: filter isLocallyDefined (tcEnvIds unf_env)
do_one name ty id_infos src_loc
= tcAddSrcLoc src_loc $
tcHsType ty `thenTc` \ sigma_ty ->
tcIdInfo unf_env in_scope_vars name
sigma_ty vanillaIdInfo id_infos `thenTc` \ id_info ->
- returnTc (mkId name sigma_ty id_info)
+ returnTc (mkImportedId name sigma_ty id_info)
\end{code}
\begin{code}
import ErrUtils ( Message )
import TyCon ( TyCon, isSynTyCon, tyConArity, tyConKind )
import Class ( ClassContext, classArity, classTyCon )
-import Name ( Name, isLocallyDefined )
+import Name ( Name )
import TysWiredIn ( mkListTy, mkTupleTy, genUnitTyCon )
import UniqFM ( elemUFM )
import BasicTypes ( Boxity(..), RecFlag(..), isRec )
= returnNF_Tc (tidy_env, acc)
find_globals tv tidy_env acc (id:ids)
- | not (isLocallyDefined id) ||
- isEmptyVarSet (idFreeTyVars id)
+ | isEmptyVarSet (idFreeTyVars id)
= find_globals tv tidy_env acc ids
| otherwise
projects / ghc-hetmet.git / commitdiff