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,
11 tcStmts, tcDoStmts, tcBody,
12 tcDoStmt, tcMDoStmt, tcGuardStmt
15 import {-# SOURCE #-} TcExpr( tcSyntaxOp, tcInferRhoNC, tcMonoExpr, tcPolyExpr )
40 #include "HsVersions.h"
43 %************************************************************************
45 \subsection{tcMatchesFun, tcMatchesCase}
47 %************************************************************************
49 @tcMatchesFun@ typechecks a @[Match]@ list which occurs in a
50 @FunMonoBind@. The second argument is the name of the function, which
51 is used in error messages. It checks that all the equations have the
52 same number of arguments before using @tcMatches@ to do the work.
55 tcMatchesFun :: Name -> Bool
57 -> BoxyRhoType -- Expected type of function
58 -> TcM (HsWrapper, MatchGroup TcId) -- Returns type of body
60 tcMatchesFun fun_name inf matches exp_ty
61 = do { -- Check that they all have the same no of arguments
62 -- Location is in the monad, set the caller so that
63 -- any inter-equation error messages get some vaguely
64 -- sensible location. Note: we have to do this odd
65 -- ann-grabbing, because we don't always have annotations in
66 -- hand when we call tcMatchesFun...
67 checkArgs fun_name matches
69 -- ToDo: Don't use "expected" stuff if there ain't a type signature
70 -- because inconsistency between branches
71 -- may show up as something wrong with the (non-existent) type signature
73 -- This is one of two places places we call subFunTys
74 -- The point is that if expected_y is a "hole", we want
75 -- to make pat_tys and rhs_ty as "holes" too.
76 ; subFunTys doc n_pats exp_ty (Just (FunSigCtxt fun_name)) $ \ pat_tys rhs_ty ->
77 tcMatches match_ctxt pat_tys rhs_ty matches
80 doc = ptext (sLit "The equation(s) for") <+> quotes (ppr fun_name)
81 <+> ptext (sLit "have") <+> speakNOf n_pats (ptext (sLit "argument"))
82 n_pats = matchGroupArity matches
83 match_ctxt = MC { mc_what = FunRhs fun_name inf, mc_body = tcBody }
86 @tcMatchesCase@ doesn't do the argument-count check because the
87 parser guarantees that each equation has exactly one argument.
90 tcMatchesCase :: TcMatchCtxt -- Case context
91 -> TcRhoType -- Type of scrutinee
92 -> MatchGroup Name -- The case alternatives
93 -> BoxyRhoType -- Type of whole case expressions
94 -> TcM (MatchGroup TcId) -- Translated alternatives
96 tcMatchesCase ctxt scrut_ty matches res_ty
97 | isEmptyMatchGroup matches
98 = -- Allow empty case expressions
99 do { -- Make sure we follow the invariant that res_ty is filled in
100 res_ty' <- refineBoxToTau res_ty
101 ; return (MatchGroup [] (mkFunTys [scrut_ty] res_ty')) }
104 = tcMatches ctxt [scrut_ty] res_ty matches
106 tcMatchLambda :: MatchGroup Name -> BoxyRhoType -> TcM (HsWrapper, MatchGroup TcId)
107 tcMatchLambda match res_ty
108 = subFunTys doc n_pats res_ty Nothing $ \ pat_tys rhs_ty ->
109 tcMatches match_ctxt pat_tys rhs_ty match
111 n_pats = matchGroupArity match
112 doc = sep [ ptext (sLit "The lambda expression")
113 <+> quotes (pprSetDepth (PartWay 1) $
114 pprMatches (LambdaExpr :: HsMatchContext Name) match),
115 -- The pprSetDepth makes the abstraction print briefly
116 ptext (sLit "has") <+> speakNOf n_pats (ptext (sLit "argument"))]
117 match_ctxt = MC { mc_what = LambdaExpr,
121 @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
124 tcGRHSsPat :: GRHSs Name -> BoxyRhoType -> TcM (GRHSs TcId)
125 -- Used for pattern bindings
126 tcGRHSsPat grhss res_ty = tcGRHSs match_ctxt grhss res_ty
128 match_ctxt = MC { mc_what = PatBindRhs,
133 %************************************************************************
137 %************************************************************************
140 tcMatches :: TcMatchCtxt
141 -> [BoxySigmaType] -- Expected pattern types
142 -> BoxyRhoType -- Expected result-type of the Match.
144 -> TcM (MatchGroup TcId)
146 data TcMatchCtxt -- c.f. TcStmtCtxt, also in this module
147 = MC { mc_what :: HsMatchContext Name, -- What kind of thing this is
148 mc_body :: LHsExpr Name -- Type checker for a body of
151 -> TcM (LHsExpr TcId) }
153 tcMatches ctxt pat_tys rhs_ty (MatchGroup matches _)
154 = ASSERT( not (null matches) ) -- Ensure that rhs_ty is filled in
155 do { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
156 ; return (MatchGroup matches' (mkFunTys pat_tys rhs_ty)) }
159 tcMatch :: TcMatchCtxt
160 -> [BoxySigmaType] -- Expected pattern types
161 -> BoxyRhoType -- Expected result-type of the Match.
165 tcMatch ctxt pat_tys rhs_ty match
166 = wrapLocM (tc_match ctxt pat_tys rhs_ty) match
168 tc_match ctxt pat_tys rhs_ty match@(Match pats maybe_rhs_sig grhss)
169 = add_match_ctxt match $
170 do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys rhs_ty $
171 tc_grhss ctxt maybe_rhs_sig grhss
172 ; return (Match pats' Nothing grhss') }
174 tc_grhss ctxt Nothing grhss rhs_ty
175 = tcGRHSs ctxt grhss rhs_ty -- No result signature
177 -- Result type sigs are no longer supported
178 tc_grhss _ (Just {}) _ _
179 = panic "tc_ghrss" -- Rejected by renamer
181 -- For (\x -> e), tcExpr has already said "In the expresssion \x->e"
182 -- so we don't want to add "In the lambda abstraction \x->e"
183 add_match_ctxt match thing_inside
184 = case mc_what ctxt of
185 LambdaExpr -> thing_inside
186 m_ctxt -> addErrCtxt (pprMatchInCtxt m_ctxt match) thing_inside
189 tcGRHSs :: TcMatchCtxt -> GRHSs Name -> BoxyRhoType
192 -- Notice that we pass in the full res_ty, so that we get
193 -- good inference from simple things like
194 -- f = \(x::forall a.a->a) -> <stuff>
195 -- We used to force it to be a monotype when there was more than one guard
196 -- but we don't need to do that any more
198 tcGRHSs ctxt (GRHSs grhss binds) res_ty
199 = do { (binds', grhss') <- tcLocalBinds binds $
200 mapM (wrapLocM (tcGRHS ctxt res_ty)) grhss
202 ; return (GRHSs grhss' binds') }
205 tcGRHS :: TcMatchCtxt -> BoxyRhoType -> GRHS Name -> TcM (GRHS TcId)
207 tcGRHS ctxt res_ty (GRHS guards rhs)
208 = do { (guards', rhs') <- tcStmts stmt_ctxt tcGuardStmt guards res_ty $
210 ; return (GRHS guards' rhs') }
212 stmt_ctxt = PatGuard (mc_what ctxt)
216 %************************************************************************
218 \subsection{@tcDoStmts@ typechecks a {\em list} of do statements}
220 %************************************************************************
223 tcDoStmts :: HsStmtContext Name
227 -> TcM (HsExpr TcId) -- Returns a HsDo
228 tcDoStmts ListComp stmts body res_ty
229 = do { (elt_ty, coi) <- boxySplitListTy res_ty
230 ; (stmts', body') <- tcStmts ListComp (tcLcStmt listTyCon) stmts
233 ; return $ mkHsWrapCoI coi
234 (HsDo ListComp stmts' body' (mkListTy elt_ty)) }
236 tcDoStmts PArrComp stmts body res_ty
237 = do { (elt_ty, coi) <- boxySplitPArrTy res_ty
238 ; (stmts', body') <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts
241 ; return $ mkHsWrapCoI coi
242 (HsDo PArrComp stmts' body' (mkPArrTy elt_ty)) }
244 tcDoStmts DoExpr stmts body res_ty
245 = do { (stmts', body') <- tcStmts DoExpr tcDoStmt stmts
248 ; return (HsDo DoExpr stmts' body' res_ty) }
250 tcDoStmts ctxt@(MDoExpr _) stmts body res_ty
251 = do { ((m_ty, elt_ty), coi) <- boxySplitAppTy res_ty
252 ; let res_ty' = mkAppTy m_ty elt_ty -- The boxySplit consumes res_ty
253 tc_rhs rhs = withBox liftedTypeKind $ \ pat_ty ->
254 tcMonoExpr rhs (mkAppTy m_ty pat_ty)
256 ; (stmts', body') <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts
260 ; let names = [mfixName, bindMName, thenMName, returnMName, failMName]
261 ; insts <- mapM (newMethodFromName DoOrigin m_ty) names
264 (HsDo (MDoExpr (names `zip` insts)) stmts' body' res_ty') }
266 tcDoStmts ctxt _ _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)
268 tcBody :: LHsExpr Name -> BoxyRhoType -> TcM (LHsExpr TcId)
270 = do { traceTc (text "tcBody" <+> ppr res_ty)
271 ; body' <- tcMonoExpr body res_ty
277 %************************************************************************
281 %************************************************************************
285 = forall thing. HsStmtContext Name
287 -> BoxyRhoType -- Result type for comprehension
288 -> (BoxyRhoType -> TcM thing) -- Checker for what follows the stmt
289 -> TcM (Stmt TcId, thing)
291 tcStmts :: HsStmtContext Name
292 -> TcStmtChecker -- NB: higher-rank type
295 -> (BoxyRhoType -> TcM thing)
296 -> TcM ([LStmt TcId], thing)
298 -- Note the higher-rank type. stmt_chk is applied at different
299 -- types in the equations for tcStmts
301 tcStmts _ _ [] res_ty thing_inside
302 = do { thing <- thing_inside res_ty
303 ; return ([], thing) }
305 -- LetStmts are handled uniformly, regardless of context
306 tcStmts ctxt stmt_chk (L loc (LetStmt binds) : stmts) res_ty thing_inside
307 = do { (binds', (stmts',thing)) <- tcLocalBinds binds $
308 tcStmts ctxt stmt_chk stmts res_ty thing_inside
309 ; return (L loc (LetStmt binds') : stmts', thing) }
311 -- For the vanilla case, handle the location-setting part
312 tcStmts ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside
313 = do { (stmt', (stmts', thing)) <-
315 addErrCtxt (pprStmtInCtxt ctxt stmt) $
316 stmt_chk ctxt stmt res_ty $ \ res_ty' ->
318 tcStmts ctxt stmt_chk stmts res_ty' $
320 ; return (L loc stmt' : stmts', thing) }
322 --------------------------------
324 tcGuardStmt :: TcStmtChecker
325 tcGuardStmt _ (ExprStmt guard _ _) res_ty thing_inside
326 = do { guard' <- tcMonoExpr guard boolTy
327 ; thing <- thing_inside res_ty
328 ; return (ExprStmt guard' noSyntaxExpr boolTy, thing) }
330 tcGuardStmt ctxt (BindStmt pat rhs _ _) res_ty thing_inside
331 = do { (rhs', rhs_ty) <- tcInferRhoNC rhs -- Stmt has a context already
332 ; (pat', thing) <- tcPat (StmtCtxt ctxt) pat rhs_ty res_ty thing_inside
333 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
335 tcGuardStmt _ stmt _ _
336 = pprPanic "tcGuardStmt: unexpected Stmt" (ppr stmt)
339 --------------------------------
340 -- List comprehensions and PArrays
342 tcLcStmt :: TyCon -- The list/Parray type constructor ([] or PArray)
345 -- A generator, pat <- rhs
346 tcLcStmt m_tc ctxt (BindStmt pat rhs _ _) res_ty thing_inside
347 = do { (rhs', pat_ty) <- withBox liftedTypeKind $ \ ty ->
348 tcMonoExpr rhs (mkTyConApp m_tc [ty])
349 ; (pat', thing) <- tcPat (StmtCtxt ctxt) pat pat_ty res_ty thing_inside
350 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
353 tcLcStmt _ _ (ExprStmt rhs _ _) res_ty thing_inside
354 = do { rhs' <- tcMonoExpr rhs boolTy
355 ; thing <- thing_inside res_ty
356 ; return (ExprStmt rhs' noSyntaxExpr boolTy, thing) }
358 -- A parallel set of comprehensions
359 -- [ (g x, h x) | ... ; let g v = ...
360 -- | ... ; let h v = ... ]
362 -- It's possible that g,h are overloaded, so we need to feed the LIE from the
363 -- (g x, h x) up through both lots of bindings (so we get the bindInstsOfLocalFuns).
364 -- Similarly if we had an existential pattern match:
366 -- data T = forall a. Show a => C a
368 -- [ (show x, show y) | ... ; C x <- ...
369 -- | ... ; C y <- ... ]
371 -- Then we need the LIE from (show x, show y) to be simplified against
372 -- the bindings for x and y.
374 -- It's difficult to do this in parallel, so we rely on the renamer to
375 -- ensure that g,h and x,y don't duplicate, and simply grow the environment.
376 -- So the binders of the first parallel group will be in scope in the second
377 -- group. But that's fine; there's no shadowing to worry about.
379 tcLcStmt m_tc ctxt (ParStmt bndr_stmts_s) elt_ty thing_inside
380 = do { (pairs', thing) <- loop bndr_stmts_s
381 ; return (ParStmt pairs', thing) }
383 -- loop :: [([LStmt Name], [Name])] -> TcM ([([LStmt TcId], [TcId])], thing)
384 loop [] = do { thing <- thing_inside elt_ty
385 ; return ([], thing) } -- matching in the branches
387 loop ((stmts, names) : pairs)
388 = do { (stmts', (ids, pairs', thing))
389 <- tcStmts ctxt (tcLcStmt m_tc) stmts elt_ty $ \ _elt_ty' ->
390 do { ids <- tcLookupLocalIds names
391 ; (pairs', thing) <- loop pairs
392 ; return (ids, pairs', thing) }
393 ; return ( (stmts', ids) : pairs', thing ) }
395 tcLcStmt m_tc ctxt (TransformStmt (stmts, binders) usingExpr maybeByExpr) elt_ty thing_inside = do
396 (stmts', (binders', usingExpr', maybeByExpr', thing)) <-
397 tcStmts (TransformStmtCtxt ctxt) (tcLcStmt m_tc) stmts elt_ty $ \elt_ty' -> do
398 let alphaListTy = mkTyConApp m_tc [alphaTy]
400 (usingExpr', maybeByExpr') <-
403 -- We must validate that usingExpr :: forall a. [a] -> [a]
404 usingExpr' <- tcPolyExpr usingExpr (mkForAllTy alphaTyVar (alphaListTy `mkFunTy` alphaListTy))
405 return (usingExpr', Nothing)
407 -- We must infer a type such that e :: t and then check that usingExpr :: forall a. (a -> t) -> [a] -> [a]
408 (byExpr', tTy) <- tcInferRhoNC byExpr
409 usingExpr' <- tcPolyExpr usingExpr (mkForAllTy alphaTyVar ((alphaTy `mkFunTy` tTy) `mkFunTy` (alphaListTy `mkFunTy` alphaListTy)))
410 return (usingExpr', Just byExpr')
412 binders' <- tcLookupLocalIds binders
413 thing <- thing_inside elt_ty'
415 return (binders', usingExpr', maybeByExpr', thing)
417 return (TransformStmt (stmts', binders') usingExpr' maybeByExpr', thing)
419 tcLcStmt m_tc ctxt (GroupStmt (stmts, bindersMap) groupByClause) elt_ty thing_inside = do
420 (stmts', (bindersMap', groupByClause', thing)) <-
421 tcStmts (TransformStmtCtxt ctxt) (tcLcStmt m_tc) stmts elt_ty $ \elt_ty' -> do
422 let alphaListTy = mkTyConApp m_tc [alphaTy]
423 alphaListListTy = mkTyConApp m_tc [alphaListTy]
426 case groupByClause of
427 GroupByNothing usingExpr ->
428 -- We must validate that usingExpr :: forall a. [a] -> [[a]]
429 tcPolyExpr usingExpr (mkForAllTy alphaTyVar (alphaListTy `mkFunTy` alphaListListTy)) >>= (return . GroupByNothing)
430 GroupBySomething eitherUsingExpr byExpr -> do
431 -- We must infer a type such that byExpr :: t
432 (byExpr', tTy) <- tcInferRhoNC byExpr
434 -- If it exists, we then check that usingExpr :: forall a. (a -> t) -> [a] -> [[a]]
435 let expectedUsingType = mkForAllTy alphaTyVar ((alphaTy `mkFunTy` tTy) `mkFunTy` (alphaListTy `mkFunTy` alphaListListTy))
437 case eitherUsingExpr of
438 Left usingExpr -> (tcPolyExpr usingExpr expectedUsingType) >>= (return . Left)
439 Right usingExpr -> (tcPolyExpr (noLoc usingExpr) expectedUsingType) >>= (return . Right . unLoc)
440 return $ GroupBySomething eitherUsingExpr' byExpr'
442 -- Find the IDs and types of all old binders
443 let (oldBinders, newBinders) = unzip bindersMap
444 oldBinders' <- tcLookupLocalIds oldBinders
446 -- Ensure that every old binder of type b is linked up with its new binder which should have type [b]
447 let newBinders' = zipWith associateNewBinder oldBinders' newBinders
449 -- Type check the thing in the environment with these new binders and return the result
450 thing <- tcExtendIdEnv newBinders' (thing_inside elt_ty')
451 return (zipEqual "tcLcStmt: Old and new binder lists were not of the same length" oldBinders' newBinders', groupByClause', thing)
453 return (GroupStmt (stmts', bindersMap') groupByClause', thing)
455 associateNewBinder :: TcId -> Name -> TcId
456 associateNewBinder oldBinder newBinder = mkLocalId newBinder (mkTyConApp m_tc [idType oldBinder])
458 tcLcStmt _ _ stmt _ _
459 = pprPanic "tcLcStmt: unexpected Stmt" (ppr stmt)
461 --------------------------------
463 -- The main excitement here is dealing with rebindable syntax
465 tcDoStmt :: TcStmtChecker
467 tcDoStmt ctxt (BindStmt pat rhs bind_op fail_op) res_ty thing_inside
468 = do { (rhs', rhs_ty) <- tcInferRhoNC rhs
469 -- We should use type *inference* for the RHS computations,
471 -- do { pat <- rhs; <rest> }
473 -- case rhs of { pat -> <rest> }
474 -- We do inference on rhs, so that information about its type
475 -- can be refined when type-checking the pattern.
477 -- Deal with rebindable syntax:
478 -- (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty
479 -- This level of generality is needed for using do-notation
480 -- in full generality; see Trac #1537
481 ; ((bind_op', new_res_ty), pat_ty) <-
482 withBox liftedTypeKind $ \ pat_ty ->
483 withBox liftedTypeKind $ \ new_res_ty ->
484 tcSyntaxOp DoOrigin bind_op
485 (mkFunTys [rhs_ty, mkFunTy pat_ty new_res_ty] res_ty)
487 -- If (but only if) the pattern can fail,
488 -- typecheck the 'fail' operator
489 ; fail_op' <- if isIrrefutableHsPat pat
490 then return noSyntaxExpr
491 else tcSyntaxOp DoOrigin fail_op (mkFunTy stringTy new_res_ty)
493 ; (pat', thing) <- tcPat (StmtCtxt ctxt) pat pat_ty new_res_ty thing_inside
495 ; return (BindStmt pat' rhs' bind_op' fail_op', thing) }
498 tcDoStmt _ (ExprStmt rhs then_op _) res_ty thing_inside
499 = do { (rhs', rhs_ty) <- tcInferRhoNC rhs
501 -- Deal with rebindable syntax; (>>) :: rhs_ty -> new_res_ty -> res_ty
502 ; (then_op', new_res_ty) <-
503 withBox liftedTypeKind $ \ new_res_ty ->
504 tcSyntaxOp DoOrigin then_op
505 (mkFunTys [rhs_ty, new_res_ty] res_ty)
507 ; thing <- thing_inside new_res_ty
508 ; return (ExprStmt rhs' then_op' rhs_ty, thing) }
510 tcDoStmt ctxt (RecStmt {}) _ _
511 = failWithTc (ptext (sLit "Illegal 'rec' stmt in") <+> pprStmtContext ctxt)
512 -- This case can't be caught in the renamer
513 -- see RnExpr.checkRecStmt
516 = pprPanic "tcDoStmt: unexpected Stmt" (ppr stmt)
518 --------------------------------
520 -- The distinctive features here are
522 -- (b) no rebindable syntax
524 tcMDoStmt :: (LHsExpr Name -> TcM (LHsExpr TcId, TcType)) -- RHS inference
526 tcMDoStmt tc_rhs ctxt (BindStmt pat rhs _ _) res_ty thing_inside
527 = do { (rhs', pat_ty) <- tc_rhs rhs
528 ; (pat', thing) <- tcPat (StmtCtxt ctxt) pat pat_ty res_ty thing_inside
529 ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
531 tcMDoStmt tc_rhs _ (ExprStmt rhs _ _) res_ty thing_inside
532 = do { (rhs', elt_ty) <- tc_rhs rhs
533 ; thing <- thing_inside res_ty
534 ; return (ExprStmt rhs' noSyntaxExpr elt_ty, thing) }
536 tcMDoStmt tc_rhs ctxt (RecStmt stmts laterNames recNames _ _) res_ty thing_inside
537 = do { rec_tys <- newFlexiTyVarTys (length recNames) liftedTypeKind
538 ; let rec_ids = zipWith mkLocalId recNames rec_tys
539 ; tcExtendIdEnv rec_ids $ do
540 { (stmts', (later_ids, rec_rets))
541 <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts res_ty $ \ _res_ty' ->
542 -- ToDo: res_ty not really right
543 do { rec_rets <- zipWithM tc_ret recNames rec_tys
544 ; later_ids <- tcLookupLocalIds laterNames
545 ; return (later_ids, rec_rets) }
547 ; (thing,lie) <- tcExtendIdEnv later_ids (getLIE (thing_inside res_ty))
548 -- NB: The rec_ids for the recursive things
549 -- already scope over this part. This binding may shadow
550 -- some of them with polymorphic things with the same Name
551 -- (see note [RecStmt] in HsExpr)
552 ; lie_binds <- bindInstsOfLocalFuns lie later_ids
554 ; return (RecStmt stmts' later_ids rec_ids rec_rets lie_binds, thing)
557 -- Unify the types of the "final" Ids with those of "knot-tied" Ids
558 tc_ret rec_name mono_ty
559 = do { poly_id <- tcLookupId rec_name
560 -- poly_id may have a polymorphic type
561 -- but mono_ty is just a monomorphic type variable
562 ; co_fn <- tcSubExp DoOrigin (idType poly_id) mono_ty
563 ; return (mkHsWrap co_fn (HsVar poly_id)) }
565 tcMDoStmt _ _ stmt _ _
566 = pprPanic "tcMDoStmt: unexpected Stmt" (ppr stmt)
571 %************************************************************************
573 \subsection{Errors and contexts}
575 %************************************************************************
577 @sameNoOfArgs@ takes a @[RenamedMatch]@ and decides whether the same
578 number of args are used in each equation.
581 checkArgs :: Name -> MatchGroup Name -> TcM ()
582 checkArgs fun (MatchGroup (match1:matches) _)
583 | null bad_matches = return ()
585 = failWithTc (vcat [ptext (sLit "Equations for") <+> quotes (ppr fun) <+>
586 ptext (sLit "have different numbers of arguments"),
587 nest 2 (ppr (getLoc match1)),
588 nest 2 (ppr (getLoc (head bad_matches)))])
590 n_args1 = args_in_match match1
591 bad_matches = [m | m <- matches, args_in_match m /= n_args1]
593 args_in_match :: LMatch Name -> Int
594 args_in_match (L _ (Match pats _ _)) = length pats
595 checkArgs _ _ = panic "TcPat.checkArgs" -- Matches always non-empty