Commit 2265c849 authored by Joachim Breitner's avatar Joachim Breitner

Core pretty printer: Omit wild case binders

as they (especially their id info with absence information) clutter the
output too much. They come back with debug_on.

Differential Revision: https://phabricator.haskell.org/D2072
parent 1a8d61ca
......@@ -189,14 +189,15 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
, pprCoreExpr rhs
]
else add_par $
sep [sep [text "case" <+> pprCoreExpr expr,
ifPprDebug (text "return" <+> ppr ty),
sep [text "of" <+> ppr_bndr var,
char '{' <+> ppr_case_pat con args <+> arrow]
],
pprCoreExpr rhs,
char '}'
]
sep [sep [sep [ text "case" <+> pprCoreExpr expr
, ifPprDebug (text "return" <+> ppr ty)
, text "of" <+> ppr_bndr var
]
, char '{' <+> ppr_case_pat con args <+> arrow
]
, pprCoreExpr rhs
, char '}'
]
where
ppr_bndr = pprBndr CaseBind
......@@ -259,13 +260,13 @@ ppr_case_pat (DataAlt dc) args
| Just sort <- tyConTuple_maybe tc
= tupleParens sort (pprWithCommas ppr_bndr args)
where
ppr_bndr = pprBndr CaseBind
ppr_bndr = pprBndr CasePatBind
tc = dataConTyCon dc
ppr_case_pat con args
= ppr con <+> (fsep (map ppr_bndr args))
where
ppr_bndr = pprBndr CaseBind
ppr_bndr = pprBndr CasePatBind
-- | Pretty print the argument in a function application.
......@@ -292,6 +293,21 @@ With -dppr-case-as-let we print them as such:
Other printing bits-and-bobs used with the general @pprCoreBinding@
and @pprCoreExpr@ functions.
Note [Binding-site specific printing]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
pprCoreBinder and pprTypedLamBinder receive a BindingSite argument to adjust
the information printed.
Let-bound binders are printed with their full type and idInfo.
Case-bound variables (both the case binder and pattern variables) are printed
without a type and without their unfolding.
Furthermore, a dead case-binder is completely ignored, while otherwise, dead
binders are printed as "_".
-}
instance OutputableBndr Var where
......@@ -321,6 +337,10 @@ pprTypedLamBinder bind_site debug_on var
= sdocWithDynFlags $ \dflags ->
case () of
_
| not debug_on -- Show case-bound wild bilders only if debug is on
, CaseBind <- bind_site
, isDeadBinder var -> empty
| not debug_on -- Even dead binders can be one-shot
, isDeadBinder var -> char '_' <+> ppWhen (isId var)
(pprIdBndrInfo (idInfo var))
......@@ -328,6 +348,9 @@ pprTypedLamBinder bind_site debug_on var
| not debug_on -- No parens, no kind info
, CaseBind <- bind_site -> pprUntypedBinder var
| not debug_on
, CasePatBind <- bind_site -> pprUntypedBinder var
| suppress_sigs dflags -> pprUntypedBinder var
| isTyVar var -> parens (pprKindedTyVarBndr var)
......
......@@ -525,7 +525,7 @@ ppr_monobind :: (OutputableBndr idL, OutputableBndr idR) => HsBindLR idL idR ->
ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
= pprPatBind pat grhss
ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
= sep [pprBndr CaseBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
= sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
ppr_monobind (FunBind { fun_id = fun,
fun_co_fn = wrap,
fun_matches = matches,
......
......@@ -740,7 +740,7 @@ pprStgExpr (StgCase expr bndr alt_type alts)
pprStgAlt :: (OutputableBndr bndr, Outputable occ, Ord occ)
=> GenStgAlt bndr occ -> SDoc
pprStgAlt (con, params, expr)
= hang (hsep [ppr con, sep (map (pprBndr CaseBind) params), text "->"])
= hang (hsep [ppr con, sep (map (pprBndr CasePatBind) params), text "->"])
4 (ppr expr <> semi)
pprStgOp :: StgOp -> SDoc
......
......@@ -837,7 +837,12 @@ instance Outputable Extension where
-- | 'BindingSite' is used to tell the thing that prints binder what
-- language construct is binding the identifier. This can be used
-- to decide how much info to print.
data BindingSite = LambdaBind | CaseBind | LetBind
-- Also see Note [Binding-site specific printing] in PprCore
data BindingSite
= LambdaBind -- ^ The x in (\x. e)
| CaseBind -- ^ The x in case scrut of x { (y,z) -> ... }
| CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... }
| LetBind -- ^ The x in (let x = rhs in e)
-- | When we print a binder, we often want to print its type too.
-- The @OutputableBndr@ class encapsulates this idea.
......
......@@ -19,7 +19,7 @@ T2431.$WRefl =
-- RHS size: {terms: 4, types: 8, coercions: 0}
absurd :: forall a. Int :~: Bool -> a
[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>x]
absurd = \ (@ a) (x :: Int :~: Bool) -> case x of _ [Occ=Dead] { }
absurd = \ (@ a) (x :: Int :~: Bool) -> case x of { }
-- RHS size: {terms: 2, types: 0, coercions: 0}
$trModule1 :: GHC.Types.TrName
......
......@@ -40,14 +40,12 @@ dr :: Double -> Double
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Double) ->
case x of _ [Occ=Dead] { GHC.Types.D# x1 ->
case x of { GHC.Types.D# x1 ->
GHC.Types.D# (GHC.Prim.+## x1 x1)
}}]
dr =
\ (x :: Double) ->
case x of _ [Occ=Dead] { GHC.Types.D# x1 ->
GHC.Types.D# (GHC.Prim.+## x1 x1)
}
case x of { GHC.Types.D# x1 -> GHC.Types.D# (GHC.Prim.+## x1 x1) }
-- RHS size: {terms: 1, types: 0, coercions: 0}
dl :: Double -> Double
......@@ -59,9 +57,7 @@ dl :: Double -> Double
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Double) ->
case x of _ [Occ=Dead] { GHC.Types.D# y ->
GHC.Types.D# (GHC.Prim.+## y y)
}}]
case x of { GHC.Types.D# y -> GHC.Types.D# (GHC.Prim.+## y y) }}]
dl = dr
-- RHS size: {terms: 8, types: 3, coercions: 0}
......@@ -74,12 +70,12 @@ fr :: Float -> Float
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Float) ->
case x of _ [Occ=Dead] { GHC.Types.F# x1 ->
case x of { GHC.Types.F# x1 ->
GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
}}]
fr =
\ (x :: Float) ->
case x of _ [Occ=Dead] { GHC.Types.F# x1 ->
case x of { GHC.Types.F# x1 ->
GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
}
......@@ -93,7 +89,7 @@ fl :: Float -> Float
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Float) ->
case x of _ [Occ=Dead] { GHC.Types.F# y ->
case x of { GHC.Types.F# y ->
GHC.Types.F# (GHC.Prim.plusFloat# y y)
}}]
fl = fr
......
......@@ -53,12 +53,12 @@ foo [InlPrag=INLINE[0]] :: Int -> Int
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (w [Occ=Once!] :: Int) ->
case w of _ [Occ=Dead] { GHC.Types.I# ww1 [Occ=Once] ->
case w of { GHC.Types.I# ww1 [Occ=Once] ->
case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
}}]
foo =
\ (w :: Int) ->
case w of _ [Occ=Dead] { GHC.Types.I# ww1 ->
case w of { GHC.Types.I# ww1 ->
case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
}
......
......@@ -19,9 +19,8 @@ foo [InlPrag=NOINLINE] :: Int -> ()
[GblId, Arity=1, Caf=NoCafRefs, Str=<S(S),1*U(U)>]
foo =
\ (n :: Int) ->
case n of _ [Occ=Dead] { GHC.Types.I# y ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0# y)
of _ [Occ=Dead] {
case n of { GHC.Types.I# y ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0# y) of {
False -> GHC.Tuple.();
True -> $wxs y
}
......
......@@ -58,8 +58,8 @@ T4908.$wf =
\ (ww :: Int#) (w :: (Int, Int)) ->
case ww of ds {
__DEFAULT ->
case w of _ [Occ=Dead] { (a, b) ->
case b of _ [Occ=Dead] { I# ds1 ->
case w of { (a, b) ->
case b of { I# ds1 ->
case ds1 of ds2 {
__DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#);
0# -> GHC.Types.True
......@@ -79,10 +79,10 @@ f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: (Int, Int)) ->
case w of _ [Occ=Dead] { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
case w of { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
f =
\ (w :: Int) (w1 :: (Int, Int)) ->
case w of _ [Occ=Dead] { I# ww1 -> T4908.$wf ww1 w1 }
case w of { I# ww1 -> T4908.$wf ww1 w1 }
------ Local rules for imported ids --------
......
......@@ -37,13 +37,13 @@ T4930.$wfoo [InlPrag=[0], Occ=LoopBreaker]
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
T4930.$wfoo =
\ (ww :: GHC.Prim.Int#) ->
case case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# ww 5#)
of _ [Occ=Dead] {
case case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# ww 5#) of {
False -> GHC.Types.I# (GHC.Prim.+# ww 2#);
True ->
case T4930.$wfoo ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 }
}
of _ [Occ=Dead] { GHC.Types.I# ipv ->
of
{ GHC.Types.I# ipv ->
GHC.Prim.+# ww 5#
}
end Rec }
......@@ -58,12 +58,12 @@ foo [InlPrag=INLINE[0]] :: Int -> Int
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (w [Occ=Once!] :: Int) ->
case w of _ [Occ=Dead] { GHC.Types.I# ww1 [Occ=Once] ->
case w of { GHC.Types.I# ww1 [Occ=Once] ->
case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
}}]
foo =
\ (w :: Int) ->
case w of _ [Occ=Dead] { GHC.Types.I# ww1 ->
case w of { GHC.Types.I# ww1 ->
case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
}
......
case ds of _ [Occ=Dead] { Bar dt dt1 -> GHC.Types.I# dt }
case ds of { Bar dt [Occ=Once] _ [Occ=Dead] -> GHC.Types.I# dt }}]
f = \ (ds :: Bar) -> case ds of { Bar dt dt1 -> GHC.Types.I# dt }
......@@ -12,21 +12,15 @@ T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
Tmpl= \ (dt [Occ=Once!] :: Int) ->
case dt of _ [Occ=Dead] { GHC.Types.I# dt [Occ=Once] ->
T7360.Foo3 dt
}}]
case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }}]
T7360.$WFoo3 =
\ (dt [Occ=Once!] :: Int) ->
case dt of _ [Occ=Dead] { GHC.Types.I# dt [Occ=Once] ->
T7360.Foo3 dt
}
case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }
-- RHS size: {terms: 5, types: 2, coercions: 0}
fun1 [InlPrag=NOINLINE] :: Foo -> ()
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
fun1 =
\ (x :: Foo) ->
case x of _ [Occ=Dead] { __DEFAULT -> GHC.Tuple.() }
fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() }
-- RHS size: {terms: 2, types: 0, coercions: 0}
T7360.fun5 :: ()
......
expensive [InlPrag=NOINLINE] :: Int -> Int
expensive =
case expensive sc1 of _ [Occ=Dead] { GHC.Types.I# x ->
(case expensive x of _ [Occ=Dead] { GHC.Types.I# x1 ->
case expensive sc1 of { GHC.Types.I# x ->
(case expensive x of { GHC.Types.I# x1 ->
......@@ -56,14 +56,11 @@ Roman.foo_$s$wgo =
(GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# sc sc) sc) sc) sc)
sc)
sc } in
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc1 0#)
of _ [Occ=Dead] {
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc1 0#) of {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 100#)
of _ [Occ=Dead] {
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 100#) of {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 500#)
of _ [Occ=Dead] {
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 500#) of {
False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# sc1 1#);
True -> Roman.foo_$s$wgo m (GHC.Prim.-# sc1 3#)
};
......@@ -82,10 +79,10 @@ Roman.$wgo [InlPrag=[0]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 256 0}]
Roman.$wgo =
\ (w :: Maybe Int) (w1 :: Maybe Int) ->
case w1 of _ [Occ=Dead] {
case w1 of {
Nothing -> case Roman.foo3 of wild1 { };
Just x ->
case x of _ [Occ=Dead] { GHC.Types.I# ipv ->
case x of { GHC.Types.I# ipv ->
let {
m :: GHC.Prim.Int#
[LclId]
......@@ -96,18 +93,15 @@ Roman.$wgo =
(GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# ipv ipv) ipv) ipv) ipv)
ipv)
ipv } in
case w of _ [Occ=Dead] {
case w of {
Nothing -> Roman.foo_$s$wgo m 10#;
Just n ->
case n of _ [Occ=Dead] { GHC.Types.I# x2 ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0#)
of _ [Occ=Dead] {
case n of { GHC.Types.I# x2 ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0#) of {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100#)
of _ [Occ=Dead] {
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100#) of {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500#)
of _ [Occ=Dead] {
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500#) of {
False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# x2 1#);
True -> Roman.foo_$s$wgo m (GHC.Prim.-# x2 3#)
};
......@@ -167,7 +161,7 @@ foo :: Int -> Int
}}]
foo =
\ (n :: Int) ->
case n of _ [Occ=Dead] { GHC.Types.I# ipv ->
case n of { GHC.Types.I# ipv ->
case Roman.foo_$s$wgo 6# ipv of ww { __DEFAULT -> GHC.Types.I# ww }
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment