Fix scoped type variables for expression type signatures

[ghc-hetmet.git] / compiler / rename / RnExpr.lhs

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 735bdc3..2df8e95 100644 (file)
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -23,7 +23,6 @@ import HsSyn
 import RnHsSyn
 import TcRnMonad
 import RnEnv
-import OccName         ( plusOccEnv )
 import RnNames         ( getLocalDeclBinders, extendRdrEnvRn )
 import RnTypes         ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
                          mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, 
@@ -43,7 +42,7 @@ import Name             ( isTyVarName )
 #endif
 import Name            ( Name, nameOccName, nameIsLocalOrFrom )
 import NameSet
-import RdrName         ( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals )
+import RdrName         ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals )
 import LoadIface       ( loadInterfaceForName )
 import UniqFM          ( isNullUFM )
 import UniqSet         ( emptyUniqSet )
@@ -249,9 +248,10 @@ rnExpr (RecordUpd expr rbinds _ _)
             fvExpr `plusFV` fvRbinds)
 
 rnExpr (ExprWithTySig expr pty)
-  = rnLExpr expr               `thenM` \ (expr', fvExpr) ->
-    rnHsTypeFVs doc pty                `thenM` \ (pty', fvTy) ->
-    returnM (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
+  = do { (pty', fvTy) <- rnHsTypeFVs doc pty
+       ; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $
+                            rnLExpr expr
+       ; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
   where 
     doc = text "In an expression type signature"
 
@@ -330,7 +330,7 @@ rnExpr (HsArrForm op fixity cmds)
     returnM (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
 
 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
-       -- DictApp, DictLam, TyApp, TyLam
+       -- HsWrap
 \end{code}
 
 
@@ -968,10 +968,10 @@ mkBreakpointExpr' breakpointFunc scope
              mkScopeArg args = unLoc $ mkExpr undef (map HsVar args)
              msg = srcSpanLit sloc
          return (expr, emptyFVs)
-#endif
 
 srcSpanLit :: SrcSpan -> HsExpr Name
 srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span))))
+#endif
 
 srcSpanPrimLit :: SrcSpan -> HsExpr Name
 srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDoc (ppr span))))