-pprExpr sty (HsLet binds expr@(HsLet _ _))
- = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
- ppr sty expr]
-
-pprExpr sty (HsLet binds expr)
- = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
- ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
-
-pprExpr sty (HsDo stmts _)
- = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
-pprExpr sty (HsDoOut stmts _ _ _)
- = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
-
-pprExpr sty (ListComp expr quals)
- = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
- 4 (ppSep [interpp'SP sty quals, ppRbrack])
-
-pprExpr sty (ExplicitList exprs)
- = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
-pprExpr sty (ExplicitListOut ty exprs)
- = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
- ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
-
-pprExpr sty (ExplicitTuple exprs)
- = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
-
-pprExpr sty (RecordCon con rbinds)
- = pp_rbinds sty (ppr sty con) rbinds
-
-pprExpr sty (RecordUpd aexp rbinds)
- = pp_rbinds sty (pprParendExpr sty aexp) rbinds
-pprExpr sty (RecordUpdOut aexp _ rbinds)
- = pp_rbinds sty (pprParendExpr sty aexp) rbinds
-
-pprExpr sty (ExprWithTySig expr sig)
- = ppHang (ppBeside (ppNest 2 (pprExpr sty expr)) (ppPStr SLIT(" ::")))
- 4 (ppr sty sig)
-
-pprExpr sty (ArithSeqIn info)
- = ppBracket (ppr sty info)
-pprExpr sty (ArithSeqOut expr info)
- = case sty of
- PprForUser ->
- ppBracket (ppr sty info)
- _ ->
- ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
-
-pprExpr sty (CCall fun args _ is_asm result_ty)
- = ppHang (if is_asm
- then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
- else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
- 4 (ppSep (map (pprParendExpr sty) args))
-
-pprExpr sty (HsSCC label expr)
- = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
- pprParendExpr sty expr ]
-
-pprExpr sty (TyLam tyvars expr)
- = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
- 4 (pprExpr sty expr)
-
-pprExpr sty (TyApp expr [ty])
- = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
-
-pprExpr sty (TyApp expr tys)
- = ppHang (pprExpr sty expr)
- 4 (ppBracket (interpp'SP sty tys))
-
-pprExpr sty (DictLam dictvars expr)
- = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
- 4 (pprExpr sty expr)
-
-pprExpr sty (DictApp expr [dname])
- = ppHang (pprExpr sty expr) 4 (ppr sty dname)
-
-pprExpr sty (DictApp expr dnames)
- = ppHang (pprExpr sty expr)
- 4 (ppBracket (interpp'SP sty dnames))
-
-pprExpr sty (ClassDictLam dicts methods expr)
- = ppHang (ppCat [ppStr "\\{-classdict-}",
- ppBracket (interppSP sty dicts),
- ppBracket (interppSP sty methods),
- ppStr "->"])
- 4 (pprExpr sty expr)
-
-pprExpr sty (Dictionary dicts methods)
- = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
- ppBracket (interpp'SP sty dicts),
- ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
-
-pprExpr sty (SingleDict dname)
- = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
-
+ppr_expr (HsLet binds expr@(HsLet _ _))
+ = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]),
+ pprExpr expr]
+
+ppr_expr (HsLet binds expr)
+ = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
+ hang (ptext SLIT("in")) 2 (ppr expr)]
+
+ppr_expr (HsDo do_or_list_comp stmts _ _ _) = pprDo do_or_list_comp stmts
+
+ppr_expr (ExplicitList _ exprs)
+ = brackets (fsep (punctuate comma (map ppr_expr exprs)))
+
+ppr_expr (ExplicitPArr _ exprs)
+ = pa_brackets (fsep (punctuate comma (map ppr_expr exprs)))
+
+ppr_expr (ExplicitTuple exprs boxity)
+ = tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
+
+ppr_expr (RecordCon con_id rbinds)
+ = pp_rbinds (ppr con_id) rbinds
+ppr_expr (RecordConOut data_con con rbinds)
+ = pp_rbinds (ppr con) rbinds
+
+ppr_expr (RecordUpd aexp rbinds)
+ = pp_rbinds (pprParendExpr aexp) rbinds
+ppr_expr (RecordUpdOut aexp _ _ rbinds)
+ = pp_rbinds (pprParendExpr aexp) rbinds
+
+ppr_expr (ExprWithTySig expr sig)
+ = hang (nest 2 (ppr_expr expr) <+> dcolon)
+ 4 (ppr sig)
+
+ppr_expr (ArithSeqIn info)
+ = brackets (ppr info)
+ppr_expr (ArithSeqOut expr info)
+ = brackets (ppr info)
+
+ppr_expr (PArrSeqIn info)
+ = pa_brackets (ppr info)
+ppr_expr (PArrSeqOut expr info)
+ = pa_brackets (ppr info)
+
+ppr_expr EWildPat = char '_'
+ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
+ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
+
+ppr_expr (HsCCall fun args _ is_asm result_ty)
+ = hang (if is_asm
+ then ptext SLIT("_casm_ ``") <> pprCLabelString fun <> ptext SLIT("''")
+ else ptext SLIT("_ccall_") <+> pprCLabelString fun)
+ 4 (sep (map pprParendExpr args))
+
+ppr_expr (HsSCC lbl expr)
+ = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
+
+ppr_expr (TyLam tyvars expr)
+ = hang (hsep [ptext SLIT("/\\"),
+ hsep (map (pprBndr LambdaBind) tyvars),
+ ptext SLIT("->")])
+ 4 (ppr_expr expr)
+
+ppr_expr (TyApp expr [ty])
+ = hang (ppr_expr expr) 4 (pprParendType ty)
+
+ppr_expr (TyApp expr tys)
+ = hang (ppr_expr expr)
+ 4 (brackets (interpp'SP tys))
+
+ppr_expr (DictLam dictvars expr)
+ = hang (hsep [ptext SLIT("\\{-dict-}"),
+ hsep (map (pprBndr LambdaBind) dictvars),
+ ptext SLIT("->")])
+ 4 (ppr_expr expr)
+
+ppr_expr (DictApp expr [dname])
+ = hang (ppr_expr expr) 4 (ppr dname)
+
+ppr_expr (DictApp expr dnames)
+ = hang (ppr_expr expr)
+ 4 (brackets (interpp'SP dnames))
+
+ppr_expr (HsType id) = ppr id
+
+ppr_expr (HsSplice n e _) = char '$' <> brackets (ppr n) <> pprParendExpr e
+ppr_expr (HsBracket b _) = pprHsBracket b
+ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("where") <+> ppr ps
+ppr_expr (HsReify r) = ppr r
+
+ppr_expr (HsProc pat (HsCmdTop cmd _ _ _) _)
+ = hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), pprExpr cmd]
+
+ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True _)
+ = hsep [pprExpr arrow, ptext SLIT("-<"), pprExpr arg]
+ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False _)
+ = hsep [pprExpr arg, ptext SLIT(">-"), pprExpr arrow]
+ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True _)
+ = hsep [pprExpr arrow, ptext SLIT("-<<"), pprExpr arg]
+ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False _)
+ = hsep [pprExpr arg, ptext SLIT(">>-"), pprExpr arrow]
+
+ppr_expr (HsArrForm (HsVar v) (Just _) [arg1, arg2] _)
+ = sep [pprCmdArg arg1, hsep [pprInfix v, pprCmdArg arg2]]
+ppr_expr (HsArrForm op _ args _)
+ = hang (ptext SLIT("(|") <> pprExpr op)
+ 4 (sep (map pprCmdArg args) <> ptext SLIT("|)"))
+
+pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
+pprCmdArg (HsCmdTop cmd@(HsArrForm _ Nothing [] _) _ _ _) = pprExpr cmd
+pprCmdArg (HsCmdTop cmd _ _ _) = parens (pprExpr cmd)
+
+-- Put a var in backquotes if it's not an operator already
+pprInfix :: Outputable name => name -> SDoc
+pprInfix v | isOperator ppr_v = ppr_v
+ | otherwise = char '`' <> ppr_v <> char '`'
+ where
+ ppr_v = ppr v
+
+-- add parallel array brackets around a document
+--
+pa_brackets :: SDoc -> SDoc
+pa_brackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")