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

[ghc-hetmet.git] / ghc / compiler / typecheck / TcModule.lhs

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index e21730a..f4a3934 100644 (file)
--- 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) ->