HsExpr: Abstract Haskell syntax: expressions
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module HsExpr where
#include "HsVersions.h"
-- a place-holder before typechecking
-- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprFunBind :: (OutputableBndr id) => id -> MatchGroup id -> SDoc
-pprFunBind fun matches = pprMatches (FunRhs fun) matches
+pprFunBind :: (OutputableBndr id) => id -> Bool -> MatchGroup id -> SDoc
+pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
-- Exported to HsBinds, which can't see the defn of HsMatchContext
pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
pprMatch :: OutputableBndr id => HsMatchContext id -> Match id -> SDoc
pprMatch ctxt (Match pats maybe_ty grhss)
- = pp_name ctxt <+> sep [sep (map ppr pats),
- ppr_maybe_ty,
- nest 2 (pprGRHSs ctxt grhss)]
+ = herald <+> sep [sep (map ppr other_pats),
+ ppr_maybe_ty,
+ nest 2 (pprGRHSs ctxt grhss)]
where
- pp_name (FunRhs fun) = ppr fun -- Not pprBndr; the AbsBinds will
- -- have printed the signature
- pp_name LambdaExpr = char '\\'
- pp_name other = empty
+ (herald, other_pats)
+ = case ctxt of
+ FunRhs fun is_infix
+ | not is_infix -> (ppr fun, pats)
+ -- f x y z = e
+ -- Not pprBndr; the AbsBinds will
+ -- have printed the signature
+
+ | null pats3 -> (pp_infix, [])
+ -- x &&& y = e
+
+ | otherwise -> (parens pp_infix, pats3)
+ -- (x &&& y) z = e
+ where
+ (pat1:pat2:pats3) = pats
+ pp_infix = ppr pat1 <+> ppr fun <+> ppr pat2
+
+ LambdaExpr -> (char '\\', pats)
+ other -> (empty, pats)
ppr_maybe_ty = case maybe_ty of
Just ty -> dcolon <+> ppr ty
\begin{code}
data HsMatchContext id -- Context of a Match
- = FunRhs id -- Function binding for f
+ = FunRhs id Bool -- Function binding for f; True <=> written infix
| CaseAlt -- Guard on a case alternative
| LambdaExpr -- Pattern of a lambda
| ProcExpr -- Pattern of a proc
\end{code}
\begin{code}
-matchSeparator (FunRhs _) = ptext SLIT("=")
+matchSeparator (FunRhs {}) = ptext SLIT("=")
matchSeparator CaseAlt = ptext SLIT("->")
matchSeparator LambdaExpr = ptext SLIT("->")
matchSeparator ProcExpr = ptext SLIT("->")
\end{code}
\begin{code}
-pprMatchContext (FunRhs fun) = ptext SLIT("the definition of") <+> quotes (ppr fun)
+pprMatchContext (FunRhs fun _) = ptext SLIT("the definition of") <+> quotes (ppr fun)
pprMatchContext CaseAlt = ptext SLIT("a case alternative")
pprMatchContext RecUpd = ptext SLIT("a record-update construct")
pprMatchContext PatBindRhs = ptext SLIT("a pattern binding")
-}
-- Used to generate the string for a *runtime* error message
-matchContextErrString (FunRhs fun) = "function " ++ showSDoc (ppr fun)
+matchContextErrString (FunRhs fun _) = "function " ++ showSDoc (ppr fun)
matchContextErrString CaseAlt = "case"
matchContextErrString PatBindRhs = "pattern binding"
matchContextErrString RecUpd = "record update"