[project @ 2000-08-30 03:01:48 by kglynn]

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

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index d10c84b..34a82d1 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -27,9 +27,9 @@ import TcClassDcl     ( tcClassDecls2, mkImplicitClassBinds )
 import TcDefaults      ( tcDefaults )
 import TcEnv           ( tcExtendGlobalValEnv, tcExtendTypeEnv,
                          getEnvTyCons, getEnvClasses, tcLookupValueByKeyMaybe,
-                         explicitLookupValueByKey, tcSetValueEnv, tcSetInstEnv,
+                         tcSetValueEnv, tcSetInstEnv,
                          initEnv, 
-                         ValueEnv, TcTyThing(..)
+                         ValueEnv, 
                        )
 import TcRules         ( tcRules )
 import TcForeign       ( tcForeignImports, tcForeignExports )
@@ -39,21 +39,18 @@ 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 )
 import ErrUtils                ( Message, printErrorsAndWarnings, dumpIfSet )
 import Id              ( Id, idType, idName )
-import Module           ( pprModuleName )
+import Module           ( pprModuleName, mkThisModule )
 import OccName         ( isSysOcc )
 import Name            ( Name, nameUnique, nameOccName, isLocallyDefined, 
                          toRdrName, nameEnvElts, NamedThing(..)
                        )
-import TyCon           ( TyCon, tyConKind )
+import TyCon           ( TyCon, tyConKind, tyConClass_maybe )
 import Class           ( Class, classSelIds, classTyCon )
 import PrelInfo                ( mAIN_Name )
 import Unique          ( Unique, mainKey )
@@ -150,35 +147,32 @@ tcModule rn_name_supply fixities
                 -- Type-check the type and class decls
        tcTyAndClassDecls unf_env decls `thenTc` \ env ->
     
-                   -- Typecheck the instance decls, includes deriving
+                -- Typecheck the instance decls, includes deriving
        tcSetEnv env $
 
        tcInstDecls1 unf_env decls 
-                    mod_name fixities 
-                    rn_name_supply     `thenTc` \ (inst_info, deriv_binds) ->
+                    (mkThisModule mod_name)
+                    fixities rn_name_supply    `thenTc` \ (inst_info, deriv_binds) ->
     
        buildInstanceEnv inst_info      `thenNF_Tc` \ inst_env ->
 
        tcSetInstEnv inst_env $
        let
-           tycons       = getEnvTyCons env
            classes      = getEnvClasses env
-           local_tycons  = filter isLocallyDefined tycons
+           tycons       = getEnvTyCons env     -- INCLUDES tycons derived from classes
            local_classes = filter isLocallyDefined classes
+           local_tycons  = [ tc | tc <- tycons,
+                                  isLocallyDefined tc,
+                                  Nothing <- [tyConClass_maybe tc]
+                           ]
+                               -- For local_tycons, filter out the ones derived from classes
+                               -- Otherwise the latter show up in interface files
        in
        
            -- Default declarations
        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.