[project @ 2002-04-02 13:56:32 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index 6655ad0..6108d15 100644 (file)
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -14,11 +14,11 @@ import HsSyn                ( HsBinds(..), MonoBinds(..), TyClDecl(..),
                          collectLocatedMonoBinders )
 import RdrHsSyn                ( RdrNameMonoBinds )
 import RnHsSyn         ( RenamedHsBinds, RenamedMonoBinds, RenamedTyClDecl, RenamedHsPred )
-import CmdLineOpts     ( DynFlag(..), DynFlags )
+import CmdLineOpts     ( DynFlag(..) )
 
 import TcMonad
 import TcEnv           ( tcSetInstEnv, newDFunName, InstInfo(..), pprInstInfo,
-                         tcLookupClass, tcLookupTyCon, tcExtendTyVarEnv
+                         tcLookupTyCon, tcExtendTyVarEnv
                        )
 import TcGenDeriv      -- Deriv stuff
 import InstEnv         ( InstEnv, simpleDFunClassTyCon, extendInstEnv )
@@ -28,11 +28,11 @@ import TcSimplify   ( tcSimplifyDeriv )
 import RnBinds         ( rnMethodBinds, rnTopMonoBinds )
 import RnEnv           ( bindLocatedLocalsRn )
 import RnMonad         ( renameDerivedCode, thenRn, mapRn, returnRn )
-import HscTypes                ( DFunId, PersistentRenamerState )
+import HscTypes                ( DFunId, PersistentRenamerState, FixityEnv )
 
-import BasicTypes      ( Fixity, NewOrData(..) )
+import BasicTypes      ( NewOrData(..) )
 import Class           ( className, classKey, classTyVars, Class )
-import ErrUtils                ( dumpIfSet_dyn, Message )
+import ErrUtils                ( dumpIfSet_dyn )
 import MkId            ( mkDictFunId )
 import DataCon         ( dataConRepArgTys, isNullaryDataCon, isExistentialDataCon )
 import PrelInfo                ( needsDataDeclCtxtClassKeys )
@@ -47,15 +47,14 @@ import TyCon                ( tyConTyVars, tyConDataCons, tyConArity, newTyConRep,
                        )
 import TcType          ( TcType, ThetaType, mkTyVarTys, mkTyConApp, getClassPredTys_maybe,
                          isUnLiftedType, mkClassPred, tyVarsOfTypes, tcSplitFunTys, 
-                         tcSplitTyConApp_maybe, tcEqTypes, tyVarsOfTheta )
+                         tcSplitTyConApp_maybe, tcEqTypes )
 import Var             ( TyVar, tyVarKind )
 import VarSet          ( mkVarSet, subVarSet )
 import PrelNames
-import Util            ( zipWithEqual, sortLt, eqListBy )
+import Util            ( zipWithEqual, sortLt )
 import ListSetOps      ( removeDups,  assoc )
 import Outputable
 import Maybe           ( isJust )
-import List            ( nub )
 import FastString      ( FastString )
 \end{code}
 
@@ -179,6 +178,12 @@ context to the instance decl.  The "offending classes" are
 
        Read, Enum?
 
+FURTHER NOTE ADDED March 2002.  In fact, Haskell98 now requires that
+pattern matching against a constructor from a data type with a context
+gives rise to the constraints for that context -- or at least the thinned
+version.  So now all classes are "offending".
+
+
 
 %************************************************************************
 %*                                                                     *
@@ -190,7 +195,7 @@ context to the instance decl.  The "offending classes" are
 tcDeriving  :: PersistentRenamerState
            -> Module                   -- name of module under scrutiny
            -> InstEnv                  -- What we already know about instances
-           -> (Name -> Maybe Fixity)   -- used in deriving Show and Read
+           -> FixityEnv        -- used in deriving Show and Read
            -> [RenamedTyClDecl]        -- All type constructors
            -> TcM ([InstInfo],         -- The generated "instance decls".
                    RenamedHsBinds)     -- Extra generated bindings
@@ -349,12 +354,12 @@ makeDerivEqns tycl_decls
                        not (isUnLiftedType arg_ty)     -- No constraints for unlifted types?
                      ]
 
-       
         -- "extra_constraints": see notes above about contexts on data decls
-       extra_constraints | offensive_class = tyConTheta tycon
-                         | otherwise       = []
-       
-       offensive_class = classKey clas `elem` needsDataDeclCtxtClassKeys
+       extra_constraints = tyConTheta tycon
+
+       --    | offensive_class = tyConTheta tycon
+       --    | otherwise           = []
+       -- offensive_class = classKey clas `elem` needsDataDeclCtxtClassKeys
 
 
     mk_eqn_help NewType tycon clas tys
@@ -616,7 +621,7 @@ the renamer.  What a great hack!
 -- Generate the method bindings for the required instance
 -- (paired with class name, as we need that when renaming
 --  the method binds)
-gen_bind :: (Name -> Maybe Fixity) -> DFunId -> (Name, RdrNameMonoBinds)
+gen_bind :: FixityEnv -> DFunId -> (Name, RdrNameMonoBinds)
 gen_bind get_fixity dfun
   = (cls_nm, binds)
   where