diff options
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 |