X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyDecls.lhs;h=15c817a65780e26d6303d777fe279ecda1e01458;hp=a9ea11aefa19ab6158959342eabfffdd92f90318;hb=HEAD;hpb=6ea06bbf08517d9805feb82df65cc56ecbaf23a4

diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs
index a9ea11a..15c817a 100644
--- a/compiler/typecheck/TcTyDecls.lhs
+++ b/compiler/typecheck/TcTyDecls.lhs
@@ -30,7 +30,7 @@ import NameSet
 import Digraph
 import BasicTypes
 import SrcLoc
-import Outputable
+import Maybes( mapCatMaybes )
 import Util ( isSingleton )
 import Data.List
 \end{code}
@@ -253,11 +253,10 @@ calcRecFlags boot_details tyclss
                 nt_loop_breakers  `unionNameSets`
                 prod_loop_breakers
 
-    all_tycons = [ tc | tycls <- tyclss,
+    all_tycons = [ tc | tc <- mapCatMaybes getTyCon tyclss
                            -- Recursion of newtypes/data types can happen via
                            -- the class TyCon, so tyclss includes the class tycons
-                        let tc = getTyCon tycls,
-                        not (tyConName tc `elemNameSet` boot_name_set) ]
+                      , not (tyConName tc `elemNameSet` boot_name_set) ]
                            -- Remove the boot_name_set because they are going
                            -- to be loop breakers regardless.
 
@@ -321,10 +320,10 @@ calcRecFlags boot_details tyclss
 new_tc_rhs :: TyCon -> Type
 new_tc_rhs tc = snd (newTyConRhs tc)    -- Ignore the type variables
 
-getTyCon :: TyThing -> TyCon
-getTyCon (ATyCon tc) = tc
-getTyCon (AClass cl) = classTyCon cl
-getTyCon _           = panic "getTyCon"
+getTyCon :: TyThing -> Maybe TyCon
+getTyCon (ATyCon tc) = Just tc
+getTyCon (AClass cl) = Just (classTyCon cl)
+getTyCon _           = Nothing
 
 findLoopBreakers :: [(TyCon, [TyCon])] -> [Name]
 -- Finds a set of tycons that cut all loops
@@ -356,8 +355,8 @@ tcTyConsOfType ty
      go (FunTy a b)                = go a `plusNameEnv` go b
      go (PredTy (IParam _ ty))     = go ty
      go (PredTy (ClassP cls tys))  = go_tc (classTyCon cls) tys
+     go (PredTy (EqPred ty1 ty2))  = go ty1 `plusNameEnv` go ty2
      go (ForAllTy _ ty)            = go ty
-     go _                          = panic "tcTyConsOfType"
 
      go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc
      go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys