[project @ 2001-07-10 11:32:28 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 afbd15e..9ab5661 100644 (file)
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -4,9 +4,7 @@
 \section[TcTyDecls]{Typecheck type declarations}
 
 \begin{code}
-module TcTyDecls (
-       tcTyDecl1, kcConDetails, mkNewTyConRep
-    ) where
+module TcTyDecls ( tcTyDecl1, kcConDetails ) where
 
 #include "HsVersions.h"
 
@@ -23,20 +21,16 @@ import TcEnv                ( tcExtendTyVarEnv,
                          tcLookupTyCon, tcLookupRecId, 
                          TyThingDetails(..), RecTcEnv
                        )
+import TcType          ( tcEqType, tyVarsOfTypes, tyVarsOfPred, Type, ThetaType )
 import TcMonad
 
-import DataCon         ( DataCon, mkDataCon, dataConFieldLabels, dataConRepType )
+import DataCon         ( DataCon, mkDataCon, dataConFieldLabels )
 import MkId            ( mkDataConId, mkDataConWrapId, mkRecordSelId )
 import FieldLabel
 import Var             ( TyVar )
 import Name            ( Name, NamedThing(..) )
 import Outputable
-import TyCon           ( TyCon, isNewTyCon, tyConTyVars )
-import Type            ( tyVarsOfTypes, tyVarsOfPred, splitFunTy, applyTys,
-                         mkTyConApp, mkTyVarTys, mkForAllTys, 
-                         splitAlgTyConApp_maybe, Type, ThetaType
-                       )
-import TysWiredIn      ( unitTy )
+import TyCon           ( TyCon, tyConTyVars )
 import VarSet          ( intersectVarSet, isEmptyVarSet )
 import PrelNames       ( unpackCStringName, unpackCStringUtf8Name )
 import ListSetOps      ( equivClasses )
@@ -81,27 +75,9 @@ tcTyDecl1 is_rec unf_env (TyData {tcdND = new_or_data, tcdCtxt = context,
     mapTc (tcConDecl is_rec new_or_data tycon tyvars ctxt) con_decls   `thenTc` \ data_cons ->
     tcRecordSelectors is_rec unf_env tycon data_cons                   `thenTc` \ sel_ids -> 
     returnTc (tycon_name, DataTyDetails ctxt data_cons sel_ids)
-\end{code}
 
-\begin{code}
-mkNewTyConRep :: TyCon -> Type
--- Find the representation type for this newtype TyCon
--- The trick is to to deal correctly with recursive newtypes
--- such as     newtype T = MkT T
-
-mkNewTyConRep tc
-  = mkForAllTys tvs (loop [] (mkTyConApp tc (mkTyVarTys tvs)))
-  where
-    tvs = tyConTyVars tc
-    loop tcs ty = case splitAlgTyConApp_maybe ty of {
-                       Nothing -> ty ;
-                       Just (tc, tys, data_cons) | not (isNewTyCon tc) -> ty
-                                                 | tc `elem` tcs       -> unitTy
-                                                 | otherwise           ->
-
-                 case splitFunTy (applyTys (dataConRepType (head data_cons)) tys) of
-                       (rep_ty, _) -> loop (tc:tcs) rep_ty
-                 }
+tcTyDecl1 is_rec unf_env (ForeignType {tcdName = tycon_name})
+  = returnTc (tycon_name, ForeignTyDetails)
 \end{code}
 
 
@@ -215,7 +191,7 @@ tcRecordSelectors is_rec unf_env tycon data_cons
        =       -- Check that all the fields in the group have the same type
                -- NB: this check assumes that all the constructors of a given
                -- data type use the same type variables
-         checkTc (all (== field_ty) other_tys) (fieldTypeMisMatch field_name)
+         checkTc (all (tcEqType field_ty) other_tys) (fieldTypeMisMatch field_name)
        where
            field_ty   = fieldLabelType first_field_label
            field_name = fieldLabelName first_field_label