Core.Ppr: Omit case binder for empty case alternatives

A minor improvement to pretty-printing

7 files changed, 66 insertions, 57 deletions

diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index d5d21e294d..ce3ab841e7 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -240,7 +240,13 @@ ppr_expr add_par expr@(App {})
         _ -> parens (hang (pprParendExpr fun) 2 pp_args)
     }
 
-ppr_expr add_par (Case expr var ty [Alt con args rhs])
+ppr_expr add_par (Case expr _ ty []) -- Empty Case
+  = add_par $ sep [text "case"
+                      <+> pprCoreExpr expr
+                      <+> whenPprDebug (text "return" <+> ppr ty),
+                    text "of {}"]
+
+ppr_expr add_par (Case expr var ty [Alt con args rhs]) -- Single alt Case
   = sdocOption sdocPrintCaseAsLet $ \case
       True -> add_par $  -- See Note [Print case as let]
                sep [ sep [ text "let! {"
@@ -264,7 +270,7 @@ ppr_expr add_par (Case expr var ty [Alt con args rhs])
   where
     ppr_bndr = pprBndr CaseBind
 
-ppr_expr add_par (Case expr var ty alts)
+ppr_expr add_par (Case expr var ty alts) -- Multi alt Case
   = add_par $
     sep [sep [text "case"
                 <+> pprCoreExpr expr
diff --git a/testsuite/tests/corelint/T21115b.stderr b/testsuite/tests/corelint/T21115b.stderr
index 199b999f1f..3048ebbe72 100644
--- a/testsuite/tests/corelint/T21115b.stderr
+++ b/testsuite/tests/corelint/T21115b.stderr
@@ -19,7 +19,7 @@ foo
       let {
         fail
           = \ ds ->
-              case patError "T21115b.hs:(10,4)-(15,4)|\\case"# of wild { } } in
+              case patError "T21115b.hs:(10,4)-(15,4)|\\case"# of {} } in
       let { fail = \ ds -> 5# } in
       case ds of ds {
         __DEFAULT -> fail (##);
diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr
index 10e6a4a894..f5e70968c3 100644
--- a/testsuite/tests/deSugar/should_compile/T2431.stderr
+++ b/testsuite/tests/deSugar/should_compile/T2431.stderr
@@ -12,7 +12,7 @@ T2431.$WRefl
 -- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0}
 absurd :: forall a. (Int :~: Bool) -> a
 [GblId, Arity=1, Str=<L>b, Cpr=b, Unf=OtherCon []]
-absurd = \ (@a) (x :: Int :~: Bool) -> case x of { }
+absurd = \ (@a) (x :: Int :~: Bool) -> case x of {}
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule1 :: GHC.Prim.Addr#
diff --git a/testsuite/tests/simplCore/should_compile/T9400.stderr b/testsuite/tests/simplCore/should_compile/T9400.stderr
index 071821f347..7a2bd3f98d 100644
--- a/testsuite/tests/simplCore/should_compile/T9400.stderr
+++ b/testsuite/tests/simplCore/should_compile/T9400.stderr
@@ -71,8 +71,7 @@ main
                   @()
                   (case Control.Exception.Base.patError
                           @LiftedRep @() "T9400.hs:(17,5)-(18,29)|case"#
-                   of wild {
-                   })
+                   of {})
                   (>>
                      @IO
                      GHC.Base.$fMonadIO
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 97bbeabcc1..4ad119a629 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -6,36 +6,41 @@ Result size of Tidy Core
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 Roman.$trModule4 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
 Roman.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 Roman.$trModule3 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 Roman.$trModule3 = GHC.Types.TrNameS Roman.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 Roman.$trModule2 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 Roman.$trModule2 = "Roman"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 Roman.$trModule1 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 Roman.$trModule1 = GHC.Types.TrNameS Roman.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 Roman.$trModule :: GHC.Types.Module
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 Roman.$trModule
   = GHC.Types.Module Roman.$trModule3 Roman.$trModule1
 
@@ -77,12 +82,13 @@ Roman.$wgo [InlPrag=[2]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
 [GblId[StrictWorker([!, !])],
  Arity=2,
  Str=<1L><1L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [61 30] 249 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [61 30] 249 0}]
 Roman.$wgo
   = \ (u :: Maybe Int) (ds :: Maybe Int) ->
       case ds of {
-        Nothing -> case Roman.foo3 of wild1 { };
+        Nothing -> case Roman.foo3 of {};
         Just x ->
           case x of { GHC.Types.I# ipv ->
           case u of {
@@ -113,8 +119,8 @@ Roman.foo_go [InlPrag=[2]] :: Maybe Int -> Maybe Int -> Int
  Arity=2,
  Str=<1L><1L>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
          Tmpl= \ (u [Occ=Once1] :: Maybe Int)
                  (ds [Occ=Once1] :: Maybe Int) ->
@@ -128,15 +134,17 @@ Roman.foo_go
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 Roman.foo2 :: Int
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 Roman.foo2 = GHC.Types.I# 6#
 
 -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
 Roman.foo1 :: Maybe Int
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 Roman.foo1 = GHC.Maybe.Just @Int Roman.foo2
 
 -- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0}
@@ -145,8 +153,8 @@ foo :: Int -> Int
  Arity=1,
  Str=<1L>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (n [Occ=Once1!] :: Int) ->
                  case n of n1 [Occ=Once1] { GHC.Types.I# _ [Occ=Dead] ->
diff --git a/testsuite/tests/stranal/should_compile/T13143.stderr b/testsuite/tests/stranal/should_compile/T13143.stderr
index 3bb9885a83..62de564716 100644
--- a/testsuite/tests/stranal/should_compile/T13143.stderr
+++ b/testsuite/tests/stranal/should_compile/T13143.stderr
@@ -7,22 +7,21 @@ Rec {
 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker]
   :: forall {a}. (# #) -> a
-[GblId, Arity=1, Str=<B>b{sBp->S}, Cpr=b, Unf=OtherCon []]
-T13143.$wf
-  = \ (@a_sBm) _ [Occ=Dead] -> T13143.$wf @a_sBm GHC.Prim.(##)
+[GblId, Arity=1, Str=<B>b{sBo->S}, Cpr=b, Unf=OtherCon []]
+T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)
 end Rec }
 
 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 f [InlPrag=NOINLINE[final]] :: forall a. Int -> a
 [GblId,
  Arity=1,
- Str=<B>b{sBp->S},
+ Str=<B>b{sBo->S},
  Cpr=b,
  Unf=Unf{Src=StableSystem, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
-         Tmpl= \ (@a_sBm) _ [Occ=Dead] -> T13143.$wf @a_sBm GHC.Prim.(##)}]
-f = \ (@a_sBm) _ [Occ=Dead] -> T13143.$wf @a_sBm GHC.Prim.(##)
+         Tmpl= \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)}]
+f = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T13143.$trModule4 :: GHC.Prim.Addr#
@@ -66,9 +65,9 @@ T13143.$trModule
   = GHC.Types.Module T13143.$trModule3 T13143.$trModule1
 
 -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
-lvl_rBN :: Int
-[GblId, Str=b{sBp->S}, Cpr=b]
-lvl_rBN = T13143.$wf @Int GHC.Prim.(##)
+lvl :: Int
+[GblId, Str=b{sBo->S}, Cpr=b]
+lvl = T13143.$wf @Int GHC.Prim.(##)
 
 Rec {
 -- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
@@ -79,17 +78,17 @@ T13143.$wg [InlPrag=[2], Occ=LoopBreaker]
  Str=<1L><1L><L>,
  Unf=OtherCon []]
 T13143.$wg
-  = \ (ds_sBr :: Bool) (ds1_sBs :: Bool) (ww_sBv :: GHC.Prim.Int#) ->
-      case ds_sBr of {
+  = \ (ds :: Bool) (ds1 :: Bool) (ww :: GHC.Prim.Int#) ->
+      case ds of {
         False ->
-          case ds1_sBs of {
-            False -> T13143.$wg GHC.Types.False GHC.Types.True ww_sBv;
-            True -> GHC.Prim.+# ww_sBv 1#
+          case ds1 of {
+            False -> T13143.$wg GHC.Types.False GHC.Types.True ww;
+            True -> GHC.Prim.+# ww 1#
           };
         True ->
-          case ds1_sBs of {
-            False -> T13143.$wg GHC.Types.True GHC.Types.True ww_sBv;
-            True -> case lvl_rBN of wild2_00 { }
+          case ds1 of {
+            False -> T13143.$wg GHC.Types.True GHC.Types.True ww;
+            True -> case lvl of {}
           }
       }
 end Rec }
@@ -103,20 +102,17 @@ g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
  Unf=Unf{Src=StableSystem, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (ds_sBr [Occ=Once1] :: Bool)
-                 (ds1_sBs [Occ=Once1] :: Bool)
-                 (p_sBt [Occ=Once1!] :: Int) ->
-                 case p_sBt of { GHC.Types.I# ww_sBv [Occ=Once1] ->
-                 case T13143.$wg ds_sBr ds1_sBs ww_sBv of ww1_sBA [Occ=Once1]
-                 { __DEFAULT ->
-                 GHC.Types.I# ww1_sBA
+         Tmpl= \ (ds [Occ=Once1] :: Bool)
+                 (ds1 [Occ=Once1] :: Bool)
+                 (p [Occ=Once1!] :: Int) ->
+                 case p of { GHC.Types.I# ww [Occ=Once1] ->
+                 case T13143.$wg ds ds1 ww of ww1 [Occ=Once1] { __DEFAULT ->
+                 GHC.Types.I# ww1
                  }
                  }}]
-g = \ (ds_sBr :: Bool) (ds1_sBs :: Bool) (p_sBt :: Int) ->
-      case p_sBt of { GHC.Types.I# ww_sBv ->
-      case T13143.$wg ds_sBr ds1_sBs ww_sBv of ww1_sBA { __DEFAULT ->
-      GHC.Types.I# ww1_sBA
-      }
+g = \ (ds :: Bool) (ds1 :: Bool) (p :: Int) ->
+      case p of { GHC.Types.I# ww ->
+      case T13143.$wg ds ds1 ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
       }
 
 
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 4dbe61a300..4249f9f90d 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -43,7 +43,7 @@ test('T13077', normal, compile, [''])
 test('T13077a', normal, compile, [''])
 
 # T13143: WW for NOINLINE function f
-test('T13143', [ grep_errmsg(r'^T13143\.\$wf') ], compile, ['-ddump-simpl'])
+test('T13143', [ grep_errmsg(r'^T13143\.\$wf') ], compile, ['-ddump-simpl -dsuppress-uniques'])
 
 # T15627
 #   Absent bindings of unlifted types should be WW'ed away.