Remove the distinction between data and newtype families

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

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index dbf83fb..50e0f4c 100644 (file)
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -268,7 +268,7 @@ tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name})
        ; t_rhs    <- tcHsKindedType k_rhs
 
          -- (3) construct representation tycon
-       ; rep_tc_name <- newFamInstTyConName tc_name (srcSpanStart loc)
+       ; rep_tc_name <- newFamInstTyConName tc_name loc
        ; tycon <- buildSynTyCon rep_tc_name t_tvs (SynonymTyCon t_rhs) 
                                 (Just (family, t_typats))
 
@@ -280,8 +280,7 @@ tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
                             tcdCons = cons})
   = kcIdxTyPats decl $ \k_tvs k_typats resKind family ->
     do { -- check that the family declaration is for the right kind
-        unless (new_or_data == NewType  && isNewTyCon  family ||
-                new_or_data == DataType && isDataTyCon family) $
+        unless (isAlgTyCon family) $
           addErr (wrongKindOfFamily family)
 
        ; -- (1) kind check the data declaration as usual
@@ -307,7 +306,7 @@ tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
        ; stupid_theta <- tcHsKindedContext k_ctxt
 
          -- (3) construct representation tycon
-       ; rep_tc_name <- newFamInstTyConName tc_name (srcSpanStart loc)
+       ; rep_tc_name <- newFamInstTyConName tc_name loc
        ; tycon <- fixM (\ tycon -> do 
             { data_cons <- mappM (addLocM (tcConDecl unbox_strict tycon t_tvs))
                                  k_cons
@@ -630,10 +629,10 @@ tcTyClDecl1 _calc_isrec
 
   -- "newtype family" or "data family" declaration
 tcTyClDecl1 _calc_isrec 
-  (TyFamily {tcdFlavour = DataFamily new_or_data, 
+  (TyFamily {tcdFlavour = DataFamily, 
             tcdLName = L _ tc_name, tcdTyVars = tvs, tcdKind = mb_kind})
   = tcTyVarBndrs tvs  $ \ tvs' -> do 
-  { traceTc (text "data/newtype family: " <+> ppr tc_name) 
+  { traceTc (text "data family: " <+> ppr tc_name) 
   ; extra_tvs <- tcDataKindSig mb_kind
   ; let final_tvs = tvs' ++ extra_tvs    -- we may not need these
 
@@ -643,10 +642,7 @@ tcTyClDecl1 _calc_isrec
   ; checkTc idx_tys $ badFamInstDecl tc_name
 
   ; tycon <- buildAlgTyCon tc_name final_tvs [] 
-              (case new_or_data of
-                 DataType -> mkOpenDataTyConRhs
-                 NewType  -> mkOpenNewTyConRhs)
-              Recursive False True Nothing
+              mkOpenDataTyConRhs Recursive False True Nothing
   ; return [ATyCon tycon]
   }
 
@@ -1194,9 +1190,9 @@ wrongKindOfFamily family =
   ptext SLIT("Wrong category of family instance; declaration was for a") <+>
   kindOfFamily
   where
-    kindOfFamily | isSynTyCon  family = ptext SLIT("type synonym")
-                | isDataTyCon family = ptext SLIT("data type")
-                | isNewTyCon  family = ptext SLIT("newtype")
+    kindOfFamily | isSynTyCon family = ptext SLIT("type synonym")
+                | isAlgTyCon family = ptext SLIT("data type")
+                | otherwise = pprPanic "wrongKindOfFamily" (ppr family)
 
 emptyConDeclsErr tycon
   = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),