X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcPat.lhs;h=7cb16debf9b157ab71797aff0fdd89e9debb691a;hp=1e391de4ddc267cc22ca8fbb32e3be8bc6ea712a;hb=b10d7d079ec9c3fc22d4700fe484dd297bddb805;hpb=edeee10702955ca3c53444f2f328b4cce0ab3e32

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 1e391de..7cb16de 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -32,7 +32,6 @@ import Coercion
 import StaticFlags
 import TyCon
 import DataCon
-import VarSet	( emptyVarSet )
 import PrelNames
 import BasicTypes hiding (SuccessFlag(..))
 import DynFlags
@@ -59,14 +58,13 @@ tcLetPat :: TcSigFun -> LetBndrSpec
 tcLetPat sig_fn no_gen pat pat_ty thing_inside
   = tc_lpat pat pat_ty penv thing_inside 
   where
-    penv = PE { pe_res_tvs = emptyVarSet, pe_lazy = True
+    penv = PE { pe_lazy = True
               , pe_ctxt = LetPat sig_fn no_gen }
 
 -----------------
 tcPats :: HsMatchContext Name
        -> [LPat Name]		 -- Patterns,
        -> [TcSigmaType]	         --   and their types
-       -> TcRhoType 		 -- Result type,
        -> TcM a                  --   and the checker for the body
        -> TcM ([LPat TcId], a)
 
@@ -81,39 +79,27 @@ tcPats :: HsMatchContext Name
 --   3. Check the body
 --   4. Check that no existentials escape
 
-tcPats ctxt pats pat_tys res_ty thing_inside
+tcPats ctxt pats pat_tys thing_inside
   = tc_lpats penv pats pat_tys thing_inside
   where
-    penv = PE { pe_res_tvs = tyVarsOfTypes (res_ty : pat_tys)
-              , pe_lazy = False
-              , pe_ctxt = LamPat ctxt }
+    penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt }
 
 tcPat :: HsMatchContext Name
       -> LPat Name -> TcSigmaType 
-      -> TcRhoType             -- Result type
       -> TcM a                 -- Checker for body, given
                                -- its result type
       -> TcM (LPat TcId, a)
-tcPat ctxt pat pat_ty res_ty thing_inside
+tcPat ctxt pat pat_ty thing_inside
   = tc_lpat pat pat_ty penv thing_inside
   where
-    penv = PE { pe_res_tvs = tyVarsOfTypes [res_ty, pat_ty]
-              , pe_lazy = False
-              , pe_ctxt = LamPat ctxt }
+    penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt }
    
 
 -----------------
 data PatEnv
-  = PE { pe_res_tvs :: TcTyVarSet	
-	           -- For existential escape check; see Note [Existential check]
-	      	   -- Nothing <=> inside a "~"
-		   -- Just tvs <=> unification tvs free in the result
-		   -- 	           (which should be made untouchable in
-		   --		    any existentials we encounter in the pattern)
-
-       , pe_lazy :: Bool	-- True <=> lazy context, so no existentials allowed
+  = PE { pe_lazy :: Bool	-- True <=> lazy context, so no existentials allowed
        , pe_ctxt :: PatCtxt   	-- Context in which the whole pattern appears
-    }
+       }
 
 data PatCtxt
   = LamPat   -- Used for lambdas, case etc
@@ -188,7 +174,7 @@ Note [Existential check]
 Lazy patterns can't bind existentials.  They arise in two ways:
   * Let bindings      let { C a b = e } in b
   * Twiddle patterns  f ~(C a b) = e
-The pe_res_tvs field of PatEnv says whether we are inside a lazy
+The pe_lazy field of PatEnv says whether we are inside a lazy
 pattern (perhaps deeply)
 
 If we aren't inside a lazy pattern then we can bind existentials,
@@ -294,7 +280,7 @@ bindInstsOfPatId id thing_inside
   | not (isOverloadedTy (idType id))
   = do { res <- thing_inside; return (res, emptyTcEvBinds) }
   | otherwise
-  = do	{ (res, lie) <- getConstraints thing_inside
+  = do	{ (res, lie) <- captureConstraints thing_inside
 	; binds <- bindLocalMethods lie [id]
 	; return (res, binds) }
 -}
@@ -410,11 +396,12 @@ tc_pat penv (BangPat pat) pat_ty thing_inside
 tc_pat penv lpat@(LazyPat pat) pat_ty thing_inside
   = do	{ (pat', (res, pat_ct)) 
 		<- tc_lpat pat pat_ty (makeLazy penv) $ 
-		   getConstraints thing_inside
+		   captureConstraints thing_inside
 		-- Ignore refined penv', revert to penv
 
 	; emitConstraints pat_ct
-	-- getConstraints/extendConstraintss: see Note [Hopping the LIE in lazy patterns]
+	-- captureConstraints/extendConstraints: 
+        --   see Note [Hopping the LIE in lazy patterns]
 
 	-- Check there are no unlifted types under the lazy pattern
 	; when (any (isUnLiftedType . idType) $ collectPatBinders pat') $
@@ -593,7 +580,7 @@ We can't discharge the Num constraint from dictionaries bound by
 the pattern C!  
 
 So we have to make the constraints from thing_inside "hop around" 
-the pattern.  Hence the getConstraints and emitConstraints.
+the pattern.  Hence the captureConstraints and emitConstraints.
 
 The same thing ensures that equality constraints in a lazy match
 are not made available in the RHS of the match. For example
@@ -735,17 +722,8 @@ tcConPat penv (L con_span con_name) pat_ty arg_pats thing_inside
 		  -- should require the GADT language flag
 
 	; given <- newEvVars theta'
-        ; let free_tvs = pe_res_tvs penv
-		-- Since we have done checkExistentials,
-		-- pe_res_tvs can only be Just at this point
-		--
-		-- Nor do we need pat_ty, because we've put all the
-		-- unification variables in right at the start when
-		-- initialising the PatEnv; and the pattern itself
-		-- only adds skolems.
-
         ; (ev_binds, (arg_pats', res))
-	     <- checkConstraints skol_info free_tvs ex_tvs' given $
+	     <- checkConstraints skol_info ex_tvs' given $
                 tcConArgs data_con arg_tys' arg_pats penv thing_inside
 
         ; let res_pat = ConPatOut { pat_con   = L con_span data_con,