[project @ 2000-11-06 08:15:20 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index b5973f7..24896ab 100644 (file)
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -25,7 +25,7 @@ import TcMonoType     ( tcHsType, tcHsSigType, tcHsBoxedSigType, tcHsTyVars, tcClass
                        )
 import TcEnv           ( tcExtendTyVarEnv, 
                          tcLookupTyCon, tcLookupClass, tcLookupGlobalId, 
-                         TyThing(..), TyThingDetails(..)
+                         TyThingDetails(..)
                        )
 import TcMonad
 
@@ -37,7 +37,8 @@ import DataCon                ( DataCon, mkDataCon,
 import MkId            ( mkDataConId, mkDataConWrapId, mkRecordSelId )
 import FieldLabel
 import Var             ( Id, TyVar )
-import Name            ( Name, isLocallyDefined, NamedThing(..) )
+import Module          ( Module )
+import Name            ( Name, NamedThing(..), isFrom )
 import Outputable
 import TyCon           ( TyCon, isSynTyCon, isNewTyCon,
                          tyConDataConsIfAvailable, tyConTyVars, tyConGenIds
@@ -78,7 +79,7 @@ tcTyDecl1 (TySynonym tycon_name tyvar_names rhs src_loc)
 
     returnTc (tycon_name, SynTyDetails rhs_ty)
 
-tcTyDecl1 (TyData new_or_data context tycon_name _ con_decls _ derivings _ src_loc name1 name2)
+tcTyDecl1 (TyData new_or_data context tycon_name _ con_decls _ derivings src_loc name1 name2)
   = tcLookupTyCon tycon_name                   `thenNF_Tc` \ tycon ->
     let
        tyvars = tyConTyVars tycon
@@ -87,13 +88,9 @@ tcTyDecl1 (TyData new_or_data context tycon_name _ con_decls _ derivings _ src_l
 
        -- Typecheck the pieces
     tcClassContext context                                     `thenTc` \ ctxt ->
-    tc_derivs derivings                                                `thenTc` \ derived_classes ->
     mapTc (tcConDecl new_or_data tycon tyvars ctxt) con_decls  `thenTc` \ data_cons ->
 
-    returnTc (tycon_name, DataTyDetails ctxt data_cons derived_classes)
-  where
-    tc_derivs Nothing   = returnTc []
-    tc_derivs (Just ds) = mapTc tcLookupClass ds
+    returnTc (tycon_name, DataTyDetails ctxt data_cons)
 \end{code}
 
 \begin{code}
@@ -216,15 +213,15 @@ getBangStrictness (Unpacked _) = markedUnboxed
 %************************************************************************
 
 \begin{code}
-mkImplicitDataBinds :: [TyCon] -> TcM ([Id], TcMonoBinds)
-mkImplicitDataBinds [] = returnTc ([], EmptyMonoBinds)
-mkImplicitDataBinds (tycon : tycons) 
-  | isSynTyCon tycon = mkImplicitDataBinds tycons
-  | otherwise       = mkImplicitDataBinds_one tycon    `thenTc` \ (ids1, b1) ->
-                      mkImplicitDataBinds tycons       `thenTc` \ (ids2, b2) ->
+mkImplicitDataBinds :: Module -> [TyCon] -> TcM ([Id], TcMonoBinds)
+mkImplicitDataBinds this_mod [] = returnTc ([], EmptyMonoBinds)
+mkImplicitDataBinds this_mod (tycon : tycons) 
+  | isSynTyCon tycon = mkImplicitDataBinds this_mod tycons
+  | otherwise       = mkImplicitDataBinds_one this_mod tycon   `thenTc` \ (ids1, b1) ->
+                      mkImplicitDataBinds this_mod tycons      `thenTc` \ (ids2, b2) ->
                       returnTc (ids1++ids2, b1 `AndMonoBinds` b2)
 
-mkImplicitDataBinds_one tycon
+mkImplicitDataBinds_one this_mod tycon
   = mapTc (mkRecordSelector tycon) groups      `thenTc` \ sel_ids ->
     let
        unf_ids = sel_ids ++ data_con_wrapper_ids ++ gen_ids
@@ -233,8 +230,8 @@ mkImplicitDataBinds_one tycon
        -- For the locally-defined things
        -- we need to turn the unfoldings inside the selector Ids into bindings,
        -- and build bindigns for the constructor wrappers
-       binds | isLocallyDefined tycon = idsToMonoBinds unf_ids
-             | otherwise              = EmptyMonoBinds
+       binds | isFrom this_mod tycon = idsToMonoBinds unf_ids
+             | otherwise             = EmptyMonoBinds
     in 
     returnTc (all_ids, binds)
   where