From b3c30fea00ff792c84012943ef1789e3f3953951 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Mon, 3 Apr 2023 11:07:03 +0200 Subject: Core.Ppr: Omit case binder for empty case alternatives A minor improvement to pretty-printing --- compiler/GHC/Core/Ppr.hs | 10 +++- testsuite/tests/corelint/T21115b.stderr | 2 +- .../tests/deSugar/should_compile/T2431.stderr | 2 +- .../tests/simplCore/should_compile/T9400.stderr | 3 +- .../simplCore/should_compile/spec-inline.stderr | 50 +++++++++++--------- .../tests/stranal/should_compile/T13143.stderr | 54 ++++++++++------------ testsuite/tests/stranal/should_compile/all.T | 2 +- 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=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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] + Unf=Unf{Src=, 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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, 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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] + Unf=Unf{Src=, 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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, 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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, 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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [61 30] 249 0}] + Unf=Unf{Src=, 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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, 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=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, 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{sBp->S}, Cpr=b, Unf=OtherCon []] -T13143.$wf - = \ (@a_sBm) _ [Occ=Dead] -> T13143.$wf @a_sBm GHC.Prim.(##) +[GblId, Arity=1, Str=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{sBp->S}, + Str=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>, 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. -- cgit v1.2.1