X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyClsDecls.lhs;h=3a303e5201d3f1ed9d9890f61c96171497bbbe35;hb=85e16365444e938b4adff9d241d56df4c1fbca91;hp=3df2eef785d5772eed389788276698d2637357f2;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 3df2eef..3a303e5 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -6,11 +6,11 @@
 TcTyClsDecls: Typecheck type and class declarations
 
 \begin{code}
-{-# OPTIONS_GHC -w #-}
+{-# OPTIONS -w #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module TcTyClsDecls (
@@ -140,8 +140,12 @@ indeed type families).  I think.
 tcTyAndClassDecls :: ModDetails -> [LTyClDecl Name]
    	           -> TcM TcGblEnv 	-- Input env extended by types and classes 
 					-- and their implicit Ids,DataCons
+-- Fails if there are any errors
+
 tcTyAndClassDecls boot_details allDecls
-  = do	{       -- Omit instances of type families; they are handled together
+  = checkNoErrs $ 	-- The code recovers internally, but if anything gave rise to
+			-- an error we'd better stop now, to avoid a cascade
+    do	{       -- Omit instances of type families; they are handled together
 		-- with the *heads* of class instances
         ; let decls = filter (not . isFamInstDecl . unLoc) allDecls
 
@@ -247,7 +251,7 @@ tcFamInstDecl (L loc decl)
     recoverM (returnM Nothing)		        $
     setSrcSpan loc				$
     tcAddDeclCtxt decl				$
-    do { -- type families require -ftype-families and can't be in an
+    do { -- type families require -XTypeFamilies and can't be in an
 	 -- hs-boot file
        ; type_families <- doptM Opt_TypeFamilies
        ; is_boot  <- tcIsHsBoot	  -- Are we compiling an hs-boot file?
@@ -666,14 +670,14 @@ tcTyClDecl1 _calc_isrec
   { traceTc (text "type family: " <+> ppr tc_name) 
   ; idx_tys <- doptM Opt_TypeFamilies
 
-	-- Check that we don't use families without -ftype-families
+	-- Check that we don't use families without -XTypeFamilies
   ; checkTc idx_tys $ badFamInstDecl tc_name
 
   ; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) Nothing
   ; return [ATyCon tycon]
   }
 
-  -- "newtype family" or "data family" declaration
+  -- "data family" declaration
 tcTyClDecl1 _calc_isrec 
   (TyFamily {tcdFlavour = DataFamily, 
 	     tcdLName = L _ tc_name, tcdTyVars = tvs, tcdKind = mb_kind})
@@ -684,7 +688,7 @@ tcTyClDecl1 _calc_isrec
 
   ; idx_tys <- doptM Opt_TypeFamilies
 
-	-- Check that we don't use families without -ftype-families
+	-- Check that we don't use families without -XTypeFamilies
   ; checkTc idx_tys $ badFamInstDecl tc_name
 
   ; tycon <- buildAlgTyCon tc_name final_tvs [] 
@@ -693,6 +697,7 @@ tcTyClDecl1 _calc_isrec
   }
 
   -- "newtype" and "data"
+  -- NB: not used for newtype/data instances (whether associated or not)
 tcTyClDecl1 calc_isrec
   (TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
 	   tcdLName = L _ tc_name, tcdKindSig = mb_ksig, tcdCons = cons})
@@ -755,6 +760,8 @@ tcTyClDecl1 calc_isrec
   { ctxt' <- tcHsKindedContext ctxt
   ; fds' <- mappM (addLocM tc_fundep) fundeps
   ; atss <- mappM (addLocM (tcTyClDecl1 (const Recursive))) ats
+            -- NB: 'ats' only contains "type family" and "data family"
+            --     declarations as well as type family defaults
   ; let ats' = zipWith setTyThingPoss atss (map (tcdTyVars . unLoc) ats)
   ; sig_stuff <- tcClassSigs class_name sigs meths
   ; clas <- fixM (\ clas ->