diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs
index 1f3005aec917ffa69587f7f3705646c23eaa6128..a39ed3d9f931d606d944b8f81a2198bb7a1409d3 100644
--- a/ghc/compiler/compMan/CmLink.lhs
+++ b/ghc/compiler/compMan/CmLink.lhs
@@ -12,11 +12,11 @@ module CmLink ( Linkable(..), Unlinked(..),
PersistentLinkerState{-abstractly!-}, emptyPLS )
where
+
import Interpreter
import CmStaticInfo ( PackageConfigInfo )
import Module ( ModuleName, PackageName )
import Outputable ( SDoc )
-import FiniteMap ( emptyFM )
import Digraph ( SCC(..), flattenSCC )
import Outputable
import Panic ( panic )
@@ -82,12 +82,8 @@ instance Outputable Linkable where
ppr (LP package_nm) = text "LinkableP" <+> ptext package_nm
emptyPLS :: IO PersistentLinkerState
-#ifdef GHCI
-emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
- itbl_env = emptyFM })
-#else
-emptyPLS = return (PersistentLinkerState {})
-#endif
+emptyPLS = return (PersistentLinkerState { closure_env = emptyClosureEnv,
+ itbl_env = emptyItblEnv })
\end{code}
\begin{code}
diff --git a/ghc/compiler/ghci/StgInterp.lhs b/ghc/compiler/ghci/StgInterp.lhs
index 43146b569c473a4a64c6bce174fd77d282b9c402..f46c491bd846e54bdb96007e81ecc3b6c75944db 100644
--- a/ghc/compiler/ghci/StgInterp.lhs
+++ b/ghc/compiler/ghci/StgInterp.lhs
@@ -74,6 +74,7 @@ import CTypes
type ItblEnv = FiniteMap RdrName (Ptr StgInfoTable)
type ClosureEnv = FiniteMap RdrName HValue
+emptyClosureEnv = emptyFM
-- ---------------------------------------------------------------------------
-- Run our STG program through the interpreter
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 8ada4be7c4d17e1c55fd87354bb81f7be044df54..2fcff8b0dc9c26011ad7a9e2e761e57df996466b 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -22,7 +22,6 @@ import Rename ( renameModule, checkOldIface, closeIfaceDecls )
import Rules ( emptyRuleBase )
import PrelInfo ( wiredInThingEnv, wiredInThings )
import PrelNames ( knownKeyNames )
-import PrelRules ( builtinRules )
import MkIface ( completeIface, mkModDetailsFromIface, mkModDetails,
writeIface )
import TcModule ( TcResults(..), typecheckModule )
@@ -46,7 +45,7 @@ import UniqSupply ( mkSplitUniqSupply )
import Bag ( emptyBag )
import Outputable
-import Interpreter
+import Interpreter ( UnlinkedIBind, ItblEnv, stgToInterpSyn )
import HscStats ( ppSourceStats )
import HscTypes ( ModDetails, ModIface(..), PersistentCompilerState(..),
PersistentRenamerState(..), ModuleLocation(..),
@@ -128,7 +127,7 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
-- TYPECHECK
maybe_tc_result
- <- typecheckModule dflags this_mod pcs_cl hst hit cl_hs_decls;
+ <- typecheckModule dflags this_mod pcs_cl hst old_iface cl_hs_decls;
case maybe_tc_result of {
Nothing -> return (HscFail pcs_cl);
Just tc_result -> do {
@@ -176,7 +175,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
-- TYPECHECK
show_pass dflags "Typechecker";
maybe_tc_result
- <- typecheckModule dflags this_mod pcs_rn hst hit rn_hs_decls;
+ <- typecheckModule dflags this_mod pcs_rn hst new_iface rn_hs_decls;
case maybe_tc_result of {
Nothing -> do { hPutStrLn stderr "Typechecked failed"
; return (HscFail pcs_rn) } ;
diff --git a/ghc/compiler/main/Interpreter.hs b/ghc/compiler/main/Interpreter.hs
index 9a5c242dc64aba8b5b7423d0358af3a8823c3e52..928f8ef8983e4cfaeb92678b5d290da1f7b0bd66 100644
--- a/ghc/compiler/main/Interpreter.hs
+++ b/ghc/compiler/main/Interpreter.hs
@@ -1,5 +1,5 @@
-----------------------------------------------------------------------------
--- $Id: Interpreter.hs,v 1.2 2000/11/08 13:51:58 simonmar Exp $
+-- $Id: Interpreter.hs,v 1.3 2000/11/08 14:52:06 simonpj Exp $
--
-- Interpreter subsystem wrapper
--
@@ -13,7 +13,8 @@ module Interpreter (
module InterpSyn,
module Linker
#else
- ClosureEnv, ItblEnv,
+ ClosureEnv, emptyClosureEnv,
+ ItblEnv, emptyItblEnv,
linkIModules,
stgToInterpSyn,
HValue,
@@ -23,16 +24,37 @@ module Interpreter (
) where
#ifdef GHCI
+
+---------------------------------------------
+-- YES! We have an interpreter
+---------------------------------------------
+
import StgInterp
import InterpSyn
import Linker
+
#else
+
+import Outputable
+
+---------------------------------------------
+-- NO! No interpreter; generate stubs for all the bits
+---------------------------------------------
+
type ClosureEnv = ()
+emptyClosureEnv = ()
+
type ItblEnv = ()
-linkIModules = error "linkIModules"
-stgToInterpSyn = error "linkIModules"
-type HValue = ()
-type UnlinkedIBind = ()
-loadObjs = error "loadObjs"
-resolveObjs = error "loadObjs"
+emptyItblEnv = ()
+
+type HValue = ()
+data UnlinkedIBind = UnlinkedIBind
+
+instance Outputable UnlinkedIBind where
+ ppr x = text "Can't output UnlinkedIBind"
+
+linkIModules = error "linkIModules"
+stgToInterpSyn = error "linkIModules"
+loadObjs = error "loadObjs"
+resolveObjs = error "loadObjs"
#endif
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 75a8f6f329a30e5cf76c3af09b78072e2d3d3850..023145c8a3534fef8fba657b02408959e9e51acb 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -25,9 +25,9 @@ import RnIfaces ( slurpImpDecls, mkImportInfo,
getInterfaceExports, closeDecls,
RecompileRequired, outOfDate, recompileRequired
)
-import RnHiFiles ( readIface, removeContext,
+import RnHiFiles ( readIface, removeContext, loadInterface,
loadExports, loadFixDecls, loadDeprecs )
-import RnEnv ( availsToNameSet,
+import RnEnv ( availsToNameSet, availName,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
lookupOrigNames, lookupSrcName, newGlobalName
@@ -37,11 +37,10 @@ import Module ( Module, ModuleName, WhereFrom(..),
mkModuleInThisPackage, mkModuleName, moduleEnvElts
)
import Name ( Name, NamedThing(..), getSrcLoc,
- nameIsLocalOrFrom,
- nameOccName, nameModule,
+ nameIsLocalOrFrom, nameOccName, nameModule,
)
import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
-import RdrName ( elemRdrEnv, foldRdrEnv, isQual )
+import RdrName ( rdrEnvToList, elemRdrEnv, foldRdrEnv, isQual )
import OccName ( occNameFlavour )
import NameSet
import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
@@ -65,7 +64,7 @@ import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
ModIface(..), WhatsImported(..),
VersionInfo(..), ImportVersion,
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
- GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo,
+ GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
Provenance(..), ImportReason(..), initialVersionInfo,
Deprecations(..), lookupDeprec, lookupIface
)
@@ -137,7 +136,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
-- SLURP IN ALL THE NEEDED DECLARATIONS
implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
let
- slurp_fvs = implicit_fvs `plusFV` source_fvs
+ slurp_fvs = implicit_fvs `plusFV` source_fvs
-- It's important to do the "plus" this way round, so that
-- when compiling the prelude, locally-defined (), Bool, etc
-- override the implicit ones.
@@ -181,19 +180,11 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
mi_deprecs = my_deprecs,
mi_decls = panic "mi_decls"
}
-
- -- The export_fvs make the exported names look just as if they
- -- occurred in the source program.
- -- We only need the 'parent name' of the avail;
- -- that's enough to suck in the declaration.
- export_fvs = availsToNameSet export_avails
- used_vars = source_fvs `plusFV` export_fvs
-
in
-- REPORT UNUSED NAMES, AND DEBUG DUMP
reportUnusedNames mod_iface imports global_avail_env
- used_vars rn_imp_decls `thenRn_`
+ source_fvs export_avails rn_imp_decls `thenRn_`
returnRn (Just (mod_iface, final_decls))
where
@@ -404,9 +395,7 @@ loadOldIface :: ParsedIface -> RnMG ModIface
loadOldIface parsed_iface
= let iface = parsed_iface
- in -- RENAME IT
- let mod = pi_mod iface
- doc_str = ptext SLIT("need usage info from") <+> ppr mod
+ mod = pi_mod iface
in
initIfaceRnMS mod (
loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
@@ -523,16 +512,18 @@ closeIfaceDecls dflags hit hst pcs
\begin{code}
reportUnusedNames :: ModIface -> [RdrNameImportDecl]
-> AvailEnv
- -> NameSet
+ -> NameSet -- Used in this module
+ -> Avails -- Exported by this module
-> [RenamedHsDecl]
-> RnMG ()
reportUnusedNames my_mod_iface imports avail_env
- used_names imported_decls
+ source_fvs export_avails imported_decls
= warnUnusedModules unused_imp_mods `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
warnUnusedImports bad_imp_names `thenRn_`
printMinimalImports this_mod minimal_imports `thenRn_`
- warnDeprecations this_mod my_deprecs really_used_names `thenRn_`
+ warnDeprecations this_mod export_avails my_deprecs
+ really_used_names `thenRn_`
traceRn (text "Used" <+> fsep (map ppr (nameSetToList used_names))) `thenRn_`
returnRn ()
@@ -541,6 +532,11 @@ reportUnusedNames my_mod_iface imports avail_env
gbl_env = mi_globals my_mod_iface
my_deprecs = mi_deprecs my_mod_iface
+ -- The export_fvs make the exported names look just as if they
+ -- occurred in the source program.
+ export_fvs = availsToNameSet export_avails
+ used_names = source_fvs `plusFV` export_fvs
+
-- Now, a use of C implies a use of T,
-- if C was brought into scope by T(..) or T(C)
really_used_names = used_names `unionNameSets`
@@ -637,13 +633,17 @@ reportUnusedNames my_mod_iface imports avail_env
module_unused :: Module -> Bool
module_unused mod = moduleName mod `elem` unused_imp_mods
-
-warnDeprecations this_mod my_deprecs used_names
+warnDeprecations this_mod export_avails my_deprecs used_names
= doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
if not warn_drs then returnRn () else
- getIfacesRn `thenRn` \ ifaces ->
- getHomeIfaceTableRn `thenRn` \ hit ->
+ -- The home modules for things in the export list
+ -- may not have been loaded yet; do it now, so
+ -- that we can see their deprecations, if any
+ mapRn_ load_home export_mods `thenRn_`
+
+ getIfacesRn `thenRn` \ ifaces ->
+ getHomeIfaceTableRn `thenRn` \ hit ->
let
pit = iPIT ifaces
deprecs = [ (n,txt)
@@ -653,6 +653,13 @@ warnDeprecations this_mod my_deprecs used_names
mapRn_ warnDeprec deprecs
where
+ export_mods = nub [ moduleName (nameModule name)
+ | avail <- export_avails,
+ let name = availName avail,
+ not (nameIsLocalOrFrom this_mod name) ]
+
+ load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
+
lookup_deprec hit pit n
| nameIsLocalOrFrom this_mod n
= lookupDeprec my_deprecs n
@@ -752,7 +759,7 @@ getRnStats imported_decls ifaces
stats = vcat
[int n_mods <+> text "interfaces read",
- hsep [ int n_decls_slurped, text "class decls imported, out of",
+ hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
int (n_decls_slurped + n_decls_left), text "read"],
hsep [ int n_insts_slurped, text "instance decls imported, out of",
int (n_insts_slurped + n_insts_left), text "read"],
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index b5978923f7643639f2f3495ca202e45e377f337a..edb98f86773737639755029bbd05ec125382c03a 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -52,7 +52,7 @@ import RdrName ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
RdrNameEnv, emptyRdrEnv, extendRdrEnv,
addListToRdrEnv, rdrEnvToList, rdrEnvElts
)
-import Name ( Name, OccName, NamedThing(..), getSrcLoc,
+import Name ( Name, OccName, NamedThing(..),
nameOccName,
decode, mkLocalName, mkKnownKeyGlobal
)
@@ -450,7 +450,8 @@ mapRn :: (a -> RnM d b) -> [a] -> RnM d [b]
mapRn_ :: (a -> RnM d b) -> [a] -> RnM d ()
mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
flatMapRn :: (a -> RnM d [b]) -> [a] -> RnM d [b]
-sequenceRn :: [RnM d a] -> RnM d [a]
+sequenceRn :: [RnM d a] -> RnM d [a]
+sequenceRn_ :: [RnM d a] -> RnM d ()
foldlRn :: (b -> a -> RnM d b) -> b -> [a] -> RnM d b
mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
fixRn :: (a -> RnM d a) -> RnM d a
@@ -466,9 +467,12 @@ andRn combiner m1 m2 gdown ldown
sequenceRn [] = returnRn []
sequenceRn (m:ms) = m `thenRn` \ r ->
- sequenceRn ms `thenRn` \ rs ->
+ sequenceRn ms `thenRn` \ rs ->
returnRn (r:rs)
+sequenceRn_ [] = returnRn ()
+sequenceRn_ (m:ms) = m `thenRn_` sequenceRn_ ms
+
mapRn f [] = returnRn []
mapRn f (x:xs)
= f x `thenRn` \ r ->
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index a66c4510bf98562de42874e1f9f44a23f80c9585..0e4d05111d9dbdb450c2e80b8dcfa5226803f7ea 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -182,7 +182,7 @@ importsFromImportDecl this_mod_name is_unqual (ImportDecl imp_mod_name from qual
-- then you'll get a 'B does not export AType' message. Oh well.
in
- filterImports imp_mod_name import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
+ filterImports imp_mod_name from import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
let
mk_provenance name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
@@ -277,6 +277,7 @@ available, and filters it through the import spec (if any).
\begin{code}
filterImports :: ModuleName -- The module being imported
+ -> WhereFrom -- Tells whether it's a {-# SOURCE #-} import
-> Maybe (Bool, [RdrNameIE]) -- Import spec; True => hiding
-> [AvailInfo] -- What's available
-> RnMG ([AvailInfo], -- What's actually imported
@@ -289,10 +290,10 @@ filterImports :: ModuleName -- The module being imported
-- Complains if import spec mentions things that the module doesn't export
-- Warns/informs if import spec contains duplicates.
-filterImports mod Nothing imports
+filterImports mod from Nothing imports
= returnRn (imports, [], emptyNameSet)
-filterImports mod (Just (want_hiding, import_items)) total_avails
+filterImports mod from (Just (want_hiding, import_items)) total_avails
= flatMapRn get_item import_items `thenRn` \ avails_w_explicits ->
let
(item_avails, explicits_s) = unzip avails_w_explicits
@@ -314,7 +315,7 @@ filterImports mod (Just (want_hiding, import_items)) total_avails
-- they won't make any difference because naked entities like T
-- in an import list map to TcOccs, not VarOccs.
- bale_out item = addErrRn (badImportItemErr mod item) `thenRn_`
+ bale_out item = addErrRn (badImportItemErr mod from item) `thenRn_`
returnRn []
get_item item@(IEModuleContents _) = bale_out item
@@ -604,9 +605,13 @@ mk_export_fn exported_names = \name -> name `elemNameSet` exported_names
%************************************************************************
\begin{code}
-badImportItemErr mod ie
- = sep [ptext SLIT("Module"), quotes (ppr mod),
+badImportItemErr mod from ie
+ = sep [ptext SLIT("Module"), quotes (ppr mod), source_import,
ptext SLIT("does not export"), quotes (ppr ie)]
+ where
+ source_import = case from of
+ ImportByUserSource -> ptext SLIT("(hi-boot interface)")
+ other -> empty
dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item
dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index 670db8eac4fbe7e478b0b4953cd0f5ba7b3edbe2..41e366eecb05e15aa264c1ac7c3d63f71f70a5ec 100644
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -63,7 +63,7 @@ import Panic ( panic, assertPanic )
import Maybes ( maybeToBool )
import Constants
import List ( partition, intersperse )
-import Outputable ( pprPanic, ppr )
+import Outputable ( pprPanic, ppr, pprTrace )
#if __GLASGOW_HASKELL__ >= 404
import GlaExts ( fromInt )
@@ -914,8 +914,8 @@ gen_Read_binds get_fixity tycon
c.f. Figure 18 in Haskell 1.1 report.
-}
paren_prec_limit
- | not is_infix = fromInt maxPrecedence
- | otherwise = getFixity get_fixity dc_nm
+ | not is_infix = defaultPrecedence
+ | otherwise = getPrecedence get_fixity dc_nm
read_paren_arg -- parens depend on precedence...
| nullary_con = false_Expr -- it's optional.
@@ -1027,8 +1027,8 @@ gen_Show_binds get_fixity tycon
c.f. Figure 16 and 17 in Haskell 1.1 report
-}
paren_prec_limit
- | not is_infix = fromInt maxPrecedence + 1
- | otherwise = getFixity get_fixity dc_nm + 1
+ | not is_infix = defaultPrecedence + 1
+ | otherwise = getPrecedence get_fixity dc_nm + 1
\end{code}
@@ -1041,24 +1041,26 @@ getLRPrecs is_infix get_fixity nm = [lp, rp]
cf. Figures 16-18 in Haskell 1.1 report.
-}
(con_left_assoc, con_right_assoc) = isLRAssoc get_fixity nm
- paren_con_prec = getFixity get_fixity nm
- maxPrec = fromInt maxPrecedence
+ paren_con_prec = getPrecedence get_fixity nm
lp
- | not is_infix = maxPrec + 1
+ | not is_infix = defaultPrecedence + 1
| con_left_assoc = paren_con_prec
| otherwise = paren_con_prec + 1
rp
- | not is_infix = maxPrec + 1
+ | not is_infix = defaultPrecedence + 1
| con_right_assoc = paren_con_prec
| otherwise = paren_con_prec + 1
-getFixity :: (Name -> Maybe Fixity) -> Name -> Integer
-getFixity get_fixity nm
+defaultPrecedence :: Integer
+defaultPrecedence = fromInt maxPrecedence
+
+getPrecedence :: (Name -> Maybe Fixity) -> Name -> Integer
+getPrecedence get_fixity nm
= case get_fixity nm of
Just (Fixity x _) -> fromInt x
- other -> pprPanic "TcGenDeriv.getFixity" (ppr nm)
+ other -> pprTrace "TcGenDeriv.getPrecedence" (ppr nm) defaultPrecedence
isLRAssoc :: (Name -> Maybe Fixity) -> Name -> (Bool, Bool)
isLRAssoc get_fixity nm =
diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index ca18b67284481f7baa51e472dabfbd7e2fa3e1ce..8b145d504dd1b0e39ec490cf410d1b363eeb22f4 100644
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -56,7 +56,7 @@ import PprType ( pprConstraint, pprPred )
import TyCon ( TyCon, isSynTyCon )
import Type ( splitDFunTy, isTyVarTy,
splitTyConApp_maybe, splitDictTy,
- splitAlgTyConApp_maybe, splitForAllTys,
+ splitForAllTys,
tyVarsOfTypes, mkClassPred, mkTyVarTy,
getClassTys_maybe
)
@@ -725,11 +725,6 @@ scrutiniseInstanceHead clas inst_taus
maybe_tycon_app = splitTyConApp_maybe first_inst_tau
Just (tycon, arg_tys) = maybe_tycon_app
- -- Stuff for an *algebraic* data type
- alg_tycon_app_maybe = splitAlgTyConApp_maybe first_inst_tau
- -- The "Alg" part looks through synonyms
- Just (alg_tycon, _, _) = alg_tycon_app_maybe
-
ccallable_type dflags ty = isFFIArgumentTy dflags False {- Not safe call -} ty
creturnable_type ty = isFFIResultTy ty
\end{code}
diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 9c4bf6e0aface98035c2d0dbfa55de2c32f4a150..ec9847976667906816a5d68a569ca4f3d677b63d 100644
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -80,11 +80,12 @@ typecheckModule
:: DynFlags
-> Module
-> PersistentCompilerState
- -> HomeSymbolTable -> HomeIfaceTable
+ -> HomeSymbolTable
+ -> ModIface -- Iface for this module
-> [RenamedHsDecl]
-> IO (Maybe TcResults)
-typecheckModule dflags this_mod pcs hst hit decls
+typecheckModule dflags this_mod pcs hst mod_iface decls
= do env <- initTcEnv hst (pcs_PTE pcs)
(maybe_result, (warns,errs)) <- initTc dflags env tc_module
@@ -105,11 +106,11 @@ typecheckModule dflags this_mod pcs hst hit decls
tc_module :: TcM (RecTcEnv, TcResults)
tc_module = fixTc (\ ~(unf_env ,_) -> tcModule pcs hst get_fixity this_mod decls unf_env)
- pit = pcs_PIT pcs
+ pit = pcs_PIT pcs
+ fixity_env = mi_fixities mod_iface
get_fixity :: Name -> Maybe Fixity
- get_fixity nm = lookupIface hit pit this_mod nm `thenMaybe` \ iface ->
- lookupNameEnv (mi_fixities iface) nm
+ get_fixity nm = lookupNameEnv fixity_env nm
\end{code}
The internal monster:
diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
index 12bc8e922c2a935278751c885a319e27f2fbaa40..785a5695b3b10799d99e7fc5d3c97fbc96d4602b 100644
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs
@@ -408,6 +408,7 @@ Edges in Type/Class decls
\begin{code}
tyClDeclFTVs :: RenamedTyClDecl -> [Name]
+ -- Find the free non-tyvar vars
tyClDeclFTVs d = foldNameSet add [] (tyClDeclFVs d)
where
add n fvs | isTyVarName n = fvs