X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=d7708b3b2b8bcb2d16d72b243c66367205dc3885;hb=36104d7a0d66df895c8275e3aa7cfe35a322ff04;hp=d0052d8936e2ff42730bc8062d78e2e2e84e16ff;hpb=f16dbbbe59cf3aa19c5fd384560a1b89076d7bc8;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index d0052d8..d7708b3 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -85,7 +85,8 @@ tcPolyExpr expr res_ty
 tcPolyExprNC expr res_ty 
   | isSigmaTy res_ty
   = do	{ traceTc (text "tcPolyExprNC" <+> ppr res_ty)
-	; (gen_fn, expr') <- tcGen res_ty emptyVarSet Nothing (tcPolyExprNC expr)
+	; (gen_fn, expr') <- tcGen res_ty emptyVarSet Nothing $ \ _ res_ty ->
+			     tcPolyExprNC expr res_ty
 		-- Note the recursive call to tcPolyExpr, because the
 		-- type may have multiple layers of for-alls
 		-- E.g. forall a. Eq a => forall b. Ord b => ....
@@ -200,8 +201,10 @@ tcExpr in_expr@(ExprWithTySig expr sig_ty) res_ty
  = do	{ sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
 
 	-- Remember to extend the lexical type-variable environment
-	; (gen_fn, expr') <- tcGen sig_tc_ty emptyVarSet (Just ExprSigCtxt) $
-			     tcMonoExprNC expr
+	; (gen_fn, expr') <- tcGen sig_tc_ty emptyVarSet (Just ExprSigCtxt) $ \ skol_tvs res_ty ->
+		             tcExtendTyVarEnv2 (hsExplicitTvs sig_ty `zip` mkTyVarTys skol_tvs) $
+				-- See Note [More instantiated than scoped] in TcBinds
+			     tcMonoExprNC expr res_ty
 
 	; co_fn <- tcSubExp ExprSigOrigin sig_tc_ty res_ty
 	; return (mkHsWrap co_fn (ExprWithTySigOut (mkLHsWrap gen_fn expr') sig_ty)) }