[project @ 2000-11-07 13:12:21 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 0392d34..76b91d5 100644 (file)
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -24,8 +24,8 @@ import TcMonoType     ( tcHsType, tcHsSigType, tcHsBoxedSigType, tcHsTyVars, tcClass
                          kcHsContext, kcHsSigType
                        )
 import TcEnv           ( tcExtendTyVarEnv, 
-                         tcLookupTyCon, tcLookupClass, tcLookupGlobalId, 
-                         TyThing(..), TyThingDetails(..)
+                         tcLookupTyCon, tcLookupGlobalId, 
+                         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
@@ -87,13 +88,9 @@ tcTyDecl1 (TyData new_or_data context tycon_name _ con_decls _ derivings src_loc
 
        -- 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