[project @ 2005-03-09 14:26:56 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcDeriv.lhs
index a2b84ca..45bca4c 100644 (file)
@@ -20,7 +20,7 @@ import TcEnv          ( newDFunName, pprInstInfoDetails,
                          tcLookupClass, tcLookupTyCon, tcExtendTyVarEnv
                        )
 import TcGenDeriv      -- Deriv stuff
-import InstEnv         ( simpleDFunClassTyCon, extendInstEnv )
+import InstEnv         ( simpleDFunClassTyCon, extendInstEnvList )
 import TcHsType                ( tcHsDeriv )
 import TcSimplify      ( tcSimplifyDeriv )
 
@@ -29,14 +29,14 @@ import RnEnv                ( bindLocalNames )
 import HscTypes                ( DFunId, FixityEnv )
 
 import Class           ( className, classArity, classKey, classTyVars, classSCTheta, Class )
-import Type            ( zipTvSubst, substTheta )
+import Type            ( zipOpenTvSubst, substTheta )
 import ErrUtils                ( dumpIfSet_dyn )
 import MkId            ( mkDictFunId )
 import DataCon         ( isNullarySrcDataCon, isVanillaDataCon, dataConOrigArgTys )
 import Maybes          ( catMaybes )
 import RdrName         ( RdrName )
 import Name            ( Name, getSrcLoc )
-import NameSet         ( NameSet, emptyNameSet, duDefs )
+import NameSet         ( duDefs )
 import Kind            ( splitKindFunTys )
 import TyCon           ( tyConTyVars, tyConDataCons, tyConArity, tyConHasGenerics,
                          tyConStupidTheta, isProductTyCon, isDataTyCon, newTyConRhs,
@@ -219,9 +219,18 @@ tcDeriving tycl_decls
                -- Add the newtype-derived instances to the inst env
                -- before tacking the "ordinary" ones
 
+       ; let inst_info  = newtype_inst_info ++ ordinary_inst_info
+
+       -- If we are compiling a hs-boot file, 
+       -- don't generate any derived bindings
+       ; is_boot <- tcIsHsBoot
+       ; if is_boot then
+               return (inst_info, [])
+         else do
+       {
+
        -- Generate the generic to/from functions from each type declaration
        ; gen_binds <- mkGenericBinds tycl_decls
-       ; let inst_info  = newtype_inst_info ++ ordinary_inst_info
 
        -- Rename these extra bindings, discarding warnings about unused bindings etc
        -- Set -fglasgow exts so that we can have type signatures in patterns,
@@ -240,7 +249,7 @@ tcDeriving tycl_decls
                   (ddump_deriving inst_info rn_binds))
 
        ; returnM (inst_info, rn_binds)
-       }
+       }}
   where
     ddump_deriving :: [InstInfo] -> [HsBindGroup Name] -> SDoc
     ddump_deriving inst_infos extra_binds
@@ -432,7 +441,7 @@ makeDerivEqns tycl_decls
                -- There's no 'corece' needed because after the type checker newtypes
                -- are transparent.
 
-       sc_theta = substTheta (zipTvSubst clas_tyvars inst_tys)
+       sc_theta = substTheta (zipOpenTvSubst clas_tyvars inst_tys)
                              (classSCTheta clas)
 
                -- If there are no tyvars, there's no need
@@ -723,7 +732,7 @@ extendLocalInstEnv :: [DFunId] -> TcM a -> TcM a
 -- for functional dependency errors -- that'll happen in TcInstDcls
 extendLocalInstEnv dfuns thing_inside
  = do { env <- getGblEnv
-      ; let  inst_env' = foldl extendInstEnv (tcg_inst_env env) dfuns 
+      ; let  inst_env' = extendInstEnvList (tcg_inst_env env) dfuns 
             env'      = env { tcg_inst_env = inst_env' }
       ; setGblEnv env' thing_inside }
 \end{code}