| SectionR (LHsExpr id) -- operator
(LHsExpr id) -- operand
+ | ExplicitTuple -- Used for explicit tuples and sections thereof
+ [HsTupArg id]
+ Boxity
+
| HsCase (LHsExpr id)
(MatchGroup id)
PostTcType -- type of elements of the parallel array
[LHsExpr id]
- | ExplicitTuple -- tuple
- [LHsExpr id]
- -- NB: Unit is ExplicitTuple []
- -- for tuples, we can get the types
- -- direct from the components
- Boxity
-
-
-- Record construction
| RecordCon (Located id) -- The constructor. After type checking
-- it's the dataConWrapId of the constructor
| HsWrap HsWrapper -- TRANSLATION
(HsExpr id)
+-- HsTupArg is used for tuple sections
+-- (,a,) is represented by ExplicitTuple [Mising ty1, Present a, Missing ty3]
+-- Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
+data HsTupArg id
+ = Present (LHsExpr id) -- The argument
+ | Missing PostTcType -- The argument is missing, but this is its type
+
+tupArgPresent :: HsTupArg id -> Bool
+tupArgPresent (Present {}) = True
+tupArgPresent (Missing {}) = False
+
type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
-- pasted back in by the desugarer
\end{code}
pp_infixly v
= (sep [pprHsInfix v, pp_expr])
+ppr_expr (ExplicitTuple exprs boxity)
+ = tupleParens boxity (fcat (ppr_tup_args exprs))
+ where
+ ppr_tup_args [] = []
+ ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
+ ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
+
+ punc (Present {} : _) = comma <> space
+ punc (Missing {} : _) = comma
+ punc [] = empty
+
--avoid using PatternSignatures for stage1 code portability
ppr_expr exprType@(HsLam matches)
= pprMatches (LambdaExpr `asTypeOf` idType exprType) matches
ppr_expr (ExplicitPArr _ exprs)
= pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
-ppr_expr (ExplicitTuple exprs boxity)
- = tupleParens boxity (sep (punctuate comma (map ppr_lexpr exprs)))
-
ppr_expr (RecordCon con_id _ rbinds)
= hang (ppr con_id) 2 (ppr rbinds)
= hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
ppr_expr (HsTick tickId vars exp)
- = hcat [ptext (sLit "tick<"),
- ppr tickId,
- ptext (sLit ">("),
- hsep (map pprHsVar vars),
- ppr exp,
- ptext (sLit ")")]
+ = pprTicks (ppr exp) $
+ hcat [ptext (sLit "tick<"),
+ ppr tickId,
+ ptext (sLit ">("),
+ hsep (map pprHsVar vars),
+ ppr exp,
+ ptext (sLit ")")]
ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
- = hcat [ptext (sLit "bintick<"),
+ = pprTicks (ppr exp) $
+ hcat [ptext (sLit "bintick<"),
ppr tickIdTrue,
ptext (sLit ","),
ppr tickIdFalse,
ptext (sLit ">("),
ppr exp,ptext (sLit ")")]
ppr_expr (HsTickPragma externalSrcLoc exp)
- = hcat [ptext (sLit "tickpragma<"),
+ = pprTicks (ppr exp) $
+ hcat [ptext (sLit "tickpragma<"),
ppr externalSrcLoc,
ptext (sLit ">("),
ppr exp,
-- I think that is usually (always?) right
in
case unLoc expr of
- HsLit _ -> pp_as_was
- HsOverLit _ -> pp_as_was
- HsVar _ -> pp_as_was
- HsIPVar _ -> pp_as_was
- ExplicitList _ _ -> pp_as_was
- ExplicitPArr _ _ -> pp_as_was
- ExplicitTuple _ _ -> pp_as_was
- HsPar _ -> pp_as_was
- HsBracket _ -> pp_as_was
- HsBracketOut _ [] -> pp_as_was
+ ArithSeq {} -> pp_as_was
+ PArrSeq {} -> pp_as_was
+ HsLit {} -> pp_as_was
+ HsOverLit {} -> pp_as_was
+ HsVar {} -> pp_as_was
+ HsIPVar {} -> pp_as_was
+ ExplicitTuple {} -> pp_as_was
+ ExplicitList {} -> pp_as_was
+ ExplicitPArr {} -> pp_as_was
+ HsPar {} -> pp_as_was
+ HsBracket {} -> pp_as_was
+ HsBracketOut _ [] -> pp_as_was
HsDo sc _ _ _
| isListCompExpr sc -> pp_as_was
_ -> parens pp_as_was
pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
pprMatch ctxt (Match pats maybe_ty grhss)
- = herald <+> sep [sep (map ppr other_pats),
+ = herald <+> sep [sep (map pprParendLPat other_pats),
ppr_maybe_ty,
nest 2 (pprGRHSs ctxt grhss)]
where
-- Not pprBndr; the AbsBinds will
-- have printed the signature
- | null pats3 -> (pp_infix, [])
+ | null pats2 -> (pp_infix, [])
-- x &&& y = e
- | otherwise -> (parens pp_infix, pats3)
+ | otherwise -> (parens pp_infix, pats2)
-- (x &&& y) z = e
where
- (pat1:pat2:pats3) = pats
- pp_infix = ppr pat1 <+> ppr fun <+> ppr pat2
+ pp_infix = pprParendLPat pat1 <+> ppr fun <+> pprParendLPat pat2
LambdaExpr -> (char '\\', pats)
- _ -> (empty, pats)
+
+ _ -> ASSERT( null pats1 )
+ (ppr pat1, []) -- No parens around the single pat
+ (pat1:pats1) = pats
+ (pat2:pats2) = pats1
ppr_maybe_ty = case maybe_ty of
Just ty -> dcolon <+> ppr ty
Nothing -> empty
=> HsMatchContext idL -> GRHSs idR -> SDoc
pprGRHSs ctxt (GRHSs grhss binds)
= vcat (map (pprGRHS ctxt . unLoc) grhss)
- $$ if isEmptyLocalBinds binds then empty
- else text "where" $$ nest 4 (pprBinds binds)
+ $$ ppUnless (isEmptyLocalBinds binds)
+ (text "where" $$ nest 4 (pprBinds binds))
pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
=> HsMatchContext idL -> GRHS idR -> SDoc
type Stmt id = StmtLR id id
-data GroupByClause id
- = GroupByNothing (LHsExpr id) -- Using expression, i.e.
- -- "then group using f" ==> GroupByNothing f
- | GroupBySomething (Either (LHsExpr id) (SyntaxExpr id)) (LHsExpr id)
- -- "then group using f by e" ==> GroupBySomething (Left f) e
- -- "then group by e" ==> GroupBySomething (Right _) e: in
- -- this case the expression is filled
- -- in by the renamer
-
-- The SyntaxExprs in here are used *only* for do-notation, which
-- has rebindable syntax. Otherwise they are unused.
data StmtLR idL idR
-- The fail operator is noSyntaxExpr
-- if the pattern match can't fail
- | ExprStmt (LHsExpr idR)
+ | ExprStmt (LHsExpr idR) -- See Note [ExprStmt]
(SyntaxExpr idR) -- The (>>) operator
PostTcType -- Element type of the RHS (used for arrows)
-- After renaming, the ids are the binders bound by the stmts and used
-- after them
- | TransformStmt ([LStmt idL], [idR]) (LHsExpr idR) (Maybe (LHsExpr idR))
- -- After renaming, the IDs are the binders occurring within this
- -- transform statement that are used after it
- -- "qs, then f by e" ==> TransformStmt (qs, binders) f (Just e)
- -- "qs, then f" ==> TransformStmt (qs, binders) f Nothing
-
- | GroupStmt ([LStmt idL], [(idR, idR)]) (GroupByClause idR)
- -- After renaming, the IDs are the binders occurring within this
- -- transform statement that are used after it which are paired with
- -- the names which they group over in statements
-
- -- Recursive statement (see Note [RecStmt] below)
- | RecStmt [LStmtLR idL idR]
- --- The next two fields are only valid after renaming
- [idR] -- The ids are a subset of the variables bound by the
- -- stmts that are used in stmts that follow the RecStmt
-
- [idR] -- 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
-
- --- These fields are only valid after typechecking
- [PostTcExpr] -- These expressions correspond 1-to-1 with
- -- the "recursive" [id], and are the
- -- expressions 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*.
- (DictBinds idR) -- Method bindings of Ids bound by the
- -- RecStmt, and used afterwards
+ -- "qs, then f by e" ==> TransformStmt qs binders f (Just e)
+ -- "qs, then f" ==> TransformStmt qs binders f Nothing
+ | TransformStmt
+ [LStmt idL] -- Stmts are the ones to the left of the 'then'
+
+ [idR] -- After renaming, the IDs are the binders occurring
+ -- within this transform statement that are used after it
+
+ (LHsExpr idR) -- "then f"
+
+ (Maybe (LHsExpr idR)) -- "by e" (optional)
+
+ | GroupStmt
+ [LStmt idL] -- Stmts to the *left* of the 'group'
+ -- which generates the tuples to be grouped
+
+ [(idR, idR)] -- See Note [GroupStmt binder map]
+
+ (Maybe (LHsExpr idR)) -- "by e" (optional)
+
+ (Either -- "using f"
+ (LHsExpr idR) -- Left f => explicit "using f"
+ (SyntaxExpr idR)) -- Right f => implicit; filled in with 'groupWith'
+
+
+ -- Recursive statement (see Note [How RecStmt works] below)
+ | RecStmt
+ { recS_stmts :: [LStmtLR idL idR]
+
+ -- The next two fields are only valid after renaming
+ , recS_later_ids :: [idR] -- The ids are a subset of the variables bound by the
+ -- stmts that are used in stmts that follow the RecStmt
+
+ , recS_rec_ids :: [idR] -- Ditto, but these variables are the "recursive" ones,
+ -- that are used before they are bound in the stmts of
+ -- the RecStmt.
+ -- An Id can be in both groups
+ -- Both sets of Ids are (now) treated monomorphically
+ -- See Note [How RecStmt works] for why they are separate
+
+ -- Rebindable syntax
+ , recS_bind_fn :: SyntaxExpr idR -- The bind function
+ , recS_ret_fn :: SyntaxExpr idR -- The return function
+ , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
+
+ -- These fields are only valid after typechecking
+ , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1 with
+ -- recS_rec_ids, and are the
+ -- expressions 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*,
+ -- so they may be type applications
+
+ , recS_dicts :: DictBinds idR -- Method bindings of Ids bound by the
+ -- RecStmt, and used afterwards
+ }
\end{code}
+Note [GroupStmt binder map]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The [(idR,idR)] in a GroupStmt behaves as follows:
+
+ * Before renaming: []
+
+ * After renaming:
+ [ (x27,x27), ..., (z35,z35) ]
+ These are the variables
+ bound by the stmts to the left of the 'group'
+ and used either in the 'by' clause,
+ or in the stmts following the 'group'
+ Each item is a pair of identical variables.
+
+ * After typechecking:
+ [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]
+ Each pair has the same unique, but different *types*.
+
+Note [ExprStmt]
+~~~~~~~~~~~~~~~
ExprStmts are a bit tricky, because what they mean
depends on the context. Consider the following contexts:
Array comprehensions are handled like list comprehensions -=chak
-Note [RecStmt]
-~~~~~~~~~~~~~~
+Note [How RecStmt works]
+~~~~~~~~~~~~~~~~~~~~~~~~
Example:
- HsDo [ BindStmt x ex
+ HsDo [ BindStmt x ex
- , RecStmt [a::forall a. a -> a, b]
- [a::Int -> Int, c]
- [ BindStmt b (return x)
- , LetStmt a = ea
- , BindStmt c ec ]
+ , RecStmt { recS_rec_ids = [a, c]
+ , recS_stmts = [ BindStmt b (return (a,c))
+ , LetStmt a = ...b...
+ , BindStmt c ec ]
+ , recS_later_ids = [a, b]
- , return (a b) ]
+ , return (a b) ]
Here, the RecStmt binds a,b,c; but
- Only a,b are used in the stmts *following* the RecStmt,
- This 'a' is *polymorphic'
- Only a,c are used in the stmts *inside* the RecStmt
*before* their bindings
- This 'a' is monomorphic
-Nota Bene: the two a's have different types, even though they
-have the same Name.
+Why do we need *both* rec_ids and later_ids? For monads they could be
+combined into a single set of variables, but not for arrows. That
+follows from the types of the respective feedback operators:
+
+ mfix :: MonadFix m => (a -> m a) -> m a
+ loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
+
+* For mfix, the 'a' covers the union of the later_ids and the rec_ids
+* For 'loop', 'c' is the later_ids and 'd' is the rec_ids
+
+Note [Typing a RecStmt]
+~~~~~~~~~~~~~~~~~~~~~~~
+A (RecStmt stmts) types as if you had written
+
+ (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->
+ do { stmts
+ ; return (v1,..vn, r1, ..., rm) })
+
+where v1..vn are the later_ids
+ r1..rm are the rec_ids
\begin{code}
pprStmt (ExprStmt expr _ _) = ppr expr
pprStmt (ParStmt stmtss) = hsep (map doStmts stmtss)
where doStmts stmts = ptext (sLit "| ") <> ppr stmts
-pprStmt (TransformStmt (stmts, _) usingExpr maybeByExpr)
- = (hsep [stmtsDoc, ptext (sLit "then"), ppr usingExpr, byExprDoc])
- where stmtsDoc = interpp'SP stmts
- byExprDoc = maybe empty (\byExpr -> hsep [ptext (sLit "by"), ppr byExpr]) maybeByExpr
-pprStmt (GroupStmt (stmts, _) groupByClause) = (hsep [stmtsDoc, ptext (sLit "then group"), pprGroupByClause groupByClause])
- where stmtsDoc = interpp'SP stmts
-pprStmt (RecStmt segment _ _ _ _) = ptext (sLit "rec") <+> braces (vcat (map ppr segment))
-
-pprGroupByClause :: (OutputableBndr id) => GroupByClause id -> SDoc
-pprGroupByClause (GroupByNothing usingExpr) = hsep [ptext (sLit "using"), ppr usingExpr]
-pprGroupByClause (GroupBySomething eitherUsingExpr byExpr) = hsep [ptext (sLit "by"), ppr byExpr, usingExprDoc]
- where usingExprDoc = either (\usingExpr -> hsep [ptext (sLit "using"), ppr usingExpr]) (const empty) eitherUsingExpr
+
+pprStmt (TransformStmt stmts _ using by)
+ = sep (ppr_lc_stmts stmts ++ [pprTransformStmt using by])
+
+pprStmt (GroupStmt stmts _ by using)
+ = sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using])
+
+pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
+ , recS_later_ids = later_ids })
+ = ptext (sLit "rec") <+>
+ vcat [ braces (vcat (map ppr segment))
+ , ifPprDebug (vcat [ ptext (sLit "rec_ids=") <> ppr rec_ids
+ , ptext (sLit "later_ids=") <> ppr later_ids])]
+
+pprTransformStmt :: OutputableBndr id => LHsExpr id -> Maybe (LHsExpr id) -> SDoc
+pprTransformStmt using by = sep [ ptext (sLit "then"), nest 2 (ppr using), nest 2 (pprBy by)]
+
+pprGroupStmt :: OutputableBndr id => Maybe (LHsExpr id)
+ -> Either (LHsExpr id) (SyntaxExpr is)
+ -> SDoc
+pprGroupStmt by using
+ = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 (ppr_using using)]
+ where
+ ppr_using (Right _) = empty
+ ppr_using (Left e) = ptext (sLit "using") <+> ppr e
+
+pprBy :: OutputableBndr id => Maybe (LHsExpr id) -> SDoc
+pprBy Nothing = empty
+pprBy (Just e) = ptext (sLit "by") <+> ppr e
pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
-pprDo DoExpr stmts body = ptext (sLit "do") <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
-pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
-pprDo ListComp stmts body = pprComp brackets stmts body
-pprDo PArrComp stmts body = pprComp pa_brackets stmts body
+pprDo DoExpr stmts body = ptext (sLit "do") <+> ppr_do_stmts stmts body
+pprDo GhciStmt stmts body = ptext (sLit "do") <+> ppr_do_stmts stmts body
+pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> ppr_do_stmts stmts body
+pprDo ListComp stmts body = brackets $ pprComp stmts body
+pprDo PArrComp stmts body = pa_brackets $ pprComp stmts body
pprDo _ _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
-pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
-pprComp brack quals body
- = brack $
- hang (ppr body <+> char '|')
- 4 (interpp'SP quals)
+ppr_do_stmts :: OutputableBndr id => [LStmt id] -> LHsExpr id -> SDoc
+-- Print a bunch of do stmts, with explicit braces and semicolons,
+-- so that we are not vulnerable to layout bugs
+ppr_do_stmts stmts body
+ = lbrace <+> pprDeeperList vcat ([ppr s <> semi | s <- stmts] ++ [ppr body])
+ <+> rbrace
+
+ppr_lc_stmts :: OutputableBndr id => [LStmt id] -> [SDoc]
+ppr_lc_stmts stmts = [ppr s <> comma | s <- stmts]
+
+pprComp :: OutputableBndr id => [LStmt id] -> LHsExpr id -> SDoc
+pprComp quals body -- Prints: body | qual1, ..., qualn
+ = hang (ppr body <+> char '|') 2 (interpp'SP quals)
\end{code}
%************************************************************************
= char '$' <> ifPprDebug (brackets (ppr n)) <> pprParendExpr e
-data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
- | PatBr (LPat id) -- [p| pat |]
- | DecBr (HsGroup id) -- [d| decls |]
- | TypBr (LHsType id) -- [t| type |]
- | VarBr id -- 'x, ''T
+data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
+ | PatBr (LPat id) -- [p| pat |]
+ | DecBrL [LHsDecl id] -- [d| decls |]; result of parser
+ | DecBrG (HsGroup id) -- [d| decls |]; result of renamer
+ | TypBr (LHsType id) -- [t| type |]
+ | VarBr id -- 'x, ''T
instance OutputableBndr id => Outputable (HsBracket id) where
ppr = pprHsBracket
pprHsBracket :: OutputableBndr id => HsBracket id -> SDoc
-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
+pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
+pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
+pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
+pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
+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
\begin{code}
data HsMatchContext id -- Context of a Match
= 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
- | PatBindRhs -- Pattern binding
+ | CaseAlt -- Patterns and guards on a case alternative
+ | LambdaExpr -- Patterns of a lambda
+ | ProcExpr -- Patterns of a proc
+ | PatBindRhs -- Patterns in the *guards* of a pattern binding
| RecUpd -- Record update [used only in DsExpr to
-- tell matchWrapper what sort of
-- runtime error message to generate]
| StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
+ | ThPatQuote -- A Template Haskell pattern quotation [p| (a,b) |]
deriving ()
data HsStmtContext id
= ListComp
| DoExpr
+ | GhciStmt -- A command-line Stmt in GHCi pat <- rhs
| MDoExpr PostTcTable -- Recursive do-expression
-- (tiresomely, it needs table
-- of its return/bind ops)
matchSeparator PatBindRhs = ptext (sLit "=")
matchSeparator (StmtCtxt _) = ptext (sLit "<-")
matchSeparator RecUpd = panic "unused"
+matchSeparator ThPatQuote = panic "unused"
\end{code}
\begin{code}
<+> quotes (ppr fun)
pprMatchContext CaseAlt = ptext (sLit "a case alternative")
pprMatchContext RecUpd = ptext (sLit "a record-update construct")
+pprMatchContext ThPatQuote = ptext (sLit "a Template Haskell pattern quotation")
pprMatchContext PatBindRhs = ptext (sLit "a pattern binding")
pprMatchContext LambdaExpr = ptext (sLit "a lambda abstraction")
pprMatchContext ProcExpr = ptext (sLit "an arrow abstraction")
= sep [ptext (sLit "a transformed branch of"), pprStmtContext c]
pprStmtContext (PatGuard ctxt)
= ptext (sLit "a pattern guard for") $$ pprMatchContext ctxt
+pprStmtContext GhciStmt = ptext (sLit "an interactive GHCi command")
pprStmtContext DoExpr = ptext (sLit "a 'do' expression")
pprStmtContext (MDoExpr _) = ptext (sLit "an 'mdo' expression")
pprStmtContext ListComp = ptext (sLit "a list comprehension")
-}
-- Used to generate the string for a *runtime* error message
-matchContextErrString :: Outputable id => HsMatchContext id -> String
-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 :: Outputable id => HsMatchContext id -> SDoc
+matchContextErrString (FunRhs fun _) = ptext (sLit "function") <+> ppr fun
+matchContextErrString CaseAlt = ptext (sLit "case")
+matchContextErrString PatBindRhs = ptext (sLit "pattern binding")
+matchContextErrString RecUpd = ptext (sLit "record update")
+matchContextErrString LambdaExpr = ptext (sLit "lambda")
+matchContextErrString ProcExpr = ptext (sLit "proc")
+matchContextErrString ThPatQuote = panic "matchContextErrString" -- Not used at runtime
matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
matchContextErrString (StmtCtxt (TransformStmtCtxt 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"
+matchContextErrString (StmtCtxt (PatGuard _)) = ptext (sLit "pattern guard")
+matchContextErrString (StmtCtxt GhciStmt) = ptext (sLit "interactive GHCi command")
+matchContextErrString (StmtCtxt DoExpr) = ptext (sLit "'do' expression")
+matchContextErrString (StmtCtxt (MDoExpr _)) = ptext (sLit "'mdo' expression")
+matchContextErrString (StmtCtxt ListComp) = ptext (sLit "list comprehension")
+matchContextErrString (StmtCtxt PArrComp) = ptext (sLit "array comprehension")
\end{code}
\begin{code}
pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR)
=> HsStmtContext idL -> StmtLR idL idR -> SDoc
pprStmtInCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprStmtContext ctxt <> colon)
- 4 (ppr stmt)
+ 4 (ppr_stmt stmt)
+ where
+ -- For Group and Transform Stmts, don't print the nested stmts!
+ ppr_stmt (GroupStmt _ _ by using) = pprGroupStmt by using
+ ppr_stmt (TransformStmt _ _ using by) = pprTransformStmt using by
+ ppr_stmt stmt = pprStmt stmt
\end{code}
projects / ghc-hetmet.git / blobdiff