import {-# SOURCE #-} HsMatches ( pprMatches, pprMatch, Match )
import HsBinds ( HsBinds(..) )
-import HsBasic ( HsLit )
-import BasicTypes ( Fixity(..), FixityDirection(..) )
+import HsLit ( HsLit, HsOverLit )
+import BasicTypes ( Fixity(..) )
import HsTypes ( HsType )
-- others:
-import Name ( Name, isLexId )
+import Name ( Name, isLexSym )
import Outputable
import PprType ( pprType, pprParendType )
import Type ( Type )
-import Var ( TyVar, Id )
+import Var ( TyVar )
import DataCon ( DataCon )
+import CStrings ( CLabelString, pprCLabelString )
+import BasicTypes ( Boxity, tupleParens )
import SrcLoc ( SrcLoc )
\end{code}
\begin{code}
data HsExpr id pat
- = HsVar id -- variable
- | HsIPVar id -- implicit parameter
- | HsLit HsLit -- literal
- | HsLitOut HsLit -- TRANSLATION
- Type -- (with its type)
+ = HsVar id -- variable
+ | HsIPVar id -- implicit parameter
+ | HsOverLit (HsOverLit id) -- Overloaded literals; eliminated by type checker
+ | HsLit HsLit -- Simple (non-overloaded) literals
| HsLam (Match id pat) -- lambda
| HsApp (HsExpr id pat) -- application
-- They are eventually removed by the type checker.
| NegApp (HsExpr id pat) -- negated expr
- (HsExpr id pat) -- the negate id (in a HsVar)
+ id -- the negate id (in a HsVar)
| HsPar (HsExpr id pat) -- parenthesised expr
-- NB: Unit is ExplicitTuple []
-- for tuples, we can get the types
-- direct from the components
- Bool -- boxed?
+ Boxity
-- Record construction
(HsExpr id pat) -- (typechecked, of course)
(ArithSeqInfo id pat)
- | HsCCall FAST_STRING -- call into the C world; string is
+ | HsCCall CLabelString -- call into the C world; string is
[HsExpr id pat] -- the C function; exprs are the
-- arguments to pass.
Bool -- True <=> might cause Haskell
| HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
(HsExpr id pat) -- expr whose cost is to be measured
+
\end{code}
These constructors only appear temporarily in the parser.
(HsExpr id pat)
| ELazyPat (HsExpr id pat) -- ~ pattern
+
+ | HsType (HsType id) -- Explicit type argument; e.g f {| Int |} x y
\end{code}
Everything from here on appears only in typechecker output.
pprExpr e = pprDeeper (ppr_expr e)
pprBinds b = pprDeeper (ppr b)
-ppr_expr (HsVar v) = ppr v
-ppr_expr (HsIPVar v) = {- char '?' <> -} 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 (HsLit lit) = ppr lit
-ppr_expr (HsLitOut lit _) = ppr lit
+ppr_expr (HsIPVar v) = {- char '?' <> -} ppr v
+ppr_expr (HsLit lit) = ppr lit
+ppr_expr (HsOverLit lit) = ppr lit
ppr_expr (HsLam match)
= hsep [char '\\', nest 2 (pprMatch (True,empty) match)]
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
+ppr_expr (NegApp e _) = char '-' <+> pprParendExpr e
ppr_expr (HsPar e) = parens (ppr_expr e)
= hcat [ brackets (fsep (punctuate comma (map ppr_expr exprs))),
ifNotPprForUser ((<>) space (parens (pprType ty))) ]
-ppr_expr (ExplicitTuple exprs True)
- = parens (sep (punctuate comma (map ppr_expr exprs)))
-
-ppr_expr (ExplicitTuple exprs False)
- = ptext SLIT("(#") <> sep (punctuate comma (map ppr_expr exprs)) <> ptext SLIT("#)")
+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 (HsCCall fun args _ is_asm result_ty)
= hang (if is_asm
- then ptext SLIT("_casm_ ``") <> ptext fun <> ptext SLIT("''")
- else ptext SLIT("_ccall_") <+> ptext fun)
+ then ptext SLIT("_casm_ ``") <> pprCLabelString fun <> ptext SLIT("''")
+ else ptext SLIT("_ccall_") <+> pprCLabelString fun)
4 (sep (map pprParendExpr args))
ppr_expr (HsSCC lbl expr)
= hang (ppr_expr expr)
4 (brackets (interpp'SP dnames))
+ppr_expr (HsType id) = ppr id
+
\end{code}
Parenthesize unless very simple:
in
case expr of
HsLit l -> ppr l
- HsLitOut l _ -> ppr l
+ HsOverLit l -> ppr l
HsVar _ -> pp_as_was
HsIPVar _ -> pp_as_was
_ -> 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}
pp_rbinds thing rbinds
= hang thing
- 4 (braces (hsep (punctuate comma (map (pp_rbind) rbinds))))
+ 4 (braces (sep (punctuate comma (map (pp_rbind) rbinds))))
where
pp_rbind (v, e, pun_flag)
= getPprStyle $ \ sty ->