Type checking for type synonym families

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

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 90268e4..7186b3c 100644 (file)
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -53,7 +53,6 @@ module TcMType (
   zonkTcKindToKind, zonkTcKind, zonkTopTyVar,
 
   readKindVar, writeKindVar
-
   ) where
 
 #include "HsVersions.h"
@@ -199,7 +198,7 @@ newMetaTyVar :: BoxInfo -> Kind -> TcM TcTyVar
 -- Make a new meta tyvar out of thin air
 newMetaTyVar box_info kind
   = do { uniq <- newUnique
-       ; ref <- newMutVar Flexi ;
+       ; ref <- newMutVar Flexi
        ; let name = mkSysTvName uniq fs 
              fs = case box_info of
                        BoxTv   -> FSLIT("t")
@@ -216,7 +215,7 @@ instMetaTyVar :: BoxInfo -> TyVar -> TcM TcTyVar
 -- come from an existing TyVar
 instMetaTyVar box_info tyvar
   = do { uniq <- newUnique
-       ; ref <- newMutVar Flexi ;
+       ; ref <- newMutVar Flexi
        ; let name = setNameUnique (tyVarName tyvar) uniq
              kind = tyVarKind tyvar
        ; return (mkTcTyVar name kind (MetaTv box_info ref)) }
@@ -236,7 +235,8 @@ writeMetaTyVar tyvar ty
 
   | otherwise
   = ASSERT( isMetaTyVar tyvar )
-    ASSERT2( k2 `isSubKind` k1, (ppr tyvar <+> ppr k1) $$ (ppr ty <+> ppr k2) )
+    -- TOM: It should also work for coercions
+    -- ASSERT2( k2 `isSubKind` k1, (ppr tyvar <+> ppr k1) $$ (ppr ty <+> ppr k2) )
     do { ASSERTM2( do { details <- readMetaTyVar tyvar; return (isFlexi details) }, ppr tyvar )
        ; writeMutVar (metaTvRef tyvar) (Indirect ty) }
   where
@@ -331,7 +331,7 @@ readFilledBox :: BoxyTyVar -> TcM TcType
 readFilledBox box_tv = ASSERT( isBoxyTyVar box_tv )
                       do { cts <- readMetaTyVar box_tv
                          ; case cts of
-                               Flexi       -> pprPanic "readFilledBox" (ppr box_tv)
+                               Flexi -> pprPanic "readFilledBox" (ppr box_tv)
                                Indirect ty -> return ty }
 
 tcInstBoxyTyVar :: TyVar -> TcM BoxyTyVar
@@ -365,7 +365,7 @@ lookupTcTyVar tyvar
       MetaTv _ ref -> do { meta_details <- readMutVar ref
                         ; case meta_details of
                            Indirect ty -> return (IndirectTv ty)
-                           Flexi       -> return (DoneTv details) }
+                           Flexi -> return (DoneTv details) }
   where
     details =  tcTyVarDetails tyvar
 
@@ -694,8 +694,7 @@ checkValidType :: UserTypeCtxt -> Type -> TcM ()
 -- Checks that the type is valid for the given context
 checkValidType ctxt ty
   = traceTc (text "checkValidType" <+> ppr ty) `thenM_`
-    doptM Opt_ExpressionSignaturesUnboxedTuples `thenM` \ exp_sigs_unboxed ->
-    doptM Opt_TypeSynonymUnboxedTuples `thenM` \ type_synonym_unboxed ->
+    doptM Opt_UnboxedTuples `thenM` \ unboxed ->
     doptM Opt_Rank2Types       `thenM` \ rank2 ->
     doptM Opt_RankNTypes       `thenM` \ rankn ->
     doptM Opt_PolymorphicComponents    `thenM` \ polycomp ->
@@ -731,9 +730,9 @@ checkValidType ctxt ty
                        other        -> isSubArgTypeKind    actual_kind
        
        ubx_tup = case ctxt of
-                     TySynCtxt _ | type_synonym_unboxed -> UT_Ok
-                     ExprSigCtxt | exp_sigs_unboxed     -> UT_Ok
-                     _                                  -> UT_NotOk
+                     TySynCtxt _ | unboxed -> UT_Ok
+                     ExprSigCtxt | unboxed -> UT_Ok
+                     _                     -> UT_NotOk
     in
        -- Check that the thing has kind Type, and is lifted if necessary
     checkTc kind_ok (kindErr actual_kind)      `thenM_`
@@ -981,7 +980,7 @@ check_class_pred_tys dflags ctxt tys
        other         -> flexible_contexts || all tyvar_head tys
   where
     flexible_contexts = dopt Opt_FlexibleContexts dflags
-    undecidable_ok = dopt Opt_AllowUndecidableInstances dflags
+    undecidable_ok = dopt Opt_UndecidableInstances dflags
 
 -------------------------
 tyvar_head ty                  -- Haskell 98 allows predicates of form 
@@ -1176,7 +1175,7 @@ instTypeErr pp_ty msg
 \begin{code}
 checkValidInstance :: [TyVar] -> ThetaType -> Class -> [TcType] -> TcM ()
 checkValidInstance tyvars theta clas inst_tys
-  = do { undecidable_ok <- doptM Opt_AllowUndecidableInstances
+  = do { undecidable_ok <- doptM Opt_UndecidableInstances
 
        ; checkValidTheta InstThetaCtxt theta
        ; checkAmbiguity tyvars theta (tyVarsOfTypes inst_tys)