X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=f152ff5725a15f1659122472f1f8e16ed83723d4;hb=fdd7a41eec615cf3d77a95896a6183326e60c2ca;hp=043f54fa8066f491968487ea1b50355be150a329;hpb=146d36e87447f34fd9d0f6a1135173f899aa7f52;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 043f54f..f152ff5 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
@@ -559,7 +564,7 @@ dsExplicitList :: PostTcType -> [LHsExpr Id] -> DsM CoreExpr
 dsExplicitList elt_ty xs = do
     dflags <- getDOptsDs
     xs' <- mapM dsLExpr xs
-    if not (dopt Opt_RewriteRules dflags)
+    if not (dopt Opt_EnableRewriteRules dflags)
         then return $ mkListExpr elt_ty xs'
         else mkBuildExpr elt_ty (mkSplitExplicitList (thisPackage dflags) xs')
   where