diff options
author | klebinger.andreas@gmx.at <klebinger.andreas@gmx.at> | 2019-04-16 00:36:26 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-04-19 23:38:16 -0400 |
commit | fcef26b62569428d47e96fcd8946a733540783ab (patch) | |
tree | d74cf53aa40b42e7f3d5cd5e4d709752fb5faa25 /compiler | |
parent | eb2a4df84cd7d66bb27f8ccb08ef10d5c984e892 (diff) | |
download | haskell-fcef26b62569428d47e96fcd8946a733540783ab.tar.gz |
Don't indent single alternative case expressions for STG.
Makes the width of STG dumps slightly saner.
Especially for things like unboxing.
Fixes #16580
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/stgSyn/StgSyn.hs | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs index 2f3148cfeb..3a6cf3f133 100644 --- a/compiler/stgSyn/StgSyn.hs +++ b/compiler/stgSyn/StgSyn.hs @@ -831,18 +831,31 @@ pprStgExpr (StgTick tickish expr) else sep [ ppr tickish, pprStgExpr expr ] +-- Don't indent for a single case alternative. +pprStgExpr (StgCase expr bndr alt_type [alt]) + = sep [sep [text "case", + nest 4 (hsep [pprStgExpr expr, + whenPprDebug (dcolon <+> ppr alt_type)]), + text "of", pprBndr CaseBind bndr, char '{'], + pprStgAlt False alt, + char '}'] + pprStgExpr (StgCase expr bndr alt_type alts) = sep [sep [text "case", nest 4 (hsep [pprStgExpr expr, whenPprDebug (dcolon <+> ppr alt_type)]), text "of", pprBndr CaseBind bndr, char '{'], - nest 2 (vcat (map pprStgAlt alts)), + nest 2 (vcat (map (pprStgAlt True) alts)), char '}'] -pprStgAlt :: OutputablePass pass => GenStgAlt pass -> SDoc -pprStgAlt (con, params, expr) - = hang (hsep [ppr con, sep (map (pprBndr CasePatBind) params), text "->"]) - 4 (ppr expr <> semi) + +pprStgAlt :: OutputablePass pass => Bool -> GenStgAlt pass -> SDoc +pprStgAlt indent (con, params, expr) + | indent = hang altPattern 4 (ppr expr <> semi) + | otherwise = sep [altPattern, ppr expr <> semi] + where + altPattern = (hsep [ppr con, sep (map (pprBndr CasePatBind) params), text "->"]) + pprStgOp :: StgOp -> SDoc pprStgOp (StgPrimOp op) = ppr op |