Commit db95d6e8 authored by simonpj's avatar simonpj

[project @ 2000-11-14 08:07:11 by simonpj]

Changing the way we know whether
something is exported.

THIS COMMIT WON'T EVEN COMPILE
(I'm doing it to transfer from my laptop.)
Wait till later today before updating.
parent 133dcbb9
......@@ -36,7 +36,7 @@ import Type ( Type, TauType, ClassContext,
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 )
......@@ -454,9 +454,8 @@ unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type
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
......
......@@ -32,7 +32,7 @@ module Id (
isDataConId, isDataConId_maybe, isDataConWrapId,
isDataConWrapId_maybe,
isBottomingId,
isExportedId, isUserExportedId,
isExportedId, isLocalId,
hasNoBinding,
-- Inline pragma stuff
......@@ -91,7 +91,7 @@ import IdInfo
import Demand ( Demand )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
isUserExportedName, nameIsLocallyDefined,
nameIsLocallyDefined,
getOccName, isIPOcc
)
import OccName ( UserFS )
......@@ -132,10 +132,10 @@ Absolutely all Ids are made by mkId. It
\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}
......@@ -255,18 +255,21 @@ hasNoBinding id = case idFlavour id of
-- 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}
......@@ -302,7 +305,7 @@ omitIfaceSigForId' id
-- 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}
......
......@@ -17,7 +17,7 @@ module IdInfo (
-- Flavour
IdFlavour(..), flavourInfo,
setNoDiscardInfo,
setNoDiscardInfo, setFlavourInfo,
ppFlavourInfo,
-- Arity
......@@ -164,6 +164,7 @@ megaSeqIdInfo info
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 }
......@@ -236,7 +237,12 @@ mkIdInfo flv = IdInfo {
\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
......@@ -245,17 +251,17 @@ data IdFlavour
-- 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` ()
......
......@@ -10,17 +10,16 @@ module Name (
-- 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,
......@@ -36,7 +35,7 @@ module Name (
-- Class NamedThing and overloaded friends
NamedThing(..),
getSrcLoc, isLocallyDefined, getOccString, toRdrName,
getSrcLoc, getOccString, toRdrName,
isFrom, isLocalOrFrom
) where
......@@ -70,11 +69,11 @@ data Name = Name {
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
......@@ -83,17 +82,18 @@ data NameSort
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
......@@ -124,7 +124,6 @@ nameModule_maybe name = Nothing
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
......@@ -145,15 +144,9 @@ nameIsFrom from other = pprPanic "nameIsFrom" (ppr other)
-- 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}
......@@ -177,18 +170,6 @@ mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, n_
-- * 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 }
......@@ -244,11 +225,6 @@ setNameModuleAndLoc :: Name -> Module -> SrcLoc -> Name
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}
......@@ -293,23 +269,18 @@ are exported. But also:
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
......@@ -359,7 +330,7 @@ nameRdrName (Name { n_occ = occ }) = mkRdrUnqual occ
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
......@@ -460,13 +431,12 @@ pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
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
......@@ -500,20 +470,15 @@ class NamedThing a where
\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}
......@@ -44,7 +44,7 @@ import VarEnv
import VarSet ( varSetElems )
import Literal ( Literal )
import Maybes ( catMaybes, maybeToBool )
import Name ( isLocallyDefined, NamedThing(..) )
import Name ( isLocalName, NamedThing(..) )
#ifdef DEBUG
import PprAbsC ( pprAmode )
#endif
......@@ -251,7 +251,7 @@ I {\em think} all looking-up is done through @getCAddrMode(s)@.
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
......
......@@ -21,26 +21,11 @@ import CoreSyn
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}
%************************************************************************
%* *
......@@ -58,7 +43,7 @@ but not those that are free in the type of variable occurrence.
\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
......@@ -166,7 +151,7 @@ rulesSomeFreeVars interesting (Rules rules _)
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)
......@@ -259,8 +244,8 @@ freeVars (Var v)
-- 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)
......
......@@ -15,7 +15,8 @@ module CoreSyn (
mkConApp,
varToCoreExpr,
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, isTyVar, isId,
isTyVar, isId, isLocalVar, mustHaveLocalBinding,
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
collectArgs, collectBindersIgnoringNotes,
coreExprCc,
......@@ -106,6 +107,29 @@ data Note
\end{code}
%************************************************************************
%* *
\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}
......
......@@ -216,7 +216,7 @@ tidyTopId :: Module -> TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
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'
......
......@@ -26,7 +26,7 @@ import Match ( matchWrapper )
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 )
......@@ -188,7 +188,7 @@ addSccs NoSccs exports = NoSccs
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)
......
......@@ -153,7 +153,8 @@ toUfApp (App f a) as = toUfApp f (a:as)
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
......
......@@ -33,7 +33,7 @@ import Type ( Type, Kind, PredType(..), ClassContext,
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 )
......@@ -88,10 +88,8 @@ hsUsOnce = HsTyVar (mkUnqual tvName SLIT(".")) -- deep magic
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
--
......@@ -685,8 +685,9 @@ doLink o_files = do
#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"
......
......@@ -175,7 +175,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
<- 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
......@@ -196,7 +196,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
-------------------
-- 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
-------------------
......@@ -315,7 +315,7 @@ restOfCodeGeneration dflags toInterp this_mod imported_module_names cost_centre_
(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)
......@@ -324,7 +324,7 @@ dsThenSimplThenTidy dflags rule_base this_mod print_unqual tc_result hst
-------------------------- 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)
......
......@@ -24,7 +24,7 @@ module HscTypes (
WhetherHasOrphans, ImportVersion, WhatsImported(..),
PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
IfaceInsts, IfaceRules, GatedDecl,
IfaceInsts, IfaceRules, GatedDecl, IsExported,
OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
AvailEnv, AvailInfo, GenAvailInfo(..),
PersistentCompilerState(..),
......@@ -45,8 +45,7 @@ module HscTypes (
#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,
......@@ -222,19 +221,16 @@ emptyIfaceTable = emptyModuleEnv
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}
......@@ -285,8 +281,7 @@ extendTypeEnvList env things
\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}
......@@ -403,6 +398,8 @@ data WhatsImported name = NothingAtAll -- The module is below us in the
-- 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}
......
......@@ -28,7 +28,7 @@ import HscTypes ( VersionInfo(..), ModIface(..), ModDetails(..),
)
import CmdLineOpts
import Id ( Id, idType, idInfo, omitIfaceSigForId, isUserExportedId, hasNoBinding,
import Id ( Id, idType, idInfo, omitIfaceSigForId, isExportedId, hasNoBinding,
idSpecialisation, idName, setIdInfo
)
import Var ( isId )
......@@ -37,13 +37,11 @@ import DataCon ( StrictnessMark(..), dataConSig, dataConFieldLabels, dataConStr
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,
......@@ -328,7 +326,7 @@ bindsToIds needed_ids codegen_ids binds
-- 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:"
......@@ -479,7 +477,7 @@ mkFinalId codegen_ids is_rec id rhs
find_fvs expr = exprSomeFreeVars interestingId expr