[project @ 2000-10-24 08:40:09 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 a26f066..a47d783 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -33,7 +33,7 @@ import TcRules                ( tcRules )
 import TcForeign       ( tcForeignImports, tcForeignExports )
 import TcIfaceSig      ( tcInterfaceSigs )
 import TcInstDcls      ( tcInstDecls1, tcInstDecls2 )
-import TcInstUtil      ( InstInfo(..) )
+import InstEnv         ( InstInfo(..) )
 import TcSimplify      ( tcSimplifyTop )
 import TcTyClsDecls    ( tcTyAndClassDecls )
 import TcTyDecls       ( mkImplicitDataBinds )
@@ -43,9 +43,9 @@ import Type           ( funResultTy, splitForAllTys )
 import Bag             ( isEmptyBag )
 import ErrUtils                ( printErrorsAndWarnings, dumpIfSet_dyn )
 import Id              ( idType, idName, idUnfolding )
-import Module           ( Module, moduleName, {-mkThisModule,-} plusModuleEnv )
-import Name            ( nameOccName, isLocallyDefined, isGlobalName,
-                         toRdrName, nameEnvElts, emptyNameEnv
+import Module           ( Module, moduleName, plusModuleEnv )
+import Name            ( Name, nameOccName, isLocallyDefined, isGlobalName,
+                         toRdrName, nameEnvElts, emptyNameEnv, lookupNameEnv
                        )
 import TyCon           ( TyCon, isDataTyCon, tyConName, tyConGenInfo )
 import OccName         ( isSysOcc )
@@ -53,14 +53,14 @@ import TyCon                ( TyCon, isClassTyCon )
 import Class           ( Class )
 import PrelNames       ( mAIN_Name, mainName )
 import UniqSupply       ( UniqSupply )
-import Maybes          ( maybeToBool )
+import Maybes          ( maybeToBool, thenMaybe )
 import Util
-import BasicTypes       ( EP(..) )
+import BasicTypes       ( EP(..), Fixity )
 import Bag             ( Bag, isEmptyBag )
 import Outputable
-import HscTypes                ( PersistentCompilerState(..), HomeSymbolTable, 
-                         PackageSymbolTable, DFunId, 
-                         TypeEnv, extendTypeEnv,
+import HscTypes                ( PersistentCompilerState(..), HomeSymbolTable, HomeIfaceTable,
+                         PackageSymbolTable, PackageIfaceTable, DFunId, ModIface(..),
+                         TypeEnv, extendTypeEnv, lookupTable,
                          TyThing(..), groupTyThings )
 import FiniteMap       ( FiniteMap, delFromFM, lookupWithDefaultFM )
 \end{code}
@@ -83,12 +83,15 @@ data TcResults
 ---------------
 typecheckModule
        :: DynFlags
+       -> Module
        -> PersistentCompilerState
        -> HomeSymbolTable
+       -> HomeIfaceTable
+       -> PackageIfaceTable
        -> RenamedHsModule
        -> IO (Maybe (TcEnv, TcResults))
 
-typecheckModule dflags pcs hst (HsModule mod_name _ _ _ decls _ src_loc)
+typecheckModule dflags this_mod pcs hst hit pit (HsModule mod_name _ _ _ decls _ src_loc)
   = do env <- initTcEnv global_symbol_table
        (maybe_result, (errs,warns)) <- initTc dflags env src_loc tc_module
        printErrorsAndWarnings (errs,warns)
@@ -98,16 +101,21 @@ typecheckModule dflags pcs hst (HsModule mod_name _ _ _ decls _ src_loc)
          else 
           return maybe_result
   where
-    this_mod           = panic "mkThisModule: unimp"  -- WAS: mkThisModule
     global_symbol_table = pcs_PST pcs `plusModuleEnv` hst
 
-    tc_module = fixTc (\ ~(unf_env ,_) -> tcModule pcs hst this_mod decls unf_env)
+    tc_module = fixTc (\ ~(unf_env ,_) 
+                        -> tcModule pcs hst get_fixity this_mod decls unf_env)
+
+    get_fixity :: Name -> Maybe Fixity
+    get_fixity nm = lookupTable hit pit nm     `thenMaybe` \ iface ->
+                   lookupNameEnv (mi_fixities iface) nm
 \end{code}
 
 The internal monster:
 \begin{code}
 tcModule :: PersistentCompilerState
         -> HomeSymbolTable
+        -> (Name -> Maybe Fixity)
         -> Module
         -> [RenamedHsDecl]
         -> TcEnv               -- The knot-tied environment
@@ -120,7 +128,7 @@ tcModule :: PersistentCompilerState
   -- unf_env is also used to get the pragama info
   -- for imported dfuns and default methods
 
-tcModule pcs hst this_mod decls unf_env
+tcModule pcs hst get_fixity this_mod decls unf_env
   =             -- Type-check the type and class decls
     tcTyAndClassDecls unf_env decls            `thenTc` \ env ->
     tcSetEnv env                               $
@@ -137,7 +145,7 @@ tcModule pcs hst this_mod decls unf_env
     in
     
        -- Typecheck the instance decls, includes deriving
-    tcInstDecls1 pcs hst unf_env this_mod 
+    tcInstDecls1 pcs hst unf_env get_fixity this_mod 
                 local_tycons decls             `thenTc` \ (pcs_with_insts, inst_env, inst_info, deriv_binds) ->
     tcSetInstEnv inst_env                      $