X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcModule.lhs;h=f4a3934faebe4d0d2e86cc0b527d226ea52f9468;hb=77a8c0dbd5c5ad90fe483cb9ddc2b6ef36d3f4d8;hp=e21730a3beaee91ef9ccaafa57f492e87da83265;hpb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index e21730a..f4a3934 100644
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -27,23 +27,19 @@ import TcClassDcl	( tcClassDecls2, mkImplicitClassBinds )
 import TcDefaults	( tcDefaults )
 import TcEnv		( tcExtendGlobalValEnv, tcExtendTypeEnv,
 			  getEnvTyCons, getEnvClasses, tcLookupValueByKeyMaybe,
-			  explicitLookupValueByKey, tcSetValueEnv,
+			  tcSetValueEnv, tcSetInstEnv,
 			  initEnv, 
-			  ValueEnv, TcTyThing(..)
+			  ValueEnv, 
 			)
-import TcExpr		( tcId )
 import TcRules		( tcRules )
 import TcForeign	( tcForeignImports, tcForeignExports )
 import TcIfaceSig	( tcInterfaceSigs )
 import TcInstDcls	( tcInstDecls1, tcInstDecls2 )
-import TcInstUtil	( buildInstanceEnvs, classDataCon, InstInfo )
+import TcInstUtil	( buildInstanceEnv, InstInfo )
 import TcSimplify	( tcSimplifyTop )
 import TcTyClsDecls	( tcTyAndClassDecls )
 import TcTyDecls	( mkImplicitDataBinds )
-import TcType		( TcType, typeToTcType,
-			  TcKind, kindToTcKind,
-			  newTyVarTy
-			)
+import TcType		( TcType, TcKind )
 
 import RnMonad		( RnNameSupply, FixityEnv )
 import Bag		( isEmptyBag )
@@ -56,19 +52,13 @@ import Name		( Name, nameUnique, nameOccName, isLocallyDefined,
 			)
 import TyCon		( TyCon, tyConKind )
 import Class		( Class, classSelIds, classTyCon )
-import Type		( mkTyConApp, mkForAllTy,
-			  boxedTypeKind, getTyVar, Type )
-import TysWiredIn	( unitTy )
 import PrelInfo		( mAIN_Name )
-import TcUnify		( unifyTauTy )
 import Unique		( Unique, mainKey )
 import UniqSupply       ( UniqSupply )
 import Maybes		( maybeToBool )
 import Util
 import Bag		( Bag, isEmptyBag )
 import Outputable
-
-import IOExts
 \end{code}
 
 Outside-world interface:
@@ -154,26 +144,19 @@ tcModule rn_name_supply fixities
 	-- unf_env is also used to get the pragam info
 	-- for imported dfuns and default methods
 
-    	    -- The knot for instance information.  This isn't used at all
-	    -- till we type-check value declarations
-    	fixTc ( \ ~(rec_inst_mapper, _, _, _) ->
-    
 		 -- Type-check the type and class decls
-		tcTyAndClassDecls unf_env rec_inst_mapper decls	`thenTc` \ env ->
+	tcTyAndClassDecls unf_env decls	`thenTc` \ env ->
     
 		    -- Typecheck the instance decls, includes deriving
-		tcSetEnv env (
-		tcInstDecls1 unf_env decls mod_name fixities rn_name_supply
-		)				`thenTc` \ (inst_info, deriv_binds) ->
-    
-    		buildInstanceEnvs inst_info	`thenNF_Tc` \ inst_mapper ->
-    
-		returnTc (inst_mapper, env, inst_info, deriv_binds)
-    
-    	-- End of inner fix loop
-    	) `thenTc` \ (_, env, inst_info, deriv_binds) ->
+	tcSetEnv env $
+
+	tcInstDecls1 unf_env decls 
+		     mod_name fixities 
+		     rn_name_supply	`thenTc` \ (inst_info, deriv_binds) ->
     
-    	tcSetEnv env 		(
+    	buildInstanceEnv inst_info	`thenNF_Tc` \ inst_env ->
+
+	tcSetInstEnv inst_env $
     	let
     	    tycons       = getEnvTyCons env
     	    classes      = getEnvClasses env
@@ -185,14 +168,6 @@ tcModule rn_name_supply fixities
     	tcDefaults decls		`thenTc` \ defaulting_tys ->
     	tcSetDefaultTys defaulting_tys 	$
     	
-	-- Extend the TyCon envt with the tycons corresponding to
-	-- the classes.
-	--  They are mentioned in types in interface files.
-        tcExtendTypeEnv [ (getName tycon, (kindToTcKind (tyConKind tycon), ADataTyCon tycon))
-		        | clas <- classes,
-			  let tycon = classTyCon clas
-		        ]				$
-
 	-- Interface type signatures
 	-- We tie a knot so that the Ids read out of interfaces are in scope
 	--   when we read their pragmas.
@@ -296,7 +271,6 @@ tcModule rn_name_supply fixities
 				tc_rules   = rules',
 				tc_env     = really_final_env
 		 }))
-	)
 
     -- End of outer fix loop
     ) `thenTc` \ (final_env, stuff) ->