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

Compiles most of the Prelude; versioning still not good

11 files changed, 111 insertions, 78 deletions

diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs
index 1f3005aec9..a39ed3d9f9 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 43146b569c..f46c491bd8 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 8ada4be7c4..2fcff8b0dc 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 9a5c242dc6..928f8ef898 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 75a8f6f329..023145c8a3 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 b5978923f7..edb98f8677 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 a66c4510bf..0e4d05111d 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 670db8eac4..41e366eecb 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 ca18b67284..8b145d504d 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 9c4bf6e0af..ec98479766 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 12bc8e922c..785a5695b3 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