X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsExpr.lhs;h=e484ad738ac1b69565c3cd152021aebf96683e26;hb=1f5e55804b97d2b9a77207d568d602ba88d8855d;hp=0ff1823befc2143f7ce83ef948c1b72b51e2b924;hpb=aadb64aa5644f2a3ad8a645e2c7a1e72c2f61e53;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs index 0ff1823..e484ad7 100644 --- a/ghc/compiler/hsSyn/HsExpr.lhs +++ b/ghc/compiler/hsSyn/HsExpr.lhs @@ -11,25 +11,58 @@ module HsExpr where -- friends: import HsDecls ( HsGroup ) import HsBinds ( HsBinds(..), nullBinds ) -import HsPat ( Pat ) -import HsLit ( HsLit, HsOverLit ) -import HsTypes ( HsType, PostTcType, SyntaxName ) +import HsPat ( Pat(..), HsConDetails(..) ) +import HsLit ( HsLit(..), HsOverLit ) +import HsTypes ( HsType, PostTcType, SyntaxName, placeHolderType ) import HsImpExp ( isOperator, pprHsVar ) -- others: -import ForeignCall ( Safety ) -import PprType ( pprParendType ) -import Type ( Type ) +import Type ( Type, pprParendType ) import Var ( TyVar, Id ) import Name ( Name ) import DataCon ( DataCon ) -import CStrings ( CLabelString, pprCLabelString ) import BasicTypes ( IPName, Boxity, tupleParens, Fixity(..) ) -import SrcLoc ( SrcLoc ) +import SrcLoc ( SrcLoc, generatedSrcLoc ) import Outputable import FastString \end{code} + +%************************************************************************ +%* * + Some useful helpers for constructing expressions +%* * +%************************************************************************ + +\begin{code} +mkHsApps f xs = foldl HsApp (HsVar f) xs +mkHsVarApps f xs = foldl HsApp (HsVar f) (map HsVar xs) + +mkHsIntLit n = HsLit (HsInt n) +mkHsString s = HsString (mkFastString s) + +mkConPat con vars = ConPatIn con (PrefixCon (map VarPat vars)) +mkNullaryConPat con = ConPatIn con (PrefixCon []) + +mkSimpleHsAlt :: Pat id -> HsExpr id -> Match id +-- A simple lambda with a single pattern, no binds, no guards; pre-typechecking +mkSimpleHsAlt pat expr + = mkSimpleMatch [pat] expr placeHolderType generatedSrcLoc + +mkSimpleMatch :: [Pat id] -> HsExpr id -> Type -> SrcLoc -> Match id +mkSimpleMatch pats rhs rhs_ty locn + = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty) + +unguardedRHS :: HsExpr id -> SrcLoc -> [GRHS id] +unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc] + +glueBindsOnGRHSs :: HsBinds id -> GRHSs id -> GRHSs id +glueBindsOnGRHSs EmptyBinds grhss = grhss +glueBindsOnGRHSs binds1 (GRHSs grhss binds2 ty) + = GRHSs grhss (binds1 `ThenBinds` binds2) ty +\end{code} + + %************************************************************************ %* * \subsection{Expressions proper} @@ -55,7 +88,7 @@ data HsExpr id | OpApp (HsExpr id) -- left operand (HsExpr id) -- operator - Fixity -- Renamer adds fixity; bottom until then + Fixity -- Renamer adds fixity; bottom until then (HsExpr id) -- right operand -- We preserve prefix negation and parenthesis for the precedence parser. @@ -83,19 +116,12 @@ data HsExpr id | HsLet (HsBinds id) -- let(rec) (HsExpr id) - | HsWith (HsExpr id) -- implicit parameter binding - [(IPName id, HsExpr id)] - Bool -- True <=> this was a 'with' binding - -- (tmp, until 'with' is removed) - | HsDo (HsStmtContext Name) -- The parameterisation is unimportant -- because in this context we never use - -- the FunRhs variant - [Stmt id] -- "do":one or more stmts - [id] -- Ids for [return,fail,>>=,>>] - -- Brutal but simple - -- Before type checking, used for rebindable syntax - PostTcType -- Type of the whole expression + -- the PatGuard or ParStmt variant + [Stmt id] -- "do":one or more stmts + (ReboundNames id) -- Ids for [return,fail,>>=,>>] + PostTcType -- Type of the whole expression SrcLoc | ExplicitList -- syntactic list @@ -147,22 +173,13 @@ data HsExpr id (HsExpr id) -- (typechecked, of course) (ArithSeqInfo id) - | HsCCall CLabelString -- call into the C world; string is - [HsExpr id] -- the C function; exprs are the - -- arguments to pass. - Safety -- True <=> might cause Haskell - -- garbage-collection (must generate - -- more paranoid code) - Bool -- True <=> it's really a "casm" - -- NOTE: this CCall is the *boxed* - -- version; the desugarer will convert - -- it into the unboxed "ccall#". - PostTcType -- The result type; will be *bottom* - -- until the typechecker gets ahold of it - | HsSCC FastString -- "set cost centre" (_scc_) annotation (HsExpr id) -- expr whose cost is to be measured + + | HsCoreAnn FastString -- hdaume: core annotation + (HsExpr id) + ----------------------------------------------------------- -- MetaHaskell Extensions | HsBracket (HsBracket id) SrcLoc @@ -173,6 +190,37 @@ data HsExpr id | HsSplice id (HsExpr id) SrcLoc -- $z or $(f 4) -- The id is just a unique name to -- identify this splice point + + ----------------------------------------------------------- + -- Arrow notation extension + + | HsProc (Pat id) -- arrow abstraction, proc + (HsCmdTop id) -- body of the abstraction + -- always has an empty stack + SrcLoc + + --------------------------------------- + -- The following are commands, not expressions proper + + | HsArrApp -- Arrow tail, or arrow application (f -< arg) + (HsExpr id) -- arrow expression, f + (HsExpr id) -- input expression, arg + PostTcType -- type of the arrow expressions f, + -- of the form a t t', where arg :: t + HsArrAppType -- higher-order (-<<) or first-order (-<) + Bool -- True => right-to-left (f -< arg) + -- False => left-to-right (arg >- f) + SrcLoc + + | HsArrForm -- Command formation, (| e cmd1 .. cmdn |) + (HsExpr id) -- the operator + -- after type-checking, a type abstraction to be + -- applied to the type of the local environment tuple + (Maybe Fixity) -- fixity (filled in by the renamer), for forms that + -- were converted from OpApp's by the renamer + [HsCmdTop id] -- argument commands + SrcLoc + \end{code} @@ -212,6 +260,22 @@ type PendingSplice = (Name, HsExpr Id) -- Typechecked splices, waiting to be -- pasted back in by the desugarer \end{code} +Table of bindings of names used in rebindable syntax. +This gets filled in by the renamer. + +\begin{code} +type ReboundNames id = [(Name, HsExpr id)] +-- * Before the renamer, this list is empty +-- +-- * After the renamer, it takes the form [(std_name, HsVar actual_name)] +-- For example, for the 'return' op of a monad +-- normal case: (GHC.Base.return, HsVar GHC.Base.return) +-- with rebindable syntax: (GHC.Base.return, return_22) +-- where return_22 is whatever "return" is in scope +-- +-- * After the type checker, it takes the form [(std_name, )] +-- where is the evidence for the method +\end{code} A @Dictionary@, unless of length 0 or 1, becomes a tuple. A @ClassDictLam dictvars methods expr@ is, therefore: @@ -239,7 +303,7 @@ ppr_expr (HsLam match) = pprMatch LambdaExpr match ppr_expr expr@(HsApp e1 e2) = let (fun, args) = collect_args expr [] in - (ppr_expr fun) <+> (sep (map ppr_expr args)) + (ppr_expr fun) <+> (sep (map pprParendExpr args)) where collect_args (HsApp fun arg) args = collect_args fun (arg:args) collect_args fun args = (fun, args) @@ -253,15 +317,10 @@ ppr_expr (OpApp e1 op fixity e2) pp_e2 = pprParendExpr e2 pp_prefixly - = hang (pprExpr op) 4 (sep [pp_e1, pp_e2]) + = hang (ppr_expr op) 4 (sep [pp_e1, pp_e2]) pp_infixly v - = sep [pp_e1, hsep [pp_v_op, pp_e2]] - where - ppr_v = ppr v - pp_v_op | isOperator ppr_v = ppr_v - | otherwise = char '`' <> ppr_v <> char '`' - -- Put it in backquotes if it's not an operator already + = sep [pp_e1, hsep [pprInfix v, pp_e2]] ppr_expr (NegApp e _) = char '-' <+> pprParendExpr e @@ -303,16 +362,12 @@ ppr_expr (HsIf e1 e2 e3 _) -- special case: let ... in let ... ppr_expr (HsLet binds expr@(HsLet _ _)) = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]), - pprExpr expr] + ppr_expr expr] ppr_expr (HsLet binds expr) = sep [hang (ptext SLIT("let")) 2 (pprBinds binds), hang (ptext SLIT("in")) 2 (ppr expr)] -ppr_expr (HsWith expr binds is_with) - = sep [hang (ptext SLIT("let")) 2 (pp_ipbinds 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) @@ -352,12 +407,6 @@ 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 ] @@ -393,6 +442,35 @@ 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 (HsProc pat (HsCmdTop cmd _ _ _) _) + = hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), pprExpr cmd] + +ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True _) + = hsep [ppr_expr arrow, ptext SLIT("-<"), ppr_expr arg] +ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False _) + = hsep [ppr_expr arg, ptext SLIT(">-"), ppr_expr arrow] +ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True _) + = hsep [ppr_expr arrow, ptext SLIT("-<<"), ppr_expr arg] +ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False _) + = hsep [ppr_expr arg, ptext SLIT(">>-"), ppr_expr 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("(|") <> ppr_expr op) + 4 (sep (map pprCmdArg args) <> ptext SLIT("|)")) + +pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc +pprCmdArg (HsCmdTop cmd@(HsArrForm _ Nothing [] _) _ _ _) = ppr_expr cmd +pprCmdArg (HsCmdTop cmd _ _ _) = parens (ppr_expr 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 @@ -405,20 +483,89 @@ pprParendExpr :: OutputableBndr id => HsExpr id -> SDoc pprParendExpr expr = let - pp_as_was = pprExpr expr + pp_as_was = ppr_expr expr + -- Using ppr_expr here avoids the call to 'deeper' + -- Not sure if that's always right. in case expr of - HsLit l -> ppr l - HsOverLit l -> ppr l + HsLit l -> ppr l + HsOverLit l -> ppr l + + HsVar _ -> pp_as_was + HsIPVar _ -> pp_as_was + ExplicitList _ _ -> pp_as_was + ExplicitPArr _ _ -> pp_as_was + ExplicitTuple _ _ -> pp_as_was + HsPar _ -> pp_as_was + + _ -> parens pp_as_was +\end{code} - HsVar _ -> pp_as_was - HsIPVar _ -> pp_as_was - ExplicitList _ _ -> pp_as_was - ExplicitPArr _ _ -> pp_as_was - ExplicitTuple _ _ -> pp_as_was - HsPar _ -> pp_as_was +%************************************************************************ +%* * +\subsection{Commands (in arrow abstractions)} +%* * +%************************************************************************ + +We re-use HsExpr to represent these. - _ -> parens pp_as_was +\begin{code} +type HsCmd id = HsExpr id + +data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp +\end{code} + +The legal constructors for commands are: + + = HsArrApp ... -- as above + + | HsArrForm ... -- as above + + | HsApp (HsCmd id) + (HsExpr id) + + | HsLam (Match id) -- kappa + + -- the renamer turns this one into HsArrForm + | OpApp (HsExpr id) -- left operand + (HsCmd id) -- operator + Fixity -- Renamer adds fixity; bottom until then + (HsCmd id) -- right operand + + | HsPar (HsCmd id) -- parenthesised command + + | HsCase (HsExpr id) + [Match id] -- bodies are HsCmd's + SrcLoc + + | HsIf (HsExpr id) -- predicate + (HsCmd id) -- then part + (HsCmd id) -- else part + SrcLoc + + | HsLet (HsBinds id) -- let(rec) + (HsCmd id) + + | HsDo (HsStmtContext Name) -- The parameterisation is unimportant + -- because in this context we never use + -- the PatGuard or ParStmt variant + [Stmt id] -- HsExpr's are really HsCmd's + (ReboundNames id) + PostTcType -- Type of the whole expression + SrcLoc + +Top-level command, introducing a new arrow. +This may occur inside a proc (where the stack is empty) or as an +argument of a command-forming operator. + +\begin{code} +data HsCmdTop id + = HsCmdTop (HsCmd id) + [PostTcType] -- types of inputs on the command's stack + PostTcType -- return type of the command + (ReboundNames id) + -- after type checking: + -- names used in the command's desugaring \end{code} %************************************************************************ @@ -442,12 +589,6 @@ pp_rbinds thing rbinds pp_rbind (v, e) = hsep [pprBndr LetBind v, char '=', ppr e] \end{code} -\begin{code} -pp_ipbinds :: OutputableBndr id => [(IPName id, HsExpr id)] -> SDoc -pp_ipbinds pairs = hsep (punctuate semi (map pp_item pairs)) - where - pp_item (id,rhs) = pprBndr LetBind id <+> equals <+> ppr_expr rhs -\end{code} %************************************************************************ @@ -488,13 +629,6 @@ data GRHSs id data GRHS id = GRHS [Stmt id] -- The RHS is the final ResultStmt SrcLoc - -mkSimpleMatch :: [Pat id] -> HsExpr id -> Type -> SrcLoc -> Match id -mkSimpleMatch pats rhs rhs_ty locn - = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty) - -unguardedRHS :: HsExpr id -> SrcLoc -> [GRHS id] -unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc] \end{code} @getMatchLoc@ takes a @Match@ and returns the @@ -577,21 +711,25 @@ data Stmt id -- The type is the *element type* of the expression -- ParStmts only occur in a list comprehension - | ParStmt [[Stmt id]] -- List comp only: parallel set of quals - | ParStmtOut [([id], [Stmt id])] -- PLC after renaming; the ids are the binders - -- bound by the stmts - - -- mdo-notation (only exists after renamer) - -- The ids are a subset of the variables bound by the stmts that - -- either (a) are used before they are bound in the stmts - -- or (b) are used in stmts that follow the RecStmt - | RecStmt [id] - [Stmt id] - [HsExpr id] -- Post type-checking only; these expressions correspond - -- 1-to-1 with the [id], and are the expresions that should - -- be returned by the recursion. They may not quite be the - -- Ids themselves, because the Id may be polymorphic, but - -- the returned thing has to be monomorphic. + | ParStmt [([Stmt id], [id])] -- After remaing, the ids are the binders + -- bound by the stmts and used subsequently + + -- Recursive statement + | RecStmt [Stmt id] + --- The next two fields are only valid after renaming + [id] -- The ids are a subset of the variables bound by the stmts + -- that are used in stmts that follow the RecStmt + + [id] -- Ditto, but these variables are the "recursive" ones, that + -- are used before they are bound in the stmts of the RecStmt + -- From a type-checking point of view, these ones have to be monomorphic + + --- This field is only valid after typechecking + [HsExpr id] -- These expressions correspond + -- 1-to-1 with the "recursive" [id], and are the expresions that + -- should be returned by the recursion. They may not quite be the + -- Ids themselves, because the Id may be *polymorphic*, but + -- the returned thing has to be *monomorphic*. \end{code} ExprStmts and ResultStmts are a bit tricky, because what they mean @@ -641,15 +779,12 @@ consLetStmt binds stmts = LetStmt binds : stmts instance OutputableBndr id => Outputable (Stmt id) where ppr stmt = pprStmt stmt -pprStmt (BindStmt pat expr _) = hsep [ppr pat, ptext SLIT("<-"), ppr expr] -pprStmt (LetStmt binds) = hsep [ptext SLIT("let"), pprBinds binds] -pprStmt (ExprStmt expr _ _) = ppr expr -pprStmt (ResultStmt expr _) = ppr expr -pprStmt (ParStmt stmtss) - = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss) -pprStmt (ParStmtOut stmtss) - = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss) -pprStmt (RecStmt _ segment _) = vcat (map ppr segment) +pprStmt (BindStmt pat expr _) = hsep [ppr pat, ptext SLIT("<-"), ppr expr] +pprStmt (LetStmt binds) = hsep [ptext SLIT("let"), pprBinds binds] +pprStmt (ExprStmt expr _ _) = ppr expr +pprStmt (ResultStmt expr _) = ppr expr +pprStmt (ParStmt stmtss) = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss) +pprStmt (RecStmt segment _ _ _) = ptext SLIT("rec") <+> braces (vcat (map ppr segment)) pprDo :: OutputableBndr id => HsStmtContext any -> [Stmt id] -> SDoc pprDo DoExpr stmts = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts)) @@ -673,10 +808,11 @@ pprComp brack stmts = brack $ %************************************************************************ \begin{code} -data HsBracket id = ExpBr (HsExpr id) - | PatBr (Pat id) - | DecBr (HsGroup id) - | TypBr (HsType id) +data HsBracket id = ExpBr (HsExpr id) -- [| expr |] + | PatBr (Pat id) -- [p| pat |] + | DecBr (HsGroup id) -- [d| decls |] + | TypBr (HsType id) -- [t| type |] + | VarBr id -- 'x, ''T instance OutputableBndr id => Outputable (HsBracket id) where ppr = pprHsBracket @@ -686,7 +822,11 @@ pprHsBracket (ExpBr e) = thBrackets empty (ppr e) pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p) pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d) pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t) - +pprHsBracket (VarBr n) = char '\'' <> ppr n + -- Infelicity: can't show ' vs '', because + -- we can't ask n what its OccName is, because the + -- pretty-printer for HsExpr doesn't ask for NamedThings + -- But the pretty-printer for names will show the OccName class thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+> pp_body <+> ptext SLIT("|]") @@ -733,6 +873,7 @@ data HsMatchContext id -- Context of a Match = FunRhs id -- Function binding for f | CaseAlt -- Guard on a case alternative | LambdaExpr -- Pattern of a lambda + | ProcExpr -- Pattern of a proc | PatBindRhs -- Pattern binding | RecUpd -- Record update [used only in DsExpr to tell matchWrapper -- what sort of runtime error message to generate] @@ -745,6 +886,7 @@ data HsStmtContext id | MDoExpr -- Recursive do-expression | PArrComp -- Parallel array comprehension | PatGuard (HsMatchContext id) -- Pattern guard for specified thing + | ParStmtCtxt (HsStmtContext id) -- A branch of a parallel stmt \end{code} \begin{code} @@ -758,6 +900,7 @@ isDoExpr other = False matchSeparator (FunRhs _) = ptext SLIT("=") matchSeparator CaseAlt = ptext SLIT("->") matchSeparator LambdaExpr = ptext SLIT("->") +matchSeparator ProcExpr = ptext SLIT("->") matchSeparator PatBindRhs = ptext SLIT("=") matchSeparator (StmtCtxt _) = ptext SLIT("<-") matchSeparator RecUpd = panic "unused" @@ -769,14 +912,17 @@ pprMatchContext CaseAlt = ptext SLIT("a case alternative") pprMatchContext RecUpd = ptext SLIT("a record-update construct") pprMatchContext PatBindRhs = ptext SLIT("a pattern binding") pprMatchContext LambdaExpr = ptext SLIT("a lambda abstraction") +pprMatchContext ProcExpr = ptext SLIT("an arrow abstraction") pprMatchContext (StmtCtxt ctxt) = ptext SLIT("a pattern binding in") $$ pprStmtContext ctxt pprMatchRhsContext (FunRhs fun) = ptext SLIT("a right-hand side of function") <+> quotes (ppr fun) pprMatchRhsContext CaseAlt = ptext SLIT("the body of a case alternative") pprMatchRhsContext PatBindRhs = ptext SLIT("the right-hand side of a pattern binding") pprMatchRhsContext LambdaExpr = ptext SLIT("the body of a lambda") +pprMatchRhsContext ProcExpr = ptext SLIT("the body of a proc") pprMatchRhsContext RecUpd = panic "pprMatchRhsContext" +pprStmtContext (ParStmtCtxt c) = sep [ptext SLIT("a parallel branch of"), pprStmtContext c] pprStmtContext (PatGuard ctxt) = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt pprStmtContext DoExpr = ptext SLIT("a 'do' expression") pprStmtContext MDoExpr = ptext SLIT("an 'mdo' expression") @@ -791,14 +937,16 @@ pprStmtResultContext other = ptext SLIT("the result of") <+> pprStmtContext -- Used to generate the string for a *runtime* error message -matchContextErrString (FunRhs fun) = "function " ++ showSDoc (ppr fun) -matchContextErrString CaseAlt = "case" -matchContextErrString PatBindRhs = "pattern binding" -matchContextErrString RecUpd = "record update" -matchContextErrString LambdaExpr = "lambda" -matchContextErrString (StmtCtxt (PatGuard _)) = "pattern gaurd" -matchContextErrString (StmtCtxt DoExpr) = "'do' expression" -matchContextErrString (StmtCtxt MDoExpr) = "'mdo' expression" -matchContextErrString (StmtCtxt ListComp) = "list comprehension" -matchContextErrString (StmtCtxt PArrComp) = "array comprehension" +matchContextErrString (FunRhs fun) = "function " ++ showSDoc (ppr fun) +matchContextErrString CaseAlt = "case" +matchContextErrString PatBindRhs = "pattern binding" +matchContextErrString RecUpd = "record update" +matchContextErrString LambdaExpr = "lambda" +matchContextErrString ProcExpr = "proc" +matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c) +matchContextErrString (StmtCtxt (PatGuard _)) = "pattern guard" +matchContextErrString (StmtCtxt DoExpr) = "'do' expression" +matchContextErrString (StmtCtxt MDoExpr) = "'mdo' expression" +matchContextErrString (StmtCtxt ListComp) = "list comprehension" +matchContextErrString (StmtCtxt PArrComp) = "array comprehension" \end{code}