2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 TcMatches: Typecheck some @Matches@
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
17 matchCtxt, TcMatchCtxt(..),
18 tcStmts, tcDoStmts, tcBody,
19 tcDoStmt, tcMDoStmt, tcGuardStmt
22 #include "HsVersions.h"
24 import {-# SOURCE #-} TcExpr( tcSyntaxOp, tcInferRho, tcMonoExpr, tcPolyExpr )
49 %************************************************************************
51 \subsection{tcMatchesFun, tcMatchesCase}
53 %************************************************************************
55 @tcMatchesFun@ typechecks a @[Match]@ list which occurs in a
56 @FunMonoBind@. The second argument is the name of the function, which
57 is used in error messages. It checks that all the equations have the
58 same number of arguments before using @tcMatches@ to do the work.
61 tcMatchesFun :: Name -> Bool
63 -> BoxyRhoType -- Expected type of function
64 -> TcM (HsWrapper, MatchGroup TcId) -- Returns type of body
66 tcMatchesFun fun_name inf matches exp_ty
67 = do { -- Check that they all have the same no of arguments
68 -- Location is in the monad, set the caller so that
69 -- any inter-equation error messages get some vaguely
70 -- sensible location. Note: we have to do this odd
71 -- ann-grabbing, because we don't always have annotations in
72 -- hand when we call tcMatchesFun...
73 checkArgs fun_name matches
75 -- ToDo: Don't use "expected" stuff if there ain't a type signature
76 -- because inconsistency between branches
77 -- may show up as something wrong with the (non-existent) type signature
79 -- This is one of two places places we call subFunTys
80 -- The point is that if expected_y is a "hole", we want
81 -- to make pat_tys and rhs_ty as "holes" too.
82 ; subFunTys doc n_pats exp_ty $ \ pat_tys rhs_ty ->
83 tcMatches match_ctxt pat_tys rhs_ty matches
86 doc = ptext SLIT("The equation(s) for") <+> quotes (ppr fun_name)
87 <+> ptext SLIT("have") <+> speakNOf n_pats (ptext SLIT("argument"))
88 n_pats = matchGroupArity matches
89 match_ctxt = MC { mc_what = FunRhs fun_name inf, mc_body = tcBody }
92 @tcMatchesCase@ doesn't do the argument-count check because the
93 parser guarantees that each equation has exactly one argument.
96 tcMatchesCase :: TcMatchCtxt -- Case context
97 -> TcRhoType -- Type of scrutinee
98 -> MatchGroup Name -- The case alternatives
99 -> BoxyRhoType -- Type of whole case expressions
100 -> TcM (MatchGroup TcId) -- Translated alternatives
102 tcMatchesCase ctxt scrut_ty matches res_ty
103 = tcMatches ctxt [scrut_ty] res_ty matches
105 tcMatchLambda :: MatchGroup Name -> BoxyRhoType -> TcM (HsWrapper, MatchGroup TcId)
106 tcMatchLambda match res_ty
107 = subFunTys doc n_pats res_ty $ \ pat_tys rhs_ty ->
108 tcMatches match_ctxt pat_tys rhs_ty match
110 n_pats = matchGroupArity match
111 doc = sep [ ptext SLIT("The lambda expression")
112 <+> quotes (pprSetDepth 1 $ pprMatches (LambdaExpr :: HsMatchContext Name) match),
113 -- The pprSetDepth makes the abstraction print briefly
114 ptext SLIT("has") <+> speakNOf n_pats (ptext SLIT("argument"))]
115 match_ctxt = MC { mc_what = LambdaExpr,
119 @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
122 tcGRHSsPat :: GRHSs Name -> BoxyRhoType -> TcM (GRHSs TcId)
123 -- Used for pattern bindings
124 tcGRHSsPat grhss res_ty = tcGRHSs match_ctxt grhss res_ty
126 match_ctxt = MC { mc_what = PatBindRhs,
131 %************************************************************************
135 %************************************************************************
138 tcMatches :: TcMatchCtxt
139 -> [BoxySigmaType] -- Expected pattern types
140 -> BoxyRhoType -- Expected result-type of the Match.
142 -> TcM (MatchGroup TcId)
144 data TcMatchCtxt -- c.f. TcStmtCtxt, also in this module
145 = MC { mc_what :: HsMatchContext Name, -- What kind of thing this is
146 mc_body :: LHsExpr Name -- Type checker for a body of
149 -> TcM (LHsExpr TcId) }
151 tcMatches ctxt pat_tys rhs_ty (MatchGroup matches _)
152 = do { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
153 ; return (MatchGroup matches' (mkFunTys pat_tys rhs_ty)) }
156 tcMatch :: TcMatchCtxt
157 -> [BoxySigmaType] -- Expected pattern types
158 -> BoxyRhoType -- Expected result-type of the Match.
162 tcMatch ctxt pat_tys rhs_ty match
163 = wrapLocM (tc_match ctxt pat_tys rhs_ty) match
165 tc_match ctxt pat_tys rhs_ty match@(Match pats maybe_rhs_sig grhss)
166 = add_match_ctxt match $
167 do { (pats', grhss') <- tcLamPats pats pat_tys rhs_ty $
168 tc_grhss ctxt maybe_rhs_sig grhss
169 ; return (Match pats' Nothing grhss') }
171 tc_grhss ctxt Nothing grhss rhs_ty
172 = tcGRHSs ctxt grhss rhs_ty -- No result signature
174 -- Result type sigs are no longer supported
175 tc_grhss ctxt (Just res_sig) grhss rhs_ty
176 = do { addErr (ptext SLIT("Ignoring (deprecated) result type signature")
178 ; tcGRHSs ctxt grhss rhs_ty }
180 -- For (\x -> e), tcExpr has already said "In the expresssion \x->e"
181 -- so we don't want to add "In the lambda abstraction \x->e"
182 add_match_ctxt match thing_inside
183 = case mc_what ctxt of
184 LambdaExpr -> thing_inside
185 m_ctxt -> addErrCtxt (matchCtxt m_ctxt match) thing_inside
188 tcGRHSs :: TcMatchCtxt -> GRHSs Name -> BoxyRhoType
191 -- Notice that we pass in the full res_ty, so that we get
192 -- good inference from simple things like
193 -- f = \(x::forall a.a->a) -> <stuff>
194 -- We used to force it to be a monotype when there was more than one guard
195 -- but we don't need to do that any more
197 tcGRHSs ctxt (GRHSs grhss binds) res_ty
198 = do { (binds', grhss') <- tcLocalBinds binds $
199 mapM (wrapLocM (tcGRHS ctxt res_ty)) grhss
201 ; return (GRHSs grhss' binds') }
204 tcGRHS :: TcMatchCtxt -> BoxyRhoType -> GRHS Name -> TcM (GRHS TcId)
206 tcGRHS ctxt res_ty (GRHS guards rhs)
207 = do { (guards', rhs') <- tcStmts stmt_ctxt tcGuardStmt guards res_ty $
209 ; return (GRHS guards' rhs') }
211 stmt_ctxt = PatGuard (mc_what ctxt)
215 %************************************************************************
217 \subsection{@tcDoStmts@ typechecks a {\em list} of do statements}
219 %************************************************************************
222 tcDoStmts :: HsStmtContext Name
226 -> TcM (HsExpr TcId) -- Returns a HsDo
227 tcDoStmts ListComp stmts body res_ty
228 = do { (elt_ty, coi) <- boxySplitListTy res_ty
229 ; (stmts', body') <- tcStmts ListComp (tcLcStmt listTyCon) stmts
232 ; return $ mkHsWrapCoI coi
233 (HsDo ListComp stmts' body' (mkListTy elt_ty)) }
235 tcDoStmts PArrComp stmts body res_ty
236 = do { (elt_ty, coi) <- boxySplitPArrTy res_ty
237 ; (stmts', body') <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts
240 ; return $ mkHsWrapCoI coi
241 (HsDo PArrComp stmts' body' (mkPArrTy elt_ty)) }
243 tcDoStmts DoExpr stmts body res_ty
244 = do { (stmts', body') <- tcStmts DoExpr tcDoStmt stmts
247 ; return (HsDo DoExpr stmts' body' res_ty) }
249 tcDoStmts ctxt@(MDoExpr _) stmts body res_ty
250 = do { ((m_ty, elt_ty), coi) <- boxySplitAppTy res_ty
251 ; let res_ty' = mkAppTy m_ty elt_ty -- The boxySplit consumes res_ty
252 tc_rhs rhs = withBox liftedTypeKind $ \ pat_ty ->
253 tcMonoExpr rhs (mkAppTy m_ty pat_ty)
255 ; (stmts', body') <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts
259 ; let names = [mfixName, bindMName, thenMName, returnMName, failMName]
260 ; insts <- mapM (newMethodFromName DoOrigin m_ty) names
263 (HsDo (MDoExpr (names `zip` insts)) stmts' body' res_ty') }
265 tcDoStmts ctxt stmts body res_ty = pprPanic "tcDoStmts" (pprStmtContext ctxt)
267 tcBody :: LHsExpr Name -> BoxyRhoType -> TcM (LHsExpr TcId)
269 = do { traceTc (text "tcBody" <+> ppr res_ty)
270 ; body' <- tcPolyExpr body res_ty
276 %************************************************************************
280 %************************************************************************
284 = forall thing. HsStmtContext Name
286 -> BoxyRhoType -- Result type for comprehension
287 -> (BoxyRhoType -> TcM thing) -- Checker for what follows the stmt
288 -> TcM (Stmt TcId, thing)
290 tcStmts :: HsStmtContext Name
291 -> TcStmtChecker -- NB: higher-rank type
294 -> (BoxyRhoType -> TcM thing)
295 -> TcM ([LStmt TcId], thing)
297 -- Note the higher-rank type. stmt_chk is applied at different
298 -- types in the equations for tcStmts
300 tcStmts ctxt stmt_chk [] res_ty thing_inside
301 = do { thing <- thing_inside res_ty
302 ; return ([], thing) }
304 -- LetStmts are handled uniformly, regardless of context
305 tcStmts ctxt stmt_chk (L loc (LetStmt binds) : stmts) res_ty thing_inside
306 = do { (binds', (stmts',thing)) <- tcLocalBinds binds $
307 tcStmts ctxt stmt_chk stmts res_ty thing_inside
308 ; return (L loc (LetStmt binds') : stmts', thing) }
310 -- For the vanilla case, handle the location-setting part
311 tcStmts ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside
312 = do { (stmt', (stmts', thing)) <-
314 addErrCtxt (stmtCtxt ctxt stmt) $
315 stmt_chk ctxt stmt res_ty $ \ res_ty' ->
317 tcStmts ctxt stmt_chk stmts res_ty' $
319 ; return (L loc stmt' : stmts', thing) }
321 --------------------------------
323 tcGuardStmt :: TcStmtChecker
324 tcGuardStmt ctxt (ExprStmt guard _ _) res_ty thing_inside
325 = do { guard' <- tcMonoExpr guard boolTy
326 ; thing <- thing_inside res_ty
327 ; return (ExprStmt guard' noSyntaxExpr boolTy, thing) }
329 tcGuardStmt ctxt (BindStmt pat rhs _ _) res_ty thing_inside
330 = do { (rhs', rhs_ty) <- tcInferRho rhs
331 ; (pat', thing) <- tcLamPat pat rhs_ty res_ty thing_inside
332 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
334 tcGuardStmt ctxt stmt res_ty thing_inside
335 = pprPanic "tcGuardStmt: unexpected Stmt" (ppr stmt)
338 --------------------------------
339 -- List comprehensions and PArrays
341 tcLcStmt :: TyCon -- The list/Parray type constructor ([] or PArray)
344 -- A generator, pat <- rhs
345 tcLcStmt m_tc ctxt (BindStmt pat rhs _ _) res_ty thing_inside
346 = do { (rhs', pat_ty) <- withBox liftedTypeKind $ \ ty ->
347 tcMonoExpr rhs (mkTyConApp m_tc [ty])
348 ; (pat', thing) <- tcLamPat pat pat_ty res_ty thing_inside
349 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
352 tcLcStmt m_tc ctxt (ExprStmt rhs _ _) res_ty thing_inside
353 = do { rhs' <- tcMonoExpr rhs boolTy
354 ; thing <- thing_inside res_ty
355 ; return (ExprStmt rhs' noSyntaxExpr boolTy, thing) }
357 -- A parallel set of comprehensions
358 -- [ (g x, h x) | ... ; let g v = ...
359 -- | ... ; let h v = ... ]
361 -- It's possible that g,h are overloaded, so we need to feed the LIE from the
362 -- (g x, h x) up through both lots of bindings (so we get the bindInstsOfLocalFuns).
363 -- Similarly if we had an existential pattern match:
365 -- data T = forall a. Show a => C a
367 -- [ (show x, show y) | ... ; C x <- ...
368 -- | ... ; C y <- ... ]
370 -- Then we need the LIE from (show x, show y) to be simplified against
371 -- the bindings for x and y.
373 -- It's difficult to do this in parallel, so we rely on the renamer to
374 -- ensure that g,h and x,y don't duplicate, and simply grow the environment.
375 -- So the binders of the first parallel group will be in scope in the second
376 -- group. But that's fine; there's no shadowing to worry about.
378 tcLcStmt m_tc ctxt (ParStmt bndr_stmts_s) elt_ty thing_inside
379 = do { (pairs', thing) <- loop bndr_stmts_s
380 ; return (ParStmt pairs', thing) }
382 -- loop :: [([LStmt Name], [Name])] -> TcM ([([LStmt TcId], [TcId])], thing)
383 loop [] = do { thing <- thing_inside elt_ty
384 ; return ([], thing) } -- matching in the branches
386 loop ((stmts, names) : pairs)
387 = do { (stmts', (ids, pairs', thing))
388 <- tcStmts ctxt (tcLcStmt m_tc) stmts elt_ty $ \ elt_ty' ->
389 do { ids <- tcLookupLocalIds names
390 ; (pairs', thing) <- loop pairs
391 ; return (ids, pairs', thing) }
392 ; return ( (stmts', ids) : pairs', thing ) }
394 tcLcStmt m_tc ctxt (TransformStmt (stmts, binders) usingExpr maybeByExpr) elt_ty thing_inside = do
395 (stmts', (binders', usingExpr', maybeByExpr', thing)) <-
396 tcStmts (TransformStmtCtxt ctxt) (tcLcStmt m_tc) stmts elt_ty $ \elt_ty' -> do
397 let alphaListTy = mkTyConApp m_tc [alphaTy]
399 (usingExpr', maybeByExpr') <-
402 -- We must validate that usingExpr :: forall a. [a] -> [a]
403 usingExpr' <- tcPolyExpr usingExpr (mkForAllTy alphaTyVar (alphaListTy `mkFunTy` alphaListTy))
404 return (usingExpr', Nothing)
406 -- We must infer a type such that e :: t and then check that usingExpr :: forall a. (a -> t) -> [a] -> [a]
407 (byExpr', tTy) <- tcInferRho byExpr
408 usingExpr' <- tcPolyExpr usingExpr (mkForAllTy alphaTyVar ((alphaTy `mkFunTy` tTy) `mkFunTy` (alphaListTy `mkFunTy` alphaListTy)))
409 return (usingExpr', Just byExpr')
411 binders' <- tcLookupLocalIds binders
412 thing <- thing_inside elt_ty'
414 return (binders', usingExpr', maybeByExpr', thing)
416 return (TransformStmt (stmts', binders') usingExpr' maybeByExpr', thing)
418 tcLcStmt m_tc ctxt (GroupStmt (stmts, bindersMap) groupByClause) elt_ty thing_inside = do
419 (stmts', (bindersMap', groupByClause', thing)) <-
420 tcStmts (TransformStmtCtxt ctxt) (tcLcStmt m_tc) stmts elt_ty $ \elt_ty' -> do
421 let alphaListTy = mkTyConApp m_tc [alphaTy]
422 alphaListListTy = mkTyConApp m_tc [alphaListTy]
425 case groupByClause of
426 GroupByNothing usingExpr ->
427 -- We must validate that usingExpr :: forall a. [a] -> [[a]]
428 tcPolyExpr usingExpr (mkForAllTy alphaTyVar (alphaListTy `mkFunTy` alphaListListTy)) >>= (return . GroupByNothing)
429 GroupBySomething eitherUsingExpr byExpr -> do
430 -- We must infer a type such that byExpr :: t
431 (byExpr', tTy) <- tcInferRho byExpr
433 -- If it exists, we then check that usingExpr :: forall a. (a -> t) -> [a] -> [[a]]
434 let expectedUsingType = mkForAllTy alphaTyVar ((alphaTy `mkFunTy` tTy) `mkFunTy` (alphaListTy `mkFunTy` alphaListListTy))
436 case eitherUsingExpr of
437 Left usingExpr -> (tcPolyExpr usingExpr expectedUsingType) >>= (return . Left)
438 Right usingExpr -> (tcPolyExpr (noLoc usingExpr) expectedUsingType) >>= (return . Right . unLoc)
439 return $ GroupBySomething eitherUsingExpr' byExpr'
441 -- Find the IDs and types of all old binders
442 let (oldBinders, newBinders) = unzip bindersMap
443 oldBinders' <- tcLookupLocalIds oldBinders
445 -- Ensure that every old binder of type b is linked up with its new binder which should have type [b]
446 let newBinders' = zipWith associateNewBinder oldBinders' newBinders
448 -- Type check the thing in the environment with these new binders and return the result
449 thing <- tcExtendIdEnv newBinders' (thing_inside elt_ty')
450 return (zipEqual "tcLcStmt: Old and new binder lists were not of the same length" oldBinders' newBinders', groupByClause', thing)
452 return (GroupStmt (stmts', bindersMap') groupByClause', thing)
454 associateNewBinder :: TcId -> Name -> TcId
455 associateNewBinder oldBinder newBinder = mkLocalId newBinder (mkTyConApp m_tc [idType oldBinder])
457 tcLcStmt m_tc ctxt stmt elt_ty thing_inside
458 = pprPanic "tcLcStmt: unexpected Stmt" (ppr stmt)
460 --------------------------------
462 -- The main excitement here is dealing with rebindable syntax
464 tcDoStmt :: TcStmtChecker
466 tcDoStmt ctxt (BindStmt pat rhs bind_op fail_op) res_ty thing_inside
467 = do { (rhs', rhs_ty) <- tcInferRho rhs
468 -- We should use type *inference* for the RHS computations,
470 -- do { pat <- rhs; <rest> }
472 -- case rhs of { pat -> <rest> }
473 -- We do inference on rhs, so that information about its type
474 -- can be refined when type-checking the pattern.
476 -- Deal with rebindable syntax:
477 -- (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty
478 -- This level of generality is needed for using do-notation
479 -- in full generality; see Trac #1537
480 ; ((bind_op', new_res_ty), pat_ty) <-
481 withBox liftedTypeKind $ \ pat_ty ->
482 withBox liftedTypeKind $ \ new_res_ty ->
483 tcSyntaxOp DoOrigin bind_op
484 (mkFunTys [rhs_ty, mkFunTy pat_ty new_res_ty] res_ty)
486 -- If (but only if) the pattern can fail,
487 -- typecheck the 'fail' operator
488 ; fail_op' <- if isIrrefutableHsPat pat
489 then return noSyntaxExpr
490 else tcSyntaxOp DoOrigin fail_op (mkFunTy stringTy new_res_ty)
492 ; (pat', thing) <- tcLamPat pat pat_ty new_res_ty thing_inside
494 ; return (BindStmt pat' rhs' bind_op' fail_op', thing) }
497 tcDoStmt ctxt (ExprStmt rhs then_op _) res_ty thing_inside
498 = do { (rhs', rhs_ty) <- tcInferRho rhs
500 -- Deal with rebindable syntax; (>>) :: rhs_ty -> new_res_ty -> res_ty
501 ; (then_op', new_res_ty) <-
502 withBox liftedTypeKind $ \ new_res_ty ->
503 tcSyntaxOp DoOrigin then_op
504 (mkFunTys [rhs_ty, new_res_ty] res_ty)
506 ; thing <- thing_inside new_res_ty
507 ; return (ExprStmt rhs' then_op' rhs_ty, thing) }
509 tcDoStmt ctxt (RecStmt {}) res_ty thing_inside
510 = failWithTc (ptext SLIT("Illegal 'rec' stmt in") <+> pprStmtContext ctxt)
511 -- This case can't be caught in the renamer
512 -- see RnExpr.checkRecStmt
514 tcDoStmt ctxt stmt res_ty thing_inside
515 = pprPanic "tcDoStmt: unexpected Stmt" (ppr stmt)
517 --------------------------------
519 -- The distinctive features here are
521 -- (b) no rebindable syntax
523 tcMDoStmt :: (LHsExpr Name -> TcM (LHsExpr TcId, TcType)) -- RHS inference
525 tcMDoStmt tc_rhs ctxt (BindStmt pat rhs bind_op fail_op) res_ty thing_inside
526 = do { (rhs', pat_ty) <- tc_rhs rhs
527 ; (pat', thing) <- tcLamPat pat pat_ty res_ty thing_inside
528 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
530 tcMDoStmt tc_rhs ctxt (ExprStmt rhs then_op _) res_ty thing_inside
531 = do { (rhs', elt_ty) <- tc_rhs rhs
532 ; thing <- thing_inside res_ty
533 ; return (ExprStmt rhs' noSyntaxExpr elt_ty, thing) }
535 tcMDoStmt tc_rhs ctxt (RecStmt stmts laterNames recNames _ _) res_ty thing_inside
536 = do { rec_tys <- newFlexiTyVarTys (length recNames) liftedTypeKind
537 ; let rec_ids = zipWith mkLocalId recNames rec_tys
538 ; tcExtendIdEnv rec_ids $ do
539 { (stmts', (later_ids, rec_rets))
540 <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts res_ty $ \ res_ty' ->
541 -- ToDo: res_ty not really right
542 do { rec_rets <- zipWithM tc_ret recNames rec_tys
543 ; later_ids <- tcLookupLocalIds laterNames
544 ; return (later_ids, rec_rets) }
546 ; (thing,lie) <- tcExtendIdEnv later_ids (getLIE (thing_inside res_ty))
547 -- NB: The rec_ids for the recursive things
548 -- already scope over this part. This binding may shadow
549 -- some of them with polymorphic things with the same Name
550 -- (see note [RecStmt] in HsExpr)
551 ; lie_binds <- bindInstsOfLocalFuns lie later_ids
553 ; return (RecStmt stmts' later_ids rec_ids rec_rets lie_binds, thing)
556 -- Unify the types of the "final" Ids with those of "knot-tied" Ids
557 tc_ret rec_name mono_ty
558 = do { poly_id <- tcLookupId rec_name
559 -- poly_id may have a polymorphic type
560 -- but mono_ty is just a monomorphic type variable
561 ; co_fn <- tcSubExp DoOrigin (idType poly_id) mono_ty
562 ; return (mkHsWrap co_fn (HsVar poly_id)) }
564 tcMDoStmt tc_rhs ctxt stmt res_ty thing_inside
565 = pprPanic "tcMDoStmt: unexpected Stmt" (ppr stmt)
570 %************************************************************************
572 \subsection{Errors and contexts}
574 %************************************************************************
576 @sameNoOfArgs@ takes a @[RenamedMatch]@ and decides whether the same
577 number of args are used in each equation.
580 checkArgs :: Name -> MatchGroup Name -> TcM ()
581 checkArgs fun (MatchGroup (match1:matches) _)
582 | null bad_matches = return ()
584 = failWithTc (vcat [ptext SLIT("Equations for") <+> quotes (ppr fun) <+>
585 ptext SLIT("have different numbers of arguments"),
586 nest 2 (ppr (getLoc match1)),
587 nest 2 (ppr (getLoc (head bad_matches)))])
589 n_args1 = args_in_match match1
590 bad_matches = [m | m <- matches, args_in_match m /= n_args1]
592 args_in_match :: LMatch Name -> Int
593 args_in_match (L _ (Match pats _ _)) = length pats
594 checkArgs fun other = panic "TcPat.checkArgs" -- Matches always non-empty
598 matchCtxt ctxt match = hang (ptext SLIT("In") <+> pprMatchContext ctxt <> colon)
599 4 (pprMatch ctxt match)
601 stmtCtxt ctxt stmt = hang (ptext SLIT("In a stmt of") <+> pprStmtContext ctxt <> colon)