X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=509cce23b6e710c4a25a7f0bbf401394d3cf7da1;hp=6126b6302e2de99ab7412413674b40147e19536e;hb=79b22beb4d2eca1877d99d55838ba6ce69658405;hpb=b6fcd8d1287ac70186c798013e270b0743eb7aa2 diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 6126b63..509cce2 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -273,7 +273,7 @@ dsExpr (HsCoreAnn fs expr) 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" + mkErrorAppDs pAT_ERROR_ID (funResultTy rhs_ty) (ptext (sLit "case")) | otherwise = do { core_discrim <- dsLExpr discrim @@ -396,8 +396,8 @@ dsExpr (RecordCon (L _ data_con_id) con_expr rbinds) = do = case findField (rec_flds rbinds) lbl of (rhs:rhss) -> ASSERT( null rhss ) dsLExpr rhs - [] -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (showSDoc (ppr lbl)) - unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty "" + [] -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (ppr lbl) + unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty empty labels = dataConFieldLabels (idDataCon data_con_id) -- The data_con_id is guaranteed to be the wrapper id of the constructor