Comments only: replace ":=:" by "~" (notation for equality predicates)

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

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 4a2a289..2400838 100644 (file)
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -31,6 +31,7 @@ import Generics
 import Class
 import TyCon
 import DataCon
+import Id
 import Var
 import VarSet
 import Name
@@ -243,10 +244,9 @@ lot of kinding and type checking code with ordinary algebraic data types (and
 GADTs).
 
 \begin{code}
-tcFamInstDecl :: LTyClDecl Name -> TcM (Maybe TyThing)   -- Nothing if error
+tcFamInstDecl :: LTyClDecl Name -> TcM TyThing
 tcFamInstDecl (L loc decl)
   =    -- Prime error recovery, set source location
-    recoverM (return Nothing)                  $
     setSrcSpan loc                             $
     tcAddDeclCtxt decl                         $
     do { -- type families require -XTypeFamilies and can't be in an
@@ -260,8 +260,7 @@ tcFamInstDecl (L loc decl)
        ; tc <- tcFamInstDecl1 decl
        ; checkValidTyCon tc    -- Remember to check validity;
                                -- no recursion to worry about here
-       ; return (Just (ATyCon tc))
-       }
+       ; return (ATyCon tc) }
 
 tcFamInstDecl1 :: TyClDecl Name -> TcM TyCon
 
@@ -292,7 +291,7 @@ tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name})
          -- (4) construct representation tycon
        ; rep_tc_name <- newFamInstTyConName tc_name loc
        ; buildSynTyCon rep_tc_name t_tvs (SynonymTyCon t_rhs) 
-                       (Just (family, t_typats))
+                       (typeKind t_rhs) (Just (family, t_typats))
        }}
 
   -- "newtype instance" and "data instance"
@@ -658,7 +657,8 @@ tcSynDecl
   = tcTyVarBndrs tvs           $ \ tvs' -> do 
     { traceTc (text "tcd1" <+> ppr tc_name) 
     ; rhs_ty' <- tcHsKindedType rhs_ty
-    ; tycon <- buildSynTyCon tc_name tvs' (SynonymTyCon rhs_ty') Nothing
+    ; tycon <- buildSynTyCon tc_name tvs' (SynonymTyCon rhs_ty') 
+                            (typeKind rhs_ty') Nothing
     ; return (ATyCon tycon) 
     }
 tcSynDecl d = pprPanic "tcSynDecl" (ppr d)
@@ -684,7 +684,7 @@ tcTyClDecl1 _calc_isrec
        -- Check that we don't use families without -XTypeFamilies
   ; checkTc idx_tys $ badFamInstDecl tc_name
 
-  ; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) Nothing
+  ; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) kind Nothing
   ; return [ATyCon tycon]
   }
 
@@ -878,7 +878,7 @@ tcResultType _ tc_tvs dc_tvs (ResTyGADT res_ty)
        -- E.g.  data T a b c where
        --         MkT :: forall x y z. T (x,y) z z
        -- Then we generate
-       --      ([a,z,c], [x,y], [a:=:(x,y), c:=:z], T)
+       --      ([a,z,c], [x,y], [a~(x,y), c~z], T)
 
   = do { (dc_tycon, res_tys) <- tcLHsConResTy res_ty
 
@@ -1074,10 +1074,10 @@ checkValidDataCon tc con
   = setSrcSpan (srcLocSpan (getSrcLoc con))    $
     addErrCtxt (dataConCtxt con)               $ 
     do { checkTc (dataConTyCon con == tc) (badDataConTyCon con)
-       ; checkValidType ctxt (dataConUserType con)
        ; checkValidMonoType (dataConOrigResTy con)
                -- Disallow MkT :: T (forall a. a->a)
                -- Reason: it's really the argument of an equality constraint
+       ; checkValidType ctxt (dataConUserType con)
        ; when (isNewTyCon tc) (checkNewDataCon con)
     }
   where