[project @ 2000-10-24 17:09:44 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index 571ebf7..b2298bf 100644 (file)
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -11,11 +11,10 @@ module TcInstDcls ( tcInstDecls1, tcInstDecls2, tcAddDeclCtxt ) where
 
 import CmdLineOpts     ( DynFlag(..), dopt )
 
-import HsSyn           ( HsDecl(..), InstDecl(..), TyClDecl(..), InPat(..),
-                         MonoBinds(..), HsExpr(..),  HsLit(..), Sig(..), Match(..),
+import HsSyn           ( HsDecl(..), InstDecl(..), TyClDecl(..), 
+                         MonoBinds(..), HsExpr(..),  HsLit(..), Sig(..), 
                          andMonoBindList, collectMonoBinders, isClassDecl
                        )
-import HsTypes          ( HsType (..), HsTyVarBndr(..), toHsTyVar )
 import RnHsSyn         ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl, RenamedMonoBinds,
                          RenamedTyClDecl, RenamedHsType, 
                          extractHsTyVars, maybeGenericMatch
@@ -29,25 +28,24 @@ import Inst         ( InstOrigin(..),
                          LIE, emptyLIE, plusLIE, plusLIEs )
 import TcDeriv         ( tcDeriving )
 import TcEnv           ( TcEnv, tcExtendGlobalValEnv, 
-                         tcExtendTyVarEnvForMeths, TyThing (..),
+                         tcExtendTyVarEnvForMeths, 
                          tcAddImportedIdInfo, tcInstId, tcLookupClass,
                          newDFunName, tcExtendTyVarEnv
                        )
 import InstEnv         ( InstInfo(..), InstEnv, pprInstInfo, classDataCon, 
                          simpleInstInfoTyCon, simpleInstInfoTy, isLocalInst,
                          extendInstEnv )
-import TcMonoType      ( tcTyVars, tcHsSigType, tcHsType, kcHsSigType )
+import TcMonoType      ( tcTyVars, tcHsSigType, kcHsSigType )
 import TcSimplify      ( tcSimplifyAndCheck )
 import TcType          ( zonkTcSigTyVars )
 import HscTypes                ( PersistentCompilerState(..), HomeSymbolTable, DFunId,
-                         ModDetails(..) )
-
-import Bag             ( emptyBag, unitBag, unionBags, unionManyBags,
-                         foldBag, Bag, listToBag
+                         ModDetails(..), PackageInstEnv, PersistentRenamerState
                        )
+
+import Bag             ( unionManyBags )
 import Class           ( Class, DefMeth(..), classBigSig )
 import Var             ( idName, idType )
-import Maybes          ( maybeToBool, expectJust )
+import Maybes          ( maybeToBool )
 import MkId            ( mkDictFunId )
 import Generics                ( validGenericInstanceType )
 import Module          ( Module, foldModuleEnv )
@@ -58,7 +56,7 @@ import PprType                ( pprConstraint, pprPred )
 import TyCon           ( TyCon, isSynTyCon, tyConDerivings )
 import Type            ( mkTyVarTys, splitDFunTy, isTyVarTy,
                          splitTyConApp_maybe, splitDictTy,
-                         splitAlgTyConApp_maybe, classesToPreds, classesOfPreds,
+                         splitAlgTyConApp_maybe, 
                          unUsgTy, tyVarsOfTypes, mkClassPred, mkTyVarTy,
                          getClassTys_maybe
                        )
@@ -66,12 +64,9 @@ import Subst         ( mkTopTyVarSubst, substClasses, substTheta )
 import VarSet          ( mkVarSet, varSetElems )
 import TysWiredIn      ( genericTyCons, isFFIArgumentTy, isFFIResultTy )
 import PrelNames       ( cCallableClassKey, cReturnableClassKey, hasKey )
-import Name             ( Name, NameEnv, extendNameEnv_C, emptyNameEnv, 
-                         plusNameEnv_C, nameEnvElts )
-import FiniteMap        ( mapFM )
+import Name             ( Name )
 import SrcLoc           ( SrcLoc )
 import VarSet           ( varSetElems )
-import UniqFM           ( mapUFM )
 import Unique          ( Uniquable(..) )
 import BasicTypes      ( NewOrData(..), Fixity )
 import ErrUtils                ( dumpIfSet_dyn )
@@ -79,7 +74,7 @@ import ListSetOps     ( Assoc, emptyAssoc, plusAssoc_C, mapAssoc,
                          assocElts, extendAssoc_C,
                          equivClassesByUniq, minusList
                        )
-import List             ( intersect, (\\), partition )
+import List             ( partition )
 import Outputable
 \end{code}
 
@@ -166,16 +161,17 @@ and $dbinds_super$ bind the superclass dictionaries sd1 \ldots sdm.
 Gather up the instance declarations from their various sources
 
 \begin{code}
-tcInstDecls1 :: PersistentCompilerState
+tcInstDecls1 :: PackageInstEnv
+            -> PersistentRenamerState  
             -> HomeSymbolTable         -- Contains instances
             -> TcEnv                   -- Contains IdInfo for dfun ids
             -> (Name -> Maybe Fixity)  -- for deriving Show and Read
             -> Module                  -- Module for deriving
             -> [TyCon]
             -> [RenamedHsDecl]
-            -> TcM (PersistentCompilerState, InstEnv, [InstInfo], RenamedHsBinds)
+            -> TcM (PackageInstEnv, InstEnv, [InstInfo], RenamedHsBinds)
 
-tcInstDecls1 pcs hst unf_env get_fixity mod local_tycons decls
+tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod local_tycons decls
   = let
        inst_decls = [inst_decl | InstD inst_decl <- decls]
        clas_decls = [clas_decl | TyClD clas_decl <- decls, isClassDecl clas_decl]
@@ -201,7 +197,7 @@ tcInstDecls1 pcs hst unf_env get_fixity mod local_tycons decls
                               imported_inst_info
        hst_dfuns        = foldModuleEnv ((++) . md_insts) [] hst
     in
-    addInstDFuns (pcs_insts pcs) imported_dfuns        `thenNF_Tc` \ inst_env1 ->
+    addInstDFuns inst_env0 imported_dfuns      `thenNF_Tc` \ inst_env1 ->
     addInstDFuns inst_env1 hst_dfuns           `thenNF_Tc` \ inst_env2 ->
     addInstInfos inst_env2 local_inst_info     `thenNF_Tc` \ inst_env3 ->
     addInstInfos inst_env3 generic_inst_info   `thenNF_Tc` \ inst_env4 ->
@@ -211,12 +207,10 @@ tcInstDecls1 pcs hst unf_env get_fixity mod local_tycons decls
        --     we ignore deriving decls from interfaces!
        -- This stuff computes a context for the derived instance decl, so it
        -- needs to know about all the instances possible; hecne inst_env4
-    tcDeriving (pcs_PRS pcs) mod inst_env4 get_fixity local_tycons
-                                       `thenTc` \ (deriv_inst_info, deriv_binds) ->
-    addInstInfos inst_env4 deriv_inst_info                     
-                                       `thenNF_Tc` \ final_inst_env ->
+    tcDeriving prs mod inst_env4 get_fixity local_tycons       `thenTc` \ (deriv_inst_info, deriv_binds) ->
+    addInstInfos inst_env4 deriv_inst_info                     `thenNF_Tc` \ final_inst_env ->
 
-    returnTc (pcs { pcs_insts = inst_env1 }, 
+    returnTc (inst_env1, 
              final_inst_env, 
              generic_inst_info ++ deriv_inst_info ++ local_inst_info,
              deriv_binds)