From 0174be833bd12450a254e7367d1ae1fc92e026eb Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 17 Jul 2000 11:28:00 +0000
Subject: [PATCH] [project @ 2000-07-17 11:28:00 by simonpj] Print operator
names in HsExpr better
---
ghc/compiler/hsSyn/HsExpr.lhs | 26 +++++++++++++++++---------
1 file changed, 17 insertions(+), 9 deletions(-)
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index fb4429dba033..d431859400d7 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -17,7 +17,7 @@ import BasicTypes ( Fixity(..), FixityDirection(..) )
import HsTypes ( HsType )
-- others:
-import Name ( Name, isLexId )
+import Name ( Name, isLexSym )
import Outputable
import PprType ( pprType, pprParendType )
import Type ( Type )
@@ -211,7 +211,11 @@ pprExpr :: (Outputable id, Outputable pat)
pprExpr e = pprDeeper (ppr_expr e)
pprBinds b = pprDeeper (ppr b)
-ppr_expr (HsVar v) = ppr v
+ppr_expr (HsVar v)
+ -- Put it in parens if it's an operator
+ | isOperator v = parens (ppr v)
+ | otherwise = ppr v
+
ppr_expr (HsIPVar v) = {- char '?' <> -} ppr v
ppr_expr (HsLit lit) = ppr lit
@@ -241,13 +245,9 @@ ppr_expr (OpApp e1 op fixity e2)
pp_infixly v
= sep [pp_e1, hsep [pp_v_op, pp_e2]]
where
- pp_v = ppr v
- pp_v_op | isLexId (_PK_ (showSDoc pp_v)) = char '`' <> pp_v <> char '`'
- | otherwise = pp_v
- -- Put it in backquotes if it's not an operator already
- -- We use (showSDoc pp_v), rather than isSymOcc (getOccName v) simply so
- -- that we don't need NamedThing in the context of all these funcions.
- -- Gruesome, but simple.
+ pp_v_op | isOperator v = ppr v
+ | otherwise = char '`' <> ppr v <> char '`'
+ -- Put it in backquotes if it's not an operator already
ppr_expr (NegApp e _)
= char '-' <+> pprParendExpr e
@@ -390,6 +390,14 @@ pprParendExpr expr
_ -> parens pp_as_was
\end{code}
+\begin{code}
+isOperator :: Outputable a => a -> Bool
+isOperator v = isLexSym (_PK_ (showSDoc (ppr v)))
+ -- We use (showSDoc (ppr v)), rather than isSymOcc (getOccName v) simply so
+ -- that we don't need NamedThing in the context of all these functions.
+ -- Gruesome, but simple.
+\end{code}
+
%************************************************************************
%* *
\subsection{Record binds}
--
GitLab