X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreLint.lhs;h=de9830b7e4ed65e3437f92724eaa4b99b790665a;hp=f7c63f8f51398c9c9c656b4d5a159c3b396c6df6;hb=526c3af1dc98987b6949f4df73c0debccf9875bd;hpb=842e9d6628a27cf1f420d53f6a5901935dc50c54

diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index f7c63f8..de9830b 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -363,6 +363,17 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
   do { scrut_ty <- lintCoreExpr scrut
      ; alt_ty   <- lintTy alt_ty  
      ; var_ty   <- lintTy (idType var)	
+
+     ; let mb_tc_app = splitTyConApp_maybe (idType var)
+     ; case mb_tc_app of 
+         Just (tycon, _)
+              | debugIsOn &&
+                isAlgTyCon tycon && 
+                null (tyConDataCons tycon) -> 
+                  pprTrace "case binder's type has no constructors" (ppr e)
+                      $ return ()
+         _otherwise -> return ()
+
 	-- Don't use lintIdBndr on var, because unboxed tuple is legitimate
 
      ; subst <- getTvSubst