[commit: ghc] master: Fix defer-out-of-scope-variables (a211dca)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a211dca8236fb8c7ec632278f761121beeac1438/ghc

>---------------------------------------------------------------

commit a211dca8236fb8c7ec632278f761121beeac1438
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Aug 23 13:55:33 2017 +0100

    Fix defer-out-of-scope-variables
    
    In the hacky code in TcUnify.buildImplication we'd failed to account
    for -fdefer-out-of-scope-variables.  See the new function
    TcUnify.implicationNeeded.
    
    Fixes Trac #14149


>---------------------------------------------------------------

a211dca8236fb8c7ec632278f761121beeac1438
 compiler/typecheck/TcUnify.hs                      | 51 ++++++++++++++--------
 testsuite/tests/typecheck/should_compile/T14149.hs |  8 ++++
 .../tests/typecheck/should_compile/T14149.stderr   |  3 ++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 4 files changed, 46 insertions(+), 17 deletions(-)

diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 5136649..59f8869 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -1144,24 +1144,41 @@ buildImplication :: SkolemInfo
                  -> TcM result
                  -> TcM (Bag Implication, TcEvBinds, result)
 buildImplication skol_info skol_tvs given thing_inside
-  = do { tc_lvl <- getTcLevel
-       ; deferred_type_errors <- goptM Opt_DeferTypeErrors <||>
-                                 goptM Opt_DeferTypedHoles
-       ; if null skol_tvs && null given && (not deferred_type_errors ||
-                                            not (isTopTcLevel tc_lvl))
-         then do { res <- thing_inside
-                 ; return (emptyBag, emptyTcEvBinds, res) }
-      -- Fast path.  We check every function argument with
-      -- tcPolyExpr, which uses tcSkolemise and hence checkConstraints.
-      -- But with the solver producing unlifted equalities, we need
-      -- to have an EvBindsVar for them when they might be deferred to
-      -- runtime. Otherwise, they end up as top-level unlifted bindings,
-      -- which are verboten. See also Note [Deferred errors for coercion holes]
-      -- in TcErrors.
+  = do { implication_needed <- implicationNeeded skol_tvs given
+
+       ; if implication_needed
+         then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside
+                 ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted
+                 ; return (implics, ev_binds, result) }
+
+         else -- Fast path.  We check every function argument with
+              -- tcPolyExpr, which uses tcSkolemise and hence checkConstraints.
+              -- So tihs fast path is well-exercised
+              do { res <- thing_inside
+                 ; return (emptyBag, emptyTcEvBinds, res) } }
+
+implicationNeeded :: [TcTyVar] -> [EvVar] -> TcM Bool
+-- With the solver producing unlifted equalities, we need
+-- to have an EvBindsVar for them when they might be deferred to
+-- runtime. Otherwise, they end up as top-level unlifted bindings,
+-- which are verboten. See also Note [Deferred errors for coercion holes]
+-- in TcErrors.  cf Trac #14149 for an exmample of what goes wrong.
+implicationNeeded skol_tvs given
+  | null skol_tvs
+  , null given
+  = -- Empty skolems and givens
+    do { tc_lvl <- getTcLevel
+       ; if not (isTopTcLevel tc_lvl)  -- No implication needed if we are
+         then return False             -- already inside an implication
          else
-    do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside
-       ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted
-       ; return (implics, ev_binds, result) }}
+    do { dflags <- getDynFlags       -- If any deferral can happen,
+                                     -- we must build an implication
+       ; return (gopt Opt_DeferTypeErrors dflags ||
+                 gopt Opt_DeferTypedHoles dflags ||
+                 gopt Opt_DeferOutOfScopeVariables dflags) } }
+
+  | otherwise     -- Non-empty skolems or givens
+  = return True   -- Definitely need an implication
 
 buildImplicationFor :: TcLevel -> SkolemInfo -> [TcTyVar]
                    -> [EvVar] -> WantedConstraints
diff --git a/testsuite/tests/typecheck/should_compile/T14149.hs b/testsuite/tests/typecheck/should_compile/T14149.hs
new file mode 100644
index 0000000..c23d415
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14149.hs
@@ -0,0 +1,8 @@
+{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-}
+
+module Foo where
+
+import Data.Coerce
+
+f :: Bool
+f = coerce (k :: Int)
diff --git a/testsuite/tests/typecheck/should_compile/T14149.stderr b/testsuite/tests/typecheck/should_compile/T14149.stderr
new file mode 100644
index 0000000..5e5306e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14149.stderr
@@ -0,0 +1,3 @@
+
+T14149.hs:8:13: warning: [-Wdeferred-out-of-scope-variables (in -Wdefault)]
+    Variable not in scope: k :: Int
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index f522b74..13a2719 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -571,3 +571,4 @@ test('T13881', normal, compile, [''])
 test('T13915a', normal, multimod_compile, ['T13915a', '-v0'])
 test('T13915b', normal, compile, [''])
 test('T13984', normal, compile, [''])
+test('T14149', normal, compile, [''])