Commit 0e760174 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Simplify OutputableBndr

This replaces three methods in OutputableBndr with one,
and adds comments.

There's also a tiny change in the placement of equals signs in
debug-prints.  I like it better that way, but if it complicates
life for anyone we can put it back.
parent e55986a9
......@@ -524,7 +524,6 @@ instance OutputableBndr Name where
pprInfixOcc = pprInfixName
pprPrefixOcc = pprPrefixName
pprName :: Name -> SDoc
pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
= getPprStyle $ \ sty ->
......
......@@ -1724,9 +1724,7 @@ instance (OutputableBndr Var, Outputable b) =>
pprBndr _ b = ppr b -- Simple
pprInfixOcc b = ppr b
pprPrefixOcc b = ppr b
pprNonRecBndrKeyword (TB b _) = pprNonRecBndrKeyword b
pprRecBndrKeyword (TB b _) = pprRecBndrKeyword b
pprLamsOnLhs (TB b _) = pprLamsOnLhs b
bndrIsJoin_maybe (TB b _) = isJoinId_maybe b
deTagExpr :: TaggedExpr t -> CoreExpr
deTagExpr (Var v) = Var v
......
......@@ -113,15 +113,23 @@ ppr_bind ann (Rec binds) = vcat (map pp binds)
ppr_binding :: OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding ann (val_bdr, expr)
= ann expr $$ pprBndr LetBind val_bdr $$
hang (ppr val_bdr <+> sep (map (pprBndr LambdaBind) lhs_bndrs) <+> equals) 2
(pprCoreExpr rhs)
= ann expr $$ pprBndr LetBind val_bdr $$ pp_bind
where
(bndrs, body) = collectBinders expr
(lhs_bndrs, rhs_bndrs) = splitAt (pprLamsOnLhs val_bdr) bndrs
rhs = mkLams rhs_bndrs body
-- Returns ([], expr) unless it's a join point, in which
-- case we want the args before the =
pp_bind = case bndrIsJoin_maybe val_bdr of
Nothing -> pp_normal_bind
Just ar -> pp_join_bind ar
pp_normal_bind = hang (ppr val_bdr) 2 (equals <+> pprCoreExpr expr)
-- For a join point of join arity n, we want to print j = \x1 ... xn -> e
-- as "j x1 ... xn = e" to differentiate when a join point returns a
-- lambda (the first rendering looks like a nullary join point returning
-- an n-argument function).
pp_join_bind join_arity
= hang (ppr val_bdr <+> sep (map (pprBndr LambdaBind) lhs_bndrs))
2 (equals <+> pprCoreExpr rhs)
where
(lhs_bndrs, rhs) = collectNBinders join_arity expr
pprParendExpr expr = ppr_expr parens expr
pprCoreExpr expr = ppr_expr noParens expr
......@@ -249,17 +257,20 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))
pprCoreExpr expr)
-}
-- General case (recursive case, too)
ppr_expr add_par (Let bind expr)
= add_par $
sep [hang (keyword <+> char '{') 2 (ppr_bind noAnn bind <+> text "} in"),
sep [hang (keyword bind <+> char '{') 2 (ppr_bind noAnn bind <+> text "} in"),
pprCoreExpr expr]
where
keyword = case bind of
NonRec b _ -> pprNonRecBndrKeyword b
Rec ((b,_):_) -> pprRecBndrKeyword b
Rec [] -> text "let" -- This *shouldn't* happen, but
-- let's be tolerant here
keyword (NonRec b _)
| isJust (bndrIsJoin_maybe b) = text "join"
| otherwise = text "let"
keyword (Rec pairs)
| ((b,_):_) <- pairs
, isJust (bndrIsJoin_maybe b) = text "joinrec"
| otherwise = text "letrec"
ppr_expr add_par (Tick tickish expr)
= sdocWithDynFlags $ \dflags ->
......@@ -330,11 +341,7 @@ instance OutputableBndr Var where
pprBndr = pprCoreBinder
pprInfixOcc = pprInfixName . varName
pprPrefixOcc = pprPrefixName . varName
pprNonRecBndrKeyword bndr | isJoinId bndr = text "join"
| otherwise = text "let"
pprRecBndrKeyword bndr | isJoinId bndr = text "joinrec"
| otherwise = text "letrec"
pprLamsOnLhs bndr = isJoinId_maybe bndr `orElse` 0
bndrIsJoin_maybe = isJoinId_maybe
pprCoreBinder :: BindingSite -> Var -> SDoc
pprCoreBinder LetBind binder
......
......@@ -962,18 +962,12 @@ class Outputable a => OutputableBndr a where
-- prefix position of an application, thus (f a b) or ((+) x)
-- or infix position, thus (a `f` b) or (x + y)
pprNonRecBndrKeyword, pprRecBndrKeyword :: a -> SDoc
-- Print which keyword introduces the binder in Core code. This should be
-- "let" or "letrec" for a value but "join" or "joinrec" for a join point.
pprNonRecBndrKeyword _ = text "let"
pprRecBndrKeyword _ = text "letrec"
pprLamsOnLhs :: a -> Int
-- For a join point of join arity n, we want to print j = \x1 ... xn -> e
-- as "j x1 ... xn = e" to differentiate when a join point returns a
-- lambda (the first rendering looks like a nullary join point returning
-- an n-argument function).
pprLamsOnLhs _ = 0
bndrIsJoin_maybe :: a -> Maybe Int
bndrIsJoin_maybe _ = Nothing
-- When pretty-printing we sometimes want to find
-- whether the binder is a join point. You might think
-- we could have a function of type (a->Var), but Var
-- isn't available yet, alas
{-
************************************************************************
......
......@@ -44,8 +44,8 @@ T7116.$trModule :: GHC.Types.Module
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
T7116.$trModule =
GHC.Types.Module T7116.$trModule3 T7116.$trModule1
T7116.$trModule
= GHC.Types.Module T7116.$trModule3 T7116.$trModule1
-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
dr :: Double -> Double
......@@ -60,9 +60,9 @@ dr :: Double -> Double
case x of { GHC.Types.D# x1 ->
GHC.Types.D# (GHC.Prim.+## x1 x1)
}}]
dr =
\ (x :: Double) ->
case x of { GHC.Types.D# x1 -> GHC.Types.D# (GHC.Prim.+## x1 x1) }
dr
= \ (x :: Double) ->
case x of { GHC.Types.D# x1 -> GHC.Types.D# (GHC.Prim.+## x1 x1) }
-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
dl :: Double -> Double
......@@ -75,9 +75,9 @@ dl :: Double -> Double
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Double) ->
case x of { GHC.Types.D# y -> GHC.Types.D# (GHC.Prim.+## y y) }}]
dl =
\ (x :: Double) ->
case x of { GHC.Types.D# y -> GHC.Types.D# (GHC.Prim.+## y y) }
dl
= \ (x :: Double) ->
case x of { GHC.Types.D# y -> GHC.Types.D# (GHC.Prim.+## y y) }
-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
fr :: Float -> Float
......@@ -92,11 +92,11 @@ fr :: Float -> Float
case x of { GHC.Types.F# x1 ->
GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
}}]
fr =
\ (x :: Float) ->
case x of { GHC.Types.F# x1 ->
GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
}
fr
= \ (x :: Float) ->
case x of { GHC.Types.F# x1 ->
GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
}
-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
fl :: Float -> Float
......@@ -111,11 +111,11 @@ fl :: Float -> Float
case x of { GHC.Types.F# y ->
GHC.Types.F# (GHC.Prim.plusFloat# y y)
}}]
fl =
\ (x :: Float) ->
case x of { GHC.Types.F# y ->
GHC.Types.F# (GHC.Prim.plusFloat# y y)
}
fl
= \ (x :: Float) ->
case x of { GHC.Types.F# y ->
GHC.Types.F# (GHC.Prim.plusFloat# y y)
}
case GHC.List.reverse @ a x of sat { __DEFAULT ->
case \ (@ a1) ->
case g x of {
case r @ GHC.Types.Any of { __DEFAULT -> r @ a }
case GHC.List.reverse @ a x of sat { __DEFAULT ->
case \ (@ a1) ->
case g x of {
case r @ GHC.Types.Any of { __DEFAULT -> r @ a }
......@@ -7,23 +7,23 @@ Rec {
-- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
$wxs :: GHC.Prim.Int# -> ()
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
$wxs =
\ (ww :: GHC.Prim.Int#) ->
case ww of ds1 {
__DEFAULT -> $wxs (GHC.Prim.-# ds1 1#);
1# -> GHC.Tuple.()
}
$wxs
= \ (ww :: GHC.Prim.Int#) ->
case ww of ds1 {
__DEFAULT -> $wxs (GHC.Prim.-# ds1 1#);
1# -> GHC.Tuple.()
}
end Rec }
-- RHS size: {terms: 11, types: 3, coercions: 0, joins: 0/0}
T3772.$wfoo [InlPrag=NOINLINE] :: GHC.Prim.Int# -> ()
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
T3772.$wfoo =
\ (ww :: GHC.Prim.Int#) ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0# ww) of {
False -> GHC.Tuple.();
True -> $wxs ww
}
T3772.$wfoo
= \ (ww :: GHC.Prim.Int#) ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0# ww) of {
False -> GHC.Tuple.();
True -> $wxs ww
}
-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
foo [InlPrag=INLINE[0]] :: Int -> ()
......@@ -36,8 +36,8 @@ foo [InlPrag=INLINE[0]] :: Int -> ()
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (w [Occ=Once!] :: Int) ->
case w of { GHC.Types.I# ww1 [Occ=Once] -> T3772.$wfoo ww1 }}]
foo =
\ (w :: Int) -> case w of { GHC.Types.I# ww1 -> T3772.$wfoo ww1 }
foo
= \ (w :: Int) -> case w of { GHC.Types.I# ww1 -> T3772.$wfoo ww1 }
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T3772.$trModule2 :: GHC.Prim.Addr#
......@@ -80,8 +80,8 @@ T3772.$trModule :: GHC.Types.Module
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
T3772.$trModule =
GHC.Types.Module T3772.$trModule3 T3772.$trModule1
T3772.$trModule
= GHC.Types.Module T3772.$trModule3 T3772.$trModule1
T7865.$wexpensive [InlPrag=NOINLINE]
T7865.$wexpensive =
T7865.$wexpensive
expensive [InlPrag=INLINE[0]] :: Int -> Int
case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
expensive =
case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
case T7865.$wexpensive ww1 of ww2 { __DEFAULT ->
case T7865.$wexpensive ww1 of ww2 { __DEFAULT ->
expensive
case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
case T7865.$wexpensive ww1 of ww2 { __DEFAULT ->
case T7865.$wexpensive ww1 of ww2 { __DEFAULT ->
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