import HsImpExp ( isOperator )
-- others:
+import Name ( Name )
import ForeignCall ( Safety )
import Outputable
import PprType ( pprParendType )
-import Type ( Type )
+import Type ( Type )
import Var ( TyVar )
import DataCon ( DataCon )
import CStrings ( CLabelString, pprCLabelString )
-import BasicTypes ( Boxity, tupleParens )
+import BasicTypes ( IPName, Boxity, tupleParens )
import SrcLoc ( SrcLoc )
\end{code}
\begin{code}
data HsExpr id pat
= HsVar id -- variable
- | HsIPVar id -- implicit parameter
+ | HsIPVar (IPName id) -- implicit parameter
| HsOverLit HsOverLit -- Overloaded literals; eliminated by type checker
| HsLit HsLit -- Simple (non-overloaded) literals
-- They are eventually removed by the type checker.
| NegApp (HsExpr id pat) -- negated expr
+ Name -- Name of 'negate' (see RnEnv.lookupSyntaxName)
| HsPar (HsExpr id pat) -- parenthesised expr
(HsExpr id pat)
| HsWith (HsExpr id pat) -- implicit parameter binding
- [(id, HsExpr id pat)]
+ [(IPName id, HsExpr id pat)]
| HsDo HsDoContext
[Stmt id pat] -- "do":one or more stmts
| isOperator v = parens (ppr v)
| otherwise = ppr v
-ppr_expr (HsIPVar v) = char '?' <> ppr v
+ppr_expr (HsIPVar v) = ppr v
ppr_expr (HsLit lit) = ppr lit
ppr_expr (HsOverLit lit) = ppr lit
| 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)
hang (ptext SLIT("in")) 2 (ppr expr)]
ppr_expr (HsWith expr binds)
- = hsep [ppr expr, ptext SLIT("with"), ppr binds]
+ = hsep [ppr expr, ptext SLIT("with"), pp_ipbinds binds]
ppr_expr (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp stmts
ppr_expr (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp stmts
hsep [ppr v, char '=', ppr e]
\end{code}
+\begin{code}
+pp_ipbinds :: (Outputable id, Outputable pat)
+ => [(IPName id, HsExpr id pat)] -> SDoc
+pp_ipbinds pairs = hsep (punctuate semi (map pp_item pairs))
+ where
+ pp_item (id,rhs) = ppr id <+> equals <+> ppr_expr rhs
+\end{code}
%************************************************************************
\begin{code}
data Match id pat
= Match
- [id] -- Tyvars wrt which this match is universally quantified
- -- empty after typechecking
[pat] -- The patterns
(Maybe (HsType id)) -- A type signature for the result of the match
-- Nothing after typechecking
mkSimpleMatch :: [pat] -> HsExpr id pat -> Type -> SrcLoc -> Match id pat
mkSimpleMatch pats rhs rhs_ty locn
- = Match [] pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
+ = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
unguardedRHS :: HsExpr id pat -> SrcLoc -> [GRHS id pat]
unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc]
\begin{code}
getMatchLoc :: Match id pat -> SrcLoc
-getMatchLoc (Match _ _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
+getMatchLoc (Match _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
\end{code}
We know the list must have at least one @Match@ in it.
pprMatch :: (Outputable id, Outputable pat)
=> HsMatchContext id -> Match id pat -> SDoc
-pprMatch ctxt (Match _ pats maybe_ty grhss)
+pprMatch ctxt (Match pats maybe_ty grhss)
= pp_name ctxt <+> sep [sep (map ppr pats),
ppr_maybe_ty,
nest 2 (pprGRHSs ctxt grhss)]