2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 TcMatches: Typecheck some @Matches@
9 module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
10 matchCtxt, TcMatchCtxt(..),
11 tcStmts, tcDoStmts, tcBody,
12 tcDoStmt, tcMDoStmt, tcGuardStmt
15 import {-# SOURCE #-} TcExpr( tcSyntaxOp, tcInferRho, tcMonoExpr, tcPolyExpr )
41 %************************************************************************
43 \subsection{tcMatchesFun, tcMatchesCase}
45 %************************************************************************
47 @tcMatchesFun@ typechecks a @[Match]@ list which occurs in a
48 @FunMonoBind@. The second argument is the name of the function, which
49 is used in error messages. It checks that all the equations have the
50 same number of arguments before using @tcMatches@ to do the work.
53 tcMatchesFun :: Name -> Bool
55 -> BoxyRhoType -- Expected type of function
56 -> TcM (HsWrapper, MatchGroup TcId) -- Returns type of body
58 tcMatchesFun fun_name inf matches exp_ty
59 = do { -- Check that they all have the same no of arguments
60 -- Location is in the monad, set the caller so that
61 -- any inter-equation error messages get some vaguely
62 -- sensible location. Note: we have to do this odd
63 -- ann-grabbing, because we don't always have annotations in
64 -- hand when we call tcMatchesFun...
65 checkArgs fun_name matches
67 -- ToDo: Don't use "expected" stuff if there ain't a type signature
68 -- because inconsistency between branches
69 -- may show up as something wrong with the (non-existent) type signature
71 -- This is one of two places places we call subFunTys
72 -- The point is that if expected_y is a "hole", we want
73 -- to make pat_tys and rhs_ty as "holes" too.
74 ; subFunTys doc n_pats exp_ty $ \ pat_tys rhs_ty ->
75 tcMatches match_ctxt pat_tys rhs_ty matches
78 doc = ptext (sLit "The equation(s) for") <+> quotes (ppr fun_name)
79 <+> ptext (sLit "have") <+> speakNOf n_pats (ptext (sLit "argument"))
80 n_pats = matchGroupArity matches
81 match_ctxt = MC { mc_what = FunRhs fun_name inf, mc_body = tcBody }
84 @tcMatchesCase@ doesn't do the argument-count check because the
85 parser guarantees that each equation has exactly one argument.
88 tcMatchesCase :: TcMatchCtxt -- Case context
89 -> TcRhoType -- Type of scrutinee
90 -> MatchGroup Name -- The case alternatives
91 -> BoxyRhoType -- Type of whole case expressions
92 -> TcM (MatchGroup TcId) -- Translated alternatives
94 tcMatchesCase ctxt scrut_ty matches res_ty
95 = tcMatches ctxt [scrut_ty] res_ty matches
97 tcMatchLambda :: MatchGroup Name -> BoxyRhoType -> TcM (HsWrapper, MatchGroup TcId)
98 tcMatchLambda match res_ty
99 = subFunTys doc n_pats res_ty $ \ pat_tys rhs_ty ->
100 tcMatches match_ctxt pat_tys rhs_ty match
102 n_pats = matchGroupArity match
103 doc = sep [ ptext (sLit "The lambda expression")
104 <+> quotes (pprSetDepth 1 $ pprMatches (LambdaExpr :: HsMatchContext Name) match),
105 -- The pprSetDepth makes the abstraction print briefly
106 ptext (sLit "has") <+> speakNOf n_pats (ptext (sLit "argument"))]
107 match_ctxt = MC { mc_what = LambdaExpr,
111 @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
114 tcGRHSsPat :: GRHSs Name -> BoxyRhoType -> TcM (GRHSs TcId)
115 -- Used for pattern bindings
116 tcGRHSsPat grhss res_ty = tcGRHSs match_ctxt grhss res_ty
118 match_ctxt = MC { mc_what = PatBindRhs,
123 %************************************************************************
127 %************************************************************************
130 tcMatches :: TcMatchCtxt
131 -> [BoxySigmaType] -- Expected pattern types
132 -> BoxyRhoType -- Expected result-type of the Match.
134 -> TcM (MatchGroup TcId)
136 data TcMatchCtxt -- c.f. TcStmtCtxt, also in this module
137 = MC { mc_what :: HsMatchContext Name, -- What kind of thing this is
138 mc_body :: LHsExpr Name -- Type checker for a body of
141 -> TcM (LHsExpr TcId) }
143 tcMatches ctxt pat_tys rhs_ty (MatchGroup matches _)
144 = do { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
145 ; return (MatchGroup matches' (mkFunTys pat_tys rhs_ty)) }
148 tcMatch :: TcMatchCtxt
149 -> [BoxySigmaType] -- Expected pattern types
150 -> BoxyRhoType -- Expected result-type of the Match.
154 tcMatch ctxt pat_tys rhs_ty match
155 = wrapLocM (tc_match ctxt pat_tys rhs_ty) match
157 tc_match ctxt pat_tys rhs_ty match@(Match pats maybe_rhs_sig grhss)
158 = add_match_ctxt match $
159 do { (pats', grhss') <- tcLamPats pats pat_tys rhs_ty $
160 tc_grhss ctxt maybe_rhs_sig grhss
161 ; return (Match pats' Nothing grhss') }
163 tc_grhss ctxt Nothing grhss rhs_ty
164 = tcGRHSs ctxt grhss rhs_ty -- No result signature
166 -- Result type sigs are no longer supported
167 tc_grhss ctxt (Just res_sig) grhss rhs_ty
168 = do { addErr (ptext (sLit "Ignoring (deprecated) result type signature")
170 ; tcGRHSs ctxt grhss rhs_ty }
172 -- For (\x -> e), tcExpr has already said "In the expresssion \x->e"
173 -- so we don't want to add "In the lambda abstraction \x->e"
174 add_match_ctxt match thing_inside
175 = case mc_what ctxt of
176 LambdaExpr -> thing_inside
177 m_ctxt -> addErrCtxt (matchCtxt m_ctxt match) thing_inside
180 tcGRHSs :: TcMatchCtxt -> GRHSs Name -> BoxyRhoType
183 -- Notice that we pass in the full res_ty, so that we get
184 -- good inference from simple things like
185 -- f = \(x::forall a.a->a) -> <stuff>
186 -- We used to force it to be a monotype when there was more than one guard
187 -- but we don't need to do that any more
189 tcGRHSs ctxt (GRHSs grhss binds) res_ty
190 = do { (binds', grhss') <- tcLocalBinds binds $
191 mapM (wrapLocM (tcGRHS ctxt res_ty)) grhss
193 ; return (GRHSs grhss' binds') }
196 tcGRHS :: TcMatchCtxt -> BoxyRhoType -> GRHS Name -> TcM (GRHS TcId)
198 tcGRHS ctxt res_ty (GRHS guards rhs)
199 = do { (guards', rhs') <- tcStmts stmt_ctxt tcGuardStmt guards res_ty $
201 ; return (GRHS guards' rhs') }
203 stmt_ctxt = PatGuard (mc_what ctxt)
207 %************************************************************************
209 \subsection{@tcDoStmts@ typechecks a {\em list} of do statements}
211 %************************************************************************
214 tcDoStmts :: HsStmtContext Name
218 -> TcM (HsExpr TcId) -- Returns a HsDo
219 tcDoStmts ListComp stmts body res_ty
220 = do { (elt_ty, coi) <- boxySplitListTy res_ty
221 ; (stmts', body') <- tcStmts ListComp (tcLcStmt listTyCon) stmts
224 ; return $ mkHsWrapCoI coi
225 (HsDo ListComp stmts' body' (mkListTy elt_ty)) }
227 tcDoStmts PArrComp stmts body res_ty
228 = do { (elt_ty, coi) <- boxySplitPArrTy res_ty
229 ; (stmts', body') <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts
232 ; return $ mkHsWrapCoI coi
233 (HsDo PArrComp stmts' body' (mkPArrTy elt_ty)) }
235 tcDoStmts DoExpr stmts body res_ty
236 = do { (stmts', body') <- tcStmts DoExpr tcDoStmt stmts
239 ; return (HsDo DoExpr stmts' body' res_ty) }
241 tcDoStmts ctxt@(MDoExpr _) stmts body res_ty
242 = do { ((m_ty, elt_ty), coi) <- boxySplitAppTy res_ty
243 ; let res_ty' = mkAppTy m_ty elt_ty -- The boxySplit consumes res_ty
244 tc_rhs rhs = withBox liftedTypeKind $ \ pat_ty ->
245 tcMonoExpr rhs (mkAppTy m_ty pat_ty)
247 ; (stmts', body') <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts
251 ; let names = [mfixName, bindMName, thenMName, returnMName, failMName]
252 ; insts <- mapM (newMethodFromName DoOrigin m_ty) names
255 (HsDo (MDoExpr (names `zip` insts)) stmts' body' res_ty') }
257 tcDoStmts ctxt _ _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)
259 tcBody :: LHsExpr Name -> BoxyRhoType -> TcM (LHsExpr TcId)
261 = do { traceTc (text "tcBody" <+> ppr res_ty)
262 ; body' <- tcPolyExpr body res_ty
268 %************************************************************************
272 %************************************************************************
276 = forall thing. HsStmtContext Name
278 -> BoxyRhoType -- Result type for comprehension
279 -> (BoxyRhoType -> TcM thing) -- Checker for what follows the stmt
280 -> TcM (Stmt TcId, thing)
282 tcStmts :: HsStmtContext Name
283 -> TcStmtChecker -- NB: higher-rank type
286 -> (BoxyRhoType -> TcM thing)
287 -> TcM ([LStmt TcId], thing)
289 -- Note the higher-rank type. stmt_chk is applied at different
290 -- types in the equations for tcStmts
292 tcStmts _ _ [] res_ty thing_inside
293 = do { thing <- thing_inside res_ty
294 ; return ([], thing) }
296 -- LetStmts are handled uniformly, regardless of context
297 tcStmts ctxt stmt_chk (L loc (LetStmt binds) : stmts) res_ty thing_inside
298 = do { (binds', (stmts',thing)) <- tcLocalBinds binds $
299 tcStmts ctxt stmt_chk stmts res_ty thing_inside
300 ; return (L loc (LetStmt binds') : stmts', thing) }
302 -- For the vanilla case, handle the location-setting part
303 tcStmts ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside
304 = do { (stmt', (stmts', thing)) <-
306 addErrCtxt (stmtCtxt ctxt stmt) $
307 stmt_chk ctxt stmt res_ty $ \ res_ty' ->
309 tcStmts ctxt stmt_chk stmts res_ty' $
311 ; return (L loc stmt' : stmts', thing) }
313 --------------------------------
315 tcGuardStmt :: TcStmtChecker
316 tcGuardStmt _ (ExprStmt guard _ _) res_ty thing_inside
317 = do { guard' <- tcMonoExpr guard boolTy
318 ; thing <- thing_inside res_ty
319 ; return (ExprStmt guard' noSyntaxExpr boolTy, thing) }
321 tcGuardStmt _ (BindStmt pat rhs _ _) res_ty thing_inside
322 = do { (rhs', rhs_ty) <- tcInferRho rhs
323 ; (pat', thing) <- tcLamPat pat rhs_ty res_ty thing_inside
324 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
326 tcGuardStmt _ stmt _ _
327 = pprPanic "tcGuardStmt: unexpected Stmt" (ppr stmt)
330 --------------------------------
331 -- List comprehensions and PArrays
333 tcLcStmt :: TyCon -- The list/Parray type constructor ([] or PArray)
336 -- A generator, pat <- rhs
337 tcLcStmt m_tc _ (BindStmt pat rhs _ _) res_ty thing_inside
338 = do { (rhs', pat_ty) <- withBox liftedTypeKind $ \ ty ->
339 tcMonoExpr rhs (mkTyConApp m_tc [ty])
340 ; (pat', thing) <- tcLamPat pat pat_ty res_ty thing_inside
341 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
344 tcLcStmt _ _ (ExprStmt rhs _ _) res_ty thing_inside
345 = do { rhs' <- tcMonoExpr rhs boolTy
346 ; thing <- thing_inside res_ty
347 ; return (ExprStmt rhs' noSyntaxExpr boolTy, thing) }
349 -- A parallel set of comprehensions
350 -- [ (g x, h x) | ... ; let g v = ...
351 -- | ... ; let h v = ... ]
353 -- It's possible that g,h are overloaded, so we need to feed the LIE from the
354 -- (g x, h x) up through both lots of bindings (so we get the bindInstsOfLocalFuns).
355 -- Similarly if we had an existential pattern match:
357 -- data T = forall a. Show a => C a
359 -- [ (show x, show y) | ... ; C x <- ...
360 -- | ... ; C y <- ... ]
362 -- Then we need the LIE from (show x, show y) to be simplified against
363 -- the bindings for x and y.
365 -- It's difficult to do this in parallel, so we rely on the renamer to
366 -- ensure that g,h and x,y don't duplicate, and simply grow the environment.
367 -- So the binders of the first parallel group will be in scope in the second
368 -- group. But that's fine; there's no shadowing to worry about.
370 tcLcStmt m_tc ctxt (ParStmt bndr_stmts_s) elt_ty thing_inside
371 = do { (pairs', thing) <- loop bndr_stmts_s
372 ; return (ParStmt pairs', thing) }
374 -- loop :: [([LStmt Name], [Name])] -> TcM ([([LStmt TcId], [TcId])], thing)
375 loop [] = do { thing <- thing_inside elt_ty
376 ; return ([], thing) } -- matching in the branches
378 loop ((stmts, names) : pairs)
379 = do { (stmts', (ids, pairs', thing))
380 <- tcStmts ctxt (tcLcStmt m_tc) stmts elt_ty $ \ _elt_ty' ->
381 do { ids <- tcLookupLocalIds names
382 ; (pairs', thing) <- loop pairs
383 ; return (ids, pairs', thing) }
384 ; return ( (stmts', ids) : pairs', thing ) }
386 tcLcStmt m_tc ctxt (TransformStmt (stmts, binders) usingExpr maybeByExpr) elt_ty thing_inside = do
387 (stmts', (binders', usingExpr', maybeByExpr', thing)) <-
388 tcStmts (TransformStmtCtxt ctxt) (tcLcStmt m_tc) stmts elt_ty $ \elt_ty' -> do
389 let alphaListTy = mkTyConApp m_tc [alphaTy]
391 (usingExpr', maybeByExpr') <-
394 -- We must validate that usingExpr :: forall a. [a] -> [a]
395 usingExpr' <- tcPolyExpr usingExpr (mkForAllTy alphaTyVar (alphaListTy `mkFunTy` alphaListTy))
396 return (usingExpr', Nothing)
398 -- We must infer a type such that e :: t and then check that usingExpr :: forall a. (a -> t) -> [a] -> [a]
399 (byExpr', tTy) <- tcInferRho byExpr
400 usingExpr' <- tcPolyExpr usingExpr (mkForAllTy alphaTyVar ((alphaTy `mkFunTy` tTy) `mkFunTy` (alphaListTy `mkFunTy` alphaListTy)))
401 return (usingExpr', Just byExpr')
403 binders' <- tcLookupLocalIds binders
404 thing <- thing_inside elt_ty'
406 return (binders', usingExpr', maybeByExpr', thing)
408 return (TransformStmt (stmts', binders') usingExpr' maybeByExpr', thing)
410 tcLcStmt m_tc ctxt (GroupStmt (stmts, bindersMap) groupByClause) elt_ty thing_inside = do
411 (stmts', (bindersMap', groupByClause', thing)) <-
412 tcStmts (TransformStmtCtxt ctxt) (tcLcStmt m_tc) stmts elt_ty $ \elt_ty' -> do
413 let alphaListTy = mkTyConApp m_tc [alphaTy]
414 alphaListListTy = mkTyConApp m_tc [alphaListTy]
417 case groupByClause of
418 GroupByNothing usingExpr ->
419 -- We must validate that usingExpr :: forall a. [a] -> [[a]]
420 tcPolyExpr usingExpr (mkForAllTy alphaTyVar (alphaListTy `mkFunTy` alphaListListTy)) >>= (return . GroupByNothing)
421 GroupBySomething eitherUsingExpr byExpr -> do
422 -- We must infer a type such that byExpr :: t
423 (byExpr', tTy) <- tcInferRho byExpr
425 -- If it exists, we then check that usingExpr :: forall a. (a -> t) -> [a] -> [[a]]
426 let expectedUsingType = mkForAllTy alphaTyVar ((alphaTy `mkFunTy` tTy) `mkFunTy` (alphaListTy `mkFunTy` alphaListListTy))
428 case eitherUsingExpr of
429 Left usingExpr -> (tcPolyExpr usingExpr expectedUsingType) >>= (return . Left)
430 Right usingExpr -> (tcPolyExpr (noLoc usingExpr) expectedUsingType) >>= (return . Right . unLoc)
431 return $ GroupBySomething eitherUsingExpr' byExpr'
433 -- Find the IDs and types of all old binders
434 let (oldBinders, newBinders) = unzip bindersMap
435 oldBinders' <- tcLookupLocalIds oldBinders
437 -- Ensure that every old binder of type b is linked up with its new binder which should have type [b]
438 let newBinders' = zipWith associateNewBinder oldBinders' newBinders
440 -- Type check the thing in the environment with these new binders and return the result
441 thing <- tcExtendIdEnv newBinders' (thing_inside elt_ty')
442 return (zipEqual "tcLcStmt: Old and new binder lists were not of the same length" oldBinders' newBinders', groupByClause', thing)
444 return (GroupStmt (stmts', bindersMap') groupByClause', thing)
446 associateNewBinder :: TcId -> Name -> TcId
447 associateNewBinder oldBinder newBinder = mkLocalId newBinder (mkTyConApp m_tc [idType oldBinder])
449 tcLcStmt _ _ stmt _ _
450 = pprPanic "tcLcStmt: unexpected Stmt" (ppr stmt)
452 --------------------------------
454 -- The main excitement here is dealing with rebindable syntax
456 tcDoStmt :: TcStmtChecker
458 tcDoStmt _ (BindStmt pat rhs bind_op fail_op) res_ty thing_inside
459 = do { (rhs', rhs_ty) <- tcInferRho rhs
460 -- We should use type *inference* for the RHS computations,
462 -- do { pat <- rhs; <rest> }
464 -- case rhs of { pat -> <rest> }
465 -- We do inference on rhs, so that information about its type
466 -- can be refined when type-checking the pattern.
468 -- Deal with rebindable syntax:
469 -- (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty
470 -- This level of generality is needed for using do-notation
471 -- in full generality; see Trac #1537
472 ; ((bind_op', new_res_ty), pat_ty) <-
473 withBox liftedTypeKind $ \ pat_ty ->
474 withBox liftedTypeKind $ \ new_res_ty ->
475 tcSyntaxOp DoOrigin bind_op
476 (mkFunTys [rhs_ty, mkFunTy pat_ty new_res_ty] res_ty)
478 -- If (but only if) the pattern can fail,
479 -- typecheck the 'fail' operator
480 ; fail_op' <- if isIrrefutableHsPat pat
481 then return noSyntaxExpr
482 else tcSyntaxOp DoOrigin fail_op (mkFunTy stringTy new_res_ty)
484 ; (pat', thing) <- tcLamPat pat pat_ty new_res_ty thing_inside
486 ; return (BindStmt pat' rhs' bind_op' fail_op', thing) }
489 tcDoStmt _ (ExprStmt rhs then_op _) res_ty thing_inside
490 = do { (rhs', rhs_ty) <- tcInferRho rhs
492 -- Deal with rebindable syntax; (>>) :: rhs_ty -> new_res_ty -> res_ty
493 ; (then_op', new_res_ty) <-
494 withBox liftedTypeKind $ \ new_res_ty ->
495 tcSyntaxOp DoOrigin then_op
496 (mkFunTys [rhs_ty, new_res_ty] res_ty)
498 ; thing <- thing_inside new_res_ty
499 ; return (ExprStmt rhs' then_op' rhs_ty, thing) }
501 tcDoStmt ctxt (RecStmt {}) _ _
502 = failWithTc (ptext (sLit "Illegal 'rec' stmt in") <+> pprStmtContext ctxt)
503 -- This case can't be caught in the renamer
504 -- see RnExpr.checkRecStmt
507 = pprPanic "tcDoStmt: unexpected Stmt" (ppr stmt)
509 --------------------------------
511 -- The distinctive features here are
513 -- (b) no rebindable syntax
515 tcMDoStmt :: (LHsExpr Name -> TcM (LHsExpr TcId, TcType)) -- RHS inference
517 tcMDoStmt tc_rhs _ (BindStmt pat rhs _ _) res_ty thing_inside
518 = do { (rhs', pat_ty) <- tc_rhs rhs
519 ; (pat', thing) <- tcLamPat pat pat_ty res_ty thing_inside
520 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
522 tcMDoStmt tc_rhs _ (ExprStmt rhs _ _) res_ty thing_inside
523 = do { (rhs', elt_ty) <- tc_rhs rhs
524 ; thing <- thing_inside res_ty
525 ; return (ExprStmt rhs' noSyntaxExpr elt_ty, thing) }
527 tcMDoStmt tc_rhs ctxt (RecStmt stmts laterNames recNames _ _) res_ty thing_inside
528 = do { rec_tys <- newFlexiTyVarTys (length recNames) liftedTypeKind
529 ; let rec_ids = zipWith mkLocalId recNames rec_tys
530 ; tcExtendIdEnv rec_ids $ do
531 { (stmts', (later_ids, rec_rets))
532 <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts res_ty $ \ _res_ty' ->
533 -- ToDo: res_ty not really right
534 do { rec_rets <- zipWithM tc_ret recNames rec_tys
535 ; later_ids <- tcLookupLocalIds laterNames
536 ; return (later_ids, rec_rets) }
538 ; (thing,lie) <- tcExtendIdEnv later_ids (getLIE (thing_inside res_ty))
539 -- NB: The rec_ids for the recursive things
540 -- already scope over this part. This binding may shadow
541 -- some of them with polymorphic things with the same Name
542 -- (see note [RecStmt] in HsExpr)
543 ; lie_binds <- bindInstsOfLocalFuns lie later_ids
545 ; return (RecStmt stmts' later_ids rec_ids rec_rets lie_binds, thing)
548 -- Unify the types of the "final" Ids with those of "knot-tied" Ids
549 tc_ret rec_name mono_ty
550 = do { poly_id <- tcLookupId rec_name
551 -- poly_id may have a polymorphic type
552 -- but mono_ty is just a monomorphic type variable
553 ; co_fn <- tcSubExp DoOrigin (idType poly_id) mono_ty
554 ; return (mkHsWrap co_fn (HsVar poly_id)) }
556 tcMDoStmt _ _ stmt _ _
557 = pprPanic "tcMDoStmt: unexpected Stmt" (ppr stmt)
562 %************************************************************************
564 \subsection{Errors and contexts}
566 %************************************************************************
568 @sameNoOfArgs@ takes a @[RenamedMatch]@ and decides whether the same
569 number of args are used in each equation.
572 checkArgs :: Name -> MatchGroup Name -> TcM ()
573 checkArgs fun (MatchGroup (match1:matches) _)
574 | null bad_matches = return ()
576 = failWithTc (vcat [ptext (sLit "Equations for") <+> quotes (ppr fun) <+>
577 ptext (sLit "have different numbers of arguments"),
578 nest 2 (ppr (getLoc match1)),
579 nest 2 (ppr (getLoc (head bad_matches)))])
581 n_args1 = args_in_match match1
582 bad_matches = [m | m <- matches, args_in_match m /= n_args1]
584 args_in_match :: LMatch Name -> Int
585 args_in_match (L _ (Match pats _ _)) = length pats
586 checkArgs _ _ = panic "TcPat.checkArgs" -- Matches always non-empty
590 matchCtxt :: HsMatchContext Name -> Match Name -> SDoc
591 matchCtxt ctxt match = hang (ptext (sLit "In") <+> pprMatchContext ctxt <> colon)
592 4 (pprMatch ctxt match)
594 stmtCtxt :: HsStmtContext Name -> StmtLR Name Name -> SDoc
595 stmtCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprStmtContext ctxt <> colon)