X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyClsDecls.lhs;h=ae90ef8f4ed5b26be6b043454db673c733f40880;hb=25ebbb764146f4c4634720bb285c3611e95cc951;hp=34022db5ebf7b16bb9a984eceb396a6090fb347c;hpb=940524aec90652b5ef81789c9a453c57c0e42cc9;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 34022db..ae90ef8 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -133,7 +133,7 @@ tcTyAndClassDecls :: ModDetails -> [LTyClDecl Name]
    	           -> TcM TcGblEnv 	-- Input env extended by types and classes 
 					-- and their implicit Ids,DataCons
 tcTyAndClassDecls boot_details allDecls
-  = do	{       -- Omit instances of indexed types; they are handled together
+  = do	{       -- Omit instances of type families; they are handled together
 		-- with the *heads* of class instances
         ; let decls = filter (not . isFamInstDecl . unLoc) allDecls
 
@@ -239,9 +239,9 @@ tcFamInstDecl (L loc decl)
     recoverM (returnM Nothing)		        $
     setSrcSpan loc				$
     tcAddDeclCtxt decl				$
-    do { -- type families require -findexed-types and can't be in an
+    do { -- type families require -ftype-families and can't be in an
 	 -- hs-boot file
-       ; gla_exts <- doptM Opt_IndexedTypes
+       ; gla_exts <- doptM Opt_TypeFamilies
        ; is_boot  <- tcIsHsBoot	  -- Are we compiling an hs-boot file?
        ; checkTc gla_exts      $ badFamInstDecl (tcdLName decl)
        ; checkTc (not is_boot) $ badBootFamInstDeclErr
@@ -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
@@ -393,7 +392,7 @@ So we must infer their kinds from their right-hand sides *first* and then
 use them, whereas for the mutually recursive data types D we bring into
 scope kind bindings D -> k, where k is a kind variable, and do inference.
 
-Indexed Types
+Type families
 ~~~~~~~~~~~~~
 This treatment of type synonyms only applies to Haskell 98-style synonyms.
 General type functions can be recursive, and hence, appear in `alg_decls'.
@@ -619,9 +618,9 @@ tcTyClDecl1 _calc_isrec
 						      --     kind checking
   = tcTyVarBndrs tvs  $ \ tvs' -> do 
   { traceTc (text "type family: " <+> ppr tc_name) 
-  ; idx_tys <- doptM Opt_IndexedTypes
+  ; idx_tys <- doptM Opt_TypeFamilies
 
-	-- Check that we don't use families without -findexed-types
+	-- Check that we don't use families without -ftype-families
   ; checkTc idx_tys $ badFamInstDecl tc_name
 
   ; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) Nothing
@@ -630,23 +629,20 @@ 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
 
-  ; idx_tys <- doptM Opt_IndexedTypes
+  ; idx_tys <- doptM Opt_TypeFamilies
 
-	-- Check that we don't use families without -findexed-types
+	-- Check that we don't use families without -ftype-families
   ; 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]
   }
 
@@ -1172,7 +1168,7 @@ badSigTyDecl tc_name
 badFamInstDecl tc_name
   = vcat [ ptext SLIT("Illegal family instance for") <+>
 	   quotes (ppr tc_name)
-	 , nest 2 (parens $ ptext SLIT("Use -findexed-types to allow indexed type families")) ]
+	 , nest 2 (parens $ ptext SLIT("Use -ftype-families to allow indexed type families")) ]
 
 badGadtIdxTyDecl tc_name
   = vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+>
@@ -1194,9 +1190,8 @@ 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