[project @ 2001-05-31 09:46:21 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcMatches.lhs

diff --git a/ghc/compiler/typecheck/TcMatches.lhs b/ghc/compiler/typecheck/TcMatches.lhs
index a972fb7..d6ce7a9 100644 (file)
--- a/ghc/compiler/typecheck/TcMatches.lhs
+++ b/ghc/compiler/typecheck/TcMatches.lhs
@@ -24,7 +24,7 @@ import TcHsSyn                ( TcMatch, TcGRHSs, TcStmt, TcDictBinds, TypecheckedPat )
 import TcMonad
 import TcMonoType      ( kcHsSigTypes, tcScopedTyVars, checkSigTyVars, tcHsSigType, sigPatCtxt )
 import Inst            ( LIE, isEmptyLIE, plusLIE, emptyLIE, plusLIEs, lieToList )
-import TcEnv           ( TcId, tcLookupLocalIds, tcExtendTyVarEnv, tcExtendLocalValEnv, tcExtendGlobalTyVars,
+import TcEnv           ( TcId, tcLookupLocalIds, tcExtendLocalValEnv, tcExtendGlobalTyVars,
                          tcInLocalScope )
 import TcPat           ( tcPat, tcMonoPatBndr, polyPatSig )
 import TcType          ( TcType, newTyVarTy )
@@ -32,7 +32,7 @@ import TcBinds                ( tcBindsAndThen )
 import TcSimplify      ( tcSimplifyCheck, bindInstsOfLocalFuns )
 import TcUnify         ( unifyFunTy, unifyTauTy )
 import Name            ( Name )
-import TysWiredIn      ( boolTy, mkListTy )
+import TysWiredIn      ( boolTy )
 import Id              ( idType )
 import BasicTypes      ( RecFlag(..) )
 import Type            ( tyVarsOfType, isTauTy,  mkFunTy,
@@ -133,7 +133,10 @@ tcMatch :: [(Name,Id)]
        -> TcM (TcMatch, LIE)
 
 tcMatch xve1 match@(Match sig_tvs pats maybe_rhs_sig grhss) expected_ty ctxt
-  = tcMatchPats pats expected_ty tc_grhss      `thenTc` \ ((pats', grhss'), lie, ex_binds) ->
+  = tcAddSrcLoc (getMatchLoc match)            $       -- At one stage I removed this;
+    tcAddErrCtxt (matchCtxt ctxt match)                $       -- I'm not sure why, so I put it back
+    
+    tcMatchPats pats expected_ty tc_grhss      `thenTc` \ ((pats', grhss'), lie, ex_binds) ->
     returnTc (Match [] pats' Nothing (glue_on Recursive ex_binds grhss'), lie)
 
   where
@@ -221,9 +224,9 @@ tcMatchPats pats expected_ty thing_inside
        -- I'm a bit concerned that lie_req1 from an 'inner' pattern in the list
        -- might need (via lie_req2) something made available from an 'outer' 
        -- pattern.  But it's inconvenient to deal with, and I can't find an example
-    tcCheckExistentialPat pat_ids ex_tvs lie_avail lie_req1 rhs_ty     `thenTc` \ (lie_req1', ex_binds) ->
+    tcCheckExistentialPat pat_ids ex_tvs lie_avail lie_req2 rhs_ty     `thenTc` \ (lie_req2', ex_binds) ->
 
-    returnTc (result, lie_req1' `plusLIE` lie_req2, ex_binds)
+    returnTc (result, lie_req1 `plusLIE` lie_req2', ex_binds)
 
 tcAddScopedTyVars :: [RenamedHsType] -> TcM a -> TcM a
 -- Find the not-already-in-scope signature type variables,