Fix Trac #7805: don't allow nested foralls in promoted types
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Apr 2013 13:38:14 +0000 (14:38 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Apr 2013 13:38:14 +0000 (14:38 +0100)
compiler/typecheck/TcTyDecls.lhs

index 99ee065..fb54899 100644 (file)
@@ -506,21 +506,16 @@ isPromotableType :: NameSet -> Type -> Bool
 -- Must line up with DataCon.promoteType
 -- But the function lives here because we must treat the
 -- *recursive* tycons as promotable
-isPromotableType rec_tcs ty
-  = case splitForAllTys ty of
-      (_, rho) -> go rho
+isPromotableType rec_tcs con_arg_ty
+  = go con_arg_ty
   where
-    go (TyConApp tc tys) 
-      | tys `lengthIs` tyConArity tc 
-      ,  tyConName tc `elemNameSet` rec_tcs 
-      || isJust (promotableTyCon_maybe tc) 
-                       = all go tys
-      | otherwise      = False
-    go (FunTy arg res) = go arg && go res
-    go (AppTy arg res) = go arg && go res
-    go (ForAllTy _ ty) = go ty
-    go (TyVarTy {})    = True
-    go (LitTy {})      = False
+    go (TyConApp tc tys) =  tys `lengthIs` tyConArity tc 
+                         && (tyConName tc `elemNameSet` rec_tcs 
+                             || isJust (promotableTyCon_maybe tc))
+                         && all go tys
+    go (FunTy arg res)          = go arg && go res
+    go (TyVarTy {})             = True
+    go _                        = False
 \end{code}