[project @ 2000-10-17 15:57:57 by sewardj]

Fix enough renamer bits to get going again on the typechecker.
HACK ALERT: RnIfaces is almost completely #ifdef'd out!

ghc/compiler/basicTypes/Name.lhs

@@ -121,7 +121,7 @@ nameModule name				  = pprPanic "nameModule" (ppr name)
 \begin{code}
 isLocallyDefinedName	:: Name -> Bool
 isUserExportedName	:: Name -> Bool
-isLocalName		:: Name -> Bool		-- Not globala
+isLocalName		:: Name -> Bool		-- Not globals
 isGlobalName		:: Name -> Bool
 isSystemName		:: Name -> Bool
 isExternallyVisibleName :: Name -> Bool

ghc/compiler/prelude/PrelNames.lhs

@@ -807,6 +807,16 @@ enumFrom_RDR		= nameRdrName enumFromName
 mkInt_RDR		= nameRdrName intDataConName
 enumFromThen_RDR	= nameRdrName enumFromThenName
 enumFromThenTo_RDR	= nameRdrName enumFromThenToName
+ratioDataCon_RDR	= nameRdrName ratioDataConName
+plusInteger_RDR		= nameRdrName plusIntegerName
+timesInteger_RDR	= nameRdrName timesIntegerName
+enumClass_RDR		= nameRdrName enumClassName
+monadClass_RDR		= nameRdrName monadClassName
+ioDataCon_RDR		= nameRdrName ioDataConName
+cCallableClass_RDR	= nameRdrName cCallableClassName
+cReturnableClass_RDR	= nameRdrName cReturnableClassName
+eqClass_RDR		= nameRdrName eqClassName
+eqString_RDR		= nameRdrName eqStringName
 \end{code}
 
 

ghc/compiler/rename/RnBinds.lhs

@@ -31,15 +31,16 @@ import RnEnv		( bindLocatedLocalsRn, lookupBndrRn,
 			  warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
 			  FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV
 			)
-import CmdLineOpts	( opt_WarnMissingSigs )
+import CmdLineOpts	( DynFlag(..) )
 import Digraph		( stronglyConnComp, SCC(..) )
-import Name		( OccName, Name, nameOccName, mkUnboundName, isUnboundName )
+import Name		( OccName, Name, nameOccName )
 import NameSet
 import RdrName		( RdrName, rdrNameOcc )
 import BasicTypes	( RecFlag(..) )
 import List		( partition )
 import Bag		( bagToList )
 import Outputable
+import PrelNames	( mkUnboundName, isUnboundName )
 \end{code}
 
 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
@@ -169,11 +170,13 @@ rnTopMonoBinds mbinds sigs
     let
 	bndr_name_set = mkNameSet binder_names
     in
-    renameSigs (okBindSig bndr_name_set) sigs `thenRn` \ (siglist, sig_fvs) ->
+    renameSigs (okBindSig bndr_name_set) sigs 	`thenRn` \ (siglist, sig_fvs) ->
+    doptRn Opt_WarnMissingSigs			`thenRn` \ warnMissing ->
     let
 	type_sig_vars	= [n | Sig n _ _ <- siglist]
-	un_sigd_binders | opt_WarnMissingSigs = nameSetToList (delListFromNameSet bndr_name_set type_sig_vars)
-			| otherwise	      = []
+	un_sigd_binders | warnMissing = nameSetToList (delListFromNameSet 
+                                                          bndr_name_set type_sig_vars)
+			| otherwise   = []
     in
     mapRn_ (addWarnRn.missingSigWarn) un_sigd_binders	`thenRn_`
 

ghc/compiler/rename/RnExpr.lhs

@@ -26,12 +26,12 @@ import RnHsSyn
 import RnMonad
 import RnEnv
 import RnIfaces		( lookupFixityRn )
-import CmdLineOpts	( dopt_GlasgowExts, opt_IgnoreAsserts )
+import CmdLineOpts	( DynFlag(..), opt_IgnoreAsserts )
 import Literal		( inIntRange )
 import BasicTypes	( Fixity(..), FixityDirection(..), defaultFixity, negateFixity )
 import PrelNames	( hasKey, assertIdKey,
 			  eqClass_RDR, foldr_RDR, build_RDR, eqString_RDR,
-			  ccallableClass_RDR, creturnableClass_RDR, 
+			  cCallableClass_RDR, cReturnableClass_RDR, 
 			  monadClass_RDR, enumClass_RDR, ordClass_RDR,
 			  ratioDataCon_RDR, negate_RDR, assertErr_RDR,
 			  ioDataCon_RDR, plusInteger_RDR, timesInteger_RDR
@@ -67,9 +67,9 @@ rnPat (VarPatIn name)
     returnRn (VarPatIn vname, emptyFVs)
 
 rnPat (SigPatIn pat ty)
-  = doptsRn dopt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
+  = doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
     
-    if opt_GlasgowExts
+    if glaExts
     then rnPat pat		`thenRn` \ (pat', fvs1) ->
          rnHsType doc ty	`thenRn` \ (ty',  fvs2) ->
          returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
@@ -184,7 +184,7 @@ rnMatch match@(Match _ pats maybe_rhs_sig grhss)
 
     mapFvRn rnPat pats			`thenRn` \ (pats', pat_fvs) ->
     rnGRHSs grhss			`thenRn` \ (grhss', grhss_fvs) ->
-    doptsRn dopt_GlasgowExts		`thenRn` \ opt_GlasgowExts ->
+    doptRn Opt_GlasgowExts		`thenRn` \ opt_GlasgowExts ->
     (case maybe_rhs_sig of
 	Nothing -> returnRn (Nothing, emptyFVs)
 	Just ty | opt_GlasgowExts -> rnHsType doc_sig ty	`thenRn` \ (ty', ty_fvs) ->
@@ -220,7 +220,7 @@ rnGRHSs (GRHSs grhss binds maybe_ty)
     returnRn (GRHSs grhss' binds' Nothing, fvGRHSs)
 
 rnGRHS (GRHS guarded locn)
-  = doptsRn dopt_GlasgowExts		`thenRn` \ opt_GlasgowExts ->
+  = doptRn Opt_GlasgowExts		`thenRn` \ opt_GlasgowExts ->
     pushSrcLocRn locn $		    
     (if not (opt_GlasgowExts || is_standard_guard guarded) then
 		addWarnRn (nonStdGuardErr guarded)
@@ -345,8 +345,8 @@ rnExpr section@(SectionR op expr)
 
 rnExpr (HsCCall fun args may_gc is_casm fake_result_ty)
 	-- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
-  = lookupOrigNames [ccallableClass_RDR, 
-			  creturnableClass_RDR, 
+  = lookupOrigNames [cCallableClass_RDR, 
+			  cReturnableClass_RDR, 
 			  ioDataCon_RDR]	`thenRn` \ implicit_fvs ->
     rnExprs args				`thenRn` \ (args', fvs_args) ->
     returnRn (HsCCall fun args' may_gc is_casm fake_result_ty, 
@@ -799,7 +799,7 @@ litFVs (HsInt i)	      = returnRn (unitFV (getName intTyCon))
 litFVs (HsIntPrim i)          = returnRn (unitFV (getName intPrimTyCon))
 litFVs (HsFloatPrim f)        = returnRn (unitFV (getName floatPrimTyCon))
 litFVs (HsDoublePrim d)       = returnRn (unitFV (getName doublePrimTyCon))
-litFVs (HsLitLit l bogus_ty)  = lookupOrigName ccallableClass_RDR	`thenRn` \ cc ->   
+litFVs (HsLitLit l bogus_ty)  = lookupOrigName cCallableClass_RDR	`thenRn` \ cc ->   
 				returnRn (unitFV cc)
 litFVs lit		      = pprPanic "RnExpr.litFVs" (ppr lit)	-- HsInteger and HsRat only appear 
 									-- in post-typechecker translations

ghc/compiler/rename/RnIfaces.lhs

@@ -5,7 +5,10 @@
 
 \begin{code}
 module RnIfaces (
-	findAndReadIface, 
+#if 1
+	lookupFixityRn
+#else
+ 	findAndReadIface, 
 
 	getInterfaceExports, getDeferredDecls,
 	getImportedInstDecls, getImportedRules,
@@ -17,6 +20,7 @@ module RnIfaces (
 
 	getDeclBinders, getDeclSysBinders,
 	removeContext	 	-- removeContext probably belongs somewhere else
+#endif
     ) where
 
 #include "HsVersions.h"
@@ -41,11 +45,11 @@ import ParseIface	( parseIface, IfaceStuff(..) )
 
 import Name		( Name {-instance NamedThing-}, nameOccName,
 			  nameModule, isLocallyDefined, 
-			  isWiredInName, NamedThing(..),
+			  {-isWiredInName, -} NamedThing(..),
 			  elemNameEnv, extendNameEnv
 			 )
-import Module		( Module, mkVanillaModule, pprModuleName,
-			  moduleName, isLocalModule,
+import Module		( Module, mkVanillaModule,
+			  moduleName, isModuleInThisPackage,
 			  ModuleName, WhereFrom(..),
 			)
 import RdrName		( RdrName, rdrNameOcc )
@@ -62,8 +66,14 @@ import Lex
 import FiniteMap
 import Outputable
 import Bag
+import HscTypes
 
 import List	( nub )
+
+#if 1
+import Panic ( panic )
+lookupFixityRn = panic "lookupFixityRn"
+#else
 \end{code}
 
 
@@ -82,12 +92,12 @@ loadOrphanModules :: [ModuleName] -> RnM d ()
 loadOrphanModules mods
   | null mods = returnRn ()
   | otherwise = traceRn (text "Loading orphan modules:" <+> 
-			 fsep (map pprModuleName mods))		`thenRn_` 
+			 fsep (map mods))			`thenRn_` 
 		mapRn_ load mods				`thenRn_`
 		returnRn ()
   where
     load mod   = loadInterface (mk_doc mod) mod ImportBySystem
-    mk_doc mod = pprModuleName mod <+> ptext SLIT("is a orphan-instance module")
+    mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
 	   
 
 loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d Ifaces
@@ -164,7 +174,7 @@ tryLoadInterface doc_str mod_name from
 	-- about, it should be from a different package to this one
     WARN( not (maybeToBool mod_info) && 
 	  case from of { ImportBySystem -> True; other -> False } &&
-	  isLocalModule mod,
+	  isModuleInThisPackage mod,
 	  ppr mod )
 
     loadDecls mod		(iDecls ifaces)	  (pi_decls iface)	`thenRn` \ (decls_vers, new_decls) ->
@@ -220,7 +230,8 @@ addModDeps mod new_deps mod_deps
 	-- and in that case, forget about the boot indicator
     filtered_new_deps :: (ModuleName, (WhetherHasOrphans, IsBootInterface))
     filtered_new_deps
-	| isLocalModule mod = [ (imp_mod, (has_orphans, is_boot, False))
+	| isModuleInThisPackage mod 
+			    = [ (imp_mod, (has_orphans, is_boot, False))
 			      | (imp_mod, has_orphans, is_boot, _) <- new_deps 
 			      ]			      
 	| otherwise	    = [ (imp_mod, (True, False, False))
@@ -485,7 +496,7 @@ checkModUsage ((mod_name, _, _, whats_imported)  : rest)
   = tryLoadInterface doc_str mod_name ImportBySystem	`thenRn` \ (ifaces, maybe_err) ->
     case maybe_err of {
 	Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"), 
-				      pprModuleName mod_name]) ;
+				      ppr mod_name]) ;
 		-- Couldn't find or parse a module mentioned in the
 		-- old interface file.  Don't complain -- it might just be that
 		-- the current module doesn't need that import and it's been deleted
@@ -503,10 +514,10 @@ checkModUsage ((mod_name, _, _, whats_imported)  : rest)
     in
 	-- If the module version hasn't changed, just move on
     if new_mod_vers == old_mod_vers then
-	traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name])
+	traceRn (sep [ptext SLIT("Module version unchanged:"), ppr mod_name])
 	`thenRn_` checkModUsage rest
     else
-    traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name])
+    traceRn (sep [ptext SLIT("Module version has changed:"), ppr mod_name])
     `thenRn_`
 	-- Module version changed, so check entities inside
 
@@ -534,7 +545,7 @@ checkModUsage ((mod_name, _, _, whats_imported)  : rest)
 	returnRn outOfDate	-- This one failed, so just bail out now
     }}
   where
-    doc_str = sep [ptext SLIT("need version info for"), pprModuleName mod_name]
+    doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 
 
 checkEntityUsage mod decls [] 
@@ -699,15 +710,18 @@ getInterfaceExports mod_name from
   = getHomeSymbolTableRn 		`thenRn` \ hst ->
     case lookupModuleEnvByName hst mod_name of {
 	Just mds -> returnRn (mdModule mds, mdExports mds) ;
- 
-    loadInterface doc_str mod_name from	`thenRn` \ ifaces ->
-    case lookupModuleEnv (iPST ifaces) mod_name of
-	Just mds -> returnRn (mdModule mod, mdExports mds)
-	-- loadInterface always puts something in the map
-	-- even if it's a fake
+        Nothing  -> pprPanic "getInterfaceExports" (ppr mod_name)
+
+-- I think this is what it _used_ to say.  JRS, 001017 
+--    loadInterface doc_str mod_name from	`thenRn` \ ifaces ->
+--    case lookupModuleEnv (iPST ifaces) mod_name of
+--	Just mds -> returnRn (mdModule mod, mdExports mds)
+--	-- loadInterface always puts something in the map
+--	-- even if it's a fake
+
     }
     where
-      doc_str = sep [pprModuleName mod_name, ptext SLIT("is directly imported")]
+      doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
 \end{code}
 
 
@@ -950,7 +964,7 @@ mkImportExportInfo this_mod export_avails exports
 						-- but don't actually *use* anything from Foo
 					 	-- In which case record an empty dependency list
 		   where
-		     is_lib_module = not (isLocalModule mod)
+		     is_lib_module = not (isModuleInThisPackage mod)
 		     is_sys_import = case how_imported of
 					ImportBySystem -> True
 					other	       -> False
@@ -1152,7 +1166,7 @@ findAndReadIface doc_str mod_name hi_boot_file
     trace_msg = sep [hsep [ptext SLIT("Reading"), 
 			   if hi_boot_file then ptext SLIT("[boot]") else empty,
 			   ptext SLIT("interface for"), 
-			   pprModuleName mod_name <> semi],
+			   ppr mod_name <> semi],
 		     nest 4 (ptext SLIT("reason:") <+> doc_str)]
 \end{code}
 
@@ -1199,7 +1213,7 @@ readIface wanted_mod file_path
 
 \begin{code}
 noIfaceErr mod_name boot_file search_path
-  = vcat [ptext SLIT("Could not find interface file for") <+> quotes (pprModuleName mod_name),
+  = vcat [ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name),
 	  ptext SLIT("in the directories") <+> 
 			-- \& to avoid cpp interpreting this string as a
 			-- comment starter with a pre-4.06 mkdependHS --SDM
@@ -1229,14 +1243,15 @@ importDeclWarn name
 
 warnRedundantSourceImport mod_name
   = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
-          <+> quotes (pprModuleName mod_name)
+          <+> quotes (ppr mod_name)
 
 hiModuleNameMismatchWarn :: Module -> ModuleName  -> Message
 hiModuleNameMismatchWarn requested_mod read_mod = 
     hsep [ ptext SLIT("Something is amiss; requested module name")
-	 , ppr requested_mod
+	 , ppr (moduleName requested_mod)
 	 , ptext SLIT("differs from name found in the interface file")
-   	 , pprModuleName read_mod
+   	 , ppr read_mod
   	 ]
 
 \end{code}
+#endif /* TEMP DEBUG HACK! */
\ No newline at end of file

ghc/compiler/typecheck/TcDeriv.lhs

@@ -13,18 +13,20 @@ module TcDeriv ( tcDeriving ) where
 import HsSyn		( HsBinds(..), MonoBinds(..), collectLocatedMonoBinders )
 import RdrHsSyn		( RdrNameMonoBinds )
 import RnHsSyn		( RenamedHsBinds )
-import CmdLineOpts	( opt_D_dump_deriv )
+import CmdLineOpts	( DynFlag(..) )
 
 import TcMonad
-import TcEnv		( InstEnv, getEnvTyCons, tcSetInstEnv, newDFunName )
+import TcEnv		( TcEnv, tcSetInstEnv, getTcGST, newDFunName )
 import TcGenDeriv	-- Deriv stuff
-import TcInstUtil	( InstInfo(..), pprInstInfo, simpleDFunClassTyCon, extendInstEnv )
+import TcInstUtil	( InstInfo(..), InstEnv, 
+			  pprInstInfo, simpleDFunClassTyCon, extendInstEnv )
 import TcSimplify	( tcSimplifyThetas )
 
 import RnBinds		( rnMethodBinds, rnTopMonoBinds )
 import RnEnv		( bindLocatedLocalsRn )
-import RnMonad		( RnNameSupply, 
+import RnMonad		( --RnNameSupply, 
 			  renameSourceCode, thenRn, mapRn, returnRn )
+import HscTypes		( DFunId, GlobalSymbolTable, PersistentRenamerState )
 
 import Bag		( Bag, emptyBag, unionBags, listToBag )
 import Class		( classKey, Class )
@@ -35,17 +37,17 @@ import DataCon		( dataConArgTys, isNullaryDataCon, isExistentialDataCon )
 import PrelInfo		( needsDataDeclCtxtClassKeys )
 import Maybes		( maybeToBool, catMaybes )
 import Module		( Module )
-import Name		( isLocallyDefined, getSrcLoc, NamedThing(..) )
+import Name		( Name, isLocallyDefined, getSrcLoc, NamedThing(..) )
 import RdrName		( RdrName )
-import RnMonad		( FixityEnv )
+--import RnMonad		( FixityEnv )
 
 import TyCon		( tyConTyVars, tyConDataCons, tyConDerivings,
 			  tyConTheta, maybeTyConSingleCon, isDataTyCon,
 			  isEnumerationTyCon, isAlgTyCon, TyCon
 			)
 import Type		( TauType, mkTyVarTys, mkTyConApp,
-			  mkSigmaTy, mkDictTy, isUnboxedType,
-			  splitAlgTyConApp, classesToPreds
+			  mkSigmaTy, splitSigmaTy, splitDictTy, mkDictTy, 
+			  isUnboxedType, splitAlgTyConApp, classesToPreds
 			)
 import TysWiredIn	( voidTy )
 import Var		( TyVar )
@@ -215,7 +217,7 @@ tcDeriving prs mod inst_env_in local_tycons
     let
 	extra_mbind_list = map gen_tag_n_con_monobind nm_alist_etc
 	extra_mbinds     = foldr AndMonoBinds EmptyMonoBinds extra_mbind_list
-	method_binds_s   = map (gen_bind (tcGST env)) new_dfuns
+	method_binds_s   = map (gen_bind (getTcGST env)) new_dfuns
 	mbinders	 = collectLocatedMonoBinders extra_mbinds
 	
 	-- Rename to get RenamedBinds.
@@ -231,7 +233,7 @@ tcDeriving prs mod inst_env_in local_tycons
     in
     mapNF_Tc gen_inst_info (new_dfuns `zip` rn_method_binds_s)	`thenNF_Tc` \ new_inst_infos ->
 
-    ioToTc (dumpIfSet opt_D_dump_deriv "Derived instances" 
+    ioToTc (dumpIfSet Opt_D_dump_deriv "Derived instances" 
 		      (ddump_deriving new_inst_infos rn_extra_binds))	`thenTc_`
 
     returnTc (new_inst_infos, rn_extra_binds)
@@ -248,7 +250,7 @@ tcDeriving prs mod inst_env_in local_tycons
 		   iTys = tys, iTheta = theta, 
 		   iDFunId = dfun, iBinds = binds,
 		   iLoc = getSrcLoc dfun, iPrags = [] }
-      where
+        where
 	 (tyvars, theta, tau) = splitSigmaTy dfun
 	 (clas, tys)	      = splitDictTy tau
 
@@ -286,7 +288,7 @@ makeDerivEqns this_mod local_tycons
 	think_about_deriving = need_deriving local_tycons
 	(derive_these, _)    = removeDups cmp_deriv think_about_deriving
     in
-    if null local_data_tycons then
+    if null local_tycons then
 	returnTc []	-- Bale out now
     else
     mapTc mk_eqn derive_these `thenTc`	\ maybe_eqns ->
@@ -313,15 +315,16 @@ makeDerivEqns this_mod local_tycons
 
     mk_eqn (clas, tycon)
       = case chk_out clas tycon of
-	   Just err ->  addErrTc err	`thenNF_Tc_` 
+	   Just err ->  addErrTc err				`thenNF_Tc_` 
 			returnNF_Tc Nothing
-	   Nothing  ->  newDFunName this_mod clas tys locn 	`thenNF_Tc` \ dfun_name ->
+	   Nothing  ->  newDFunName this_mod clas tyvar_tys locn `thenNF_Tc` \ dfun_name ->
 			returnNF_Tc (Just (dfun_name, clas, tycon, tyvars, constraints))
       where
 	clas_key  = classKey clas
 	tyvars    = tyConTyVars tycon	-- ToDo: Do we need new tyvars ???
 	tyvar_tys = mkTyVarTys tyvars
 	data_cons = tyConDataCons tycon
+	locn	  = getSrcLoc tycon
 
 	constraints = extra_constraints ++ concat (map mk_constraints data_cons)
 
@@ -436,15 +439,15 @@ add_solns :: InstEnv				-- The global, non-derived ones
 
 add_solns inst_env_in eqns solns
   = (new_dfuns, inst_env)
-  where
-    new_dfuns     = zipWithEqual "add_solns" mk_deriv_dfun eqns solns
-    (inst_env, _) = extendInstEnv inst_env_in 	
+    where
+      new_dfuns     = zipWithEqual "add_solns" mk_deriv_dfun eqns solns
+      (inst_env, _) = extendInstEnv inst_env_in 	
 	-- Ignore the errors about duplicate instances.
 	-- We don't want repeated error messages
 	-- They'll appear later, when we do the top-level extendInstEnvs
 
-    mk_deriv_dfun (dfun_name clas, tycon, tyvars, _) theta
-      = mkDictFunId dfun_name clas tyvars [mkTyConApp tycon (mkTyVarTys tyvars)] theta
+      mk_deriv_dfun (dfun_name, clas, tycon, tyvars, _) theta
+        = mkDictFunId dfun_name clas tyvars [mkTyConApp tycon (mkTyVarTys tyvars)] theta
 \end{code}
 
 %************************************************************************
@@ -514,7 +517,7 @@ the renamer.  What a great hack!
 -- (paired with class name, as we need that when generating dict
 --  names.)
 gen_bind :: GlobalSymbolTable -> DFunId -> RdrNameMonoBinds
-gen_bind fixities inst
+gen_bind fixities dfun
   | not (isLocallyDefined tycon) = EmptyMonoBinds
   | clas `hasKey` showClassKey   = gen_Show_binds fixities tycon
   | clas `hasKey` readClassKey   = gen_Read_binds fixities tycon
@@ -575,7 +578,7 @@ gen_taggery_Names dfuns
   = foldlTc do_con2tag []           tycons_of_interest `thenTc` \ names_so_far ->
     foldlTc do_tag2con names_so_far tycons_of_interest
   where
-    all_CTs = map simplDFunClassTyCon dfuns
+    all_CTs = map simpleDFunClassTyCon dfuns
     all_tycons		    = map snd all_CTs
     (tycons_of_interest, _) = removeDups compare all_tycons
     
@@ -611,7 +614,6 @@ gen_taggery_Names dfuns
 	is_in_eqns clas_key tycon ((c,t):cts)
 	  =  (clas_key == classKey c && tycon == t)
 	  || is_in_eqns clas_key tycon cts
-
 \end{code}
 
 \begin{code}

ghc/compiler/typecheck/TcEnv.lhs

@@ -6,6 +6,7 @@ module TcEnv(
 	-- Getting stuff from the environment
 	TcEnv, initTcEnv, 
 	tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
+	getTcGST,
 	
 	-- Instance environment
 	tcGetInstEnv, tcSetInstEnv, 
@@ -159,6 +160,8 @@ tcEnvIds     env = [id | AnId   id <- nameEnvElts (tcGEnv env)]
 tcEnvTyVars  env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
 tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
 
+getTcGST (TcEnv { tcGST = gst }) = gst
+
 -- This data type is used to help tie the knot
 -- when type checking type and class declarations
 data TyThingDetails = SynTyDetails Type

ghc/compiler/typecheck/TcInstUtil.lhs

@@ -8,7 +8,7 @@ The bits common to TcInstDcls and TcDeriv.
 \begin{code}
 module TcInstUtil (
 	InstInfo(..), pprInstInfo,
-	simpleInstInfoTy, simpleInstInfoTyCon, 
+	simpleInstInfoTy, simpleInstInfoTyCon, simpleDFunClassTyCon,
 
 	-- Instance environment
 	InstEnv, emptyInstEnv, extendInstEnv,