X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=eed7f87d8f304c49d989ff832729f5325d368fb0;hp=043f54fa8066f491968487ea1b50355be150a329;hb=27de38efce6d73d2a0209f803cfa98c82773e773;hpb=1fa3580c54985d73178d1d396b897176a57cd7f3

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 043f54f..eed7f87 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -266,10 +266,15 @@ dsExpr (HsSCC cc expr) = do
 dsExpr (HsCoreAnn fs expr)
   = Note (CoreNote $ unpackFS fs) <$> dsLExpr expr
 
-dsExpr (HsCase discrim matches) = do
-    core_discrim <- dsLExpr discrim
-    ([discrim_var], matching_code) <- matchWrapper CaseAlt matches
-    return (scrungleMatch discrim_var core_discrim matching_code)
+dsExpr (HsCase discrim matches@(MatchGroup _ rhs_ty)) 
+  | isEmptyMatchGroup matches	-- A Core 'case' is always non-empty
+  = 		      		-- So desugar empty HsCase to error call
+    mkErrorAppDs pAT_ERROR_ID (funResultTy rhs_ty) "case"
+
+  | otherwise
+  = do { core_discrim <- dsLExpr discrim
+       ; ([discrim_var], matching_code) <- matchWrapper CaseAlt matches
+       ; return (scrungleMatch discrim_var core_discrim matching_code) }
 
 -- Pepe: The binds are in scope in the body but NOT in the binding group
 --       This is to avoid silliness in breakpoints