[commit: ghc] master, wip/T11371: Use captureTopConstraints in TcRnDriver calls (5be7ad7)
git at git.haskell.org
git at git.haskell.org
Sat Mar 9 07:08:59 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branches: master,wip/T11371
Link : http://ghc.haskell.org/trac/ghc/changeset/5be7ad7861c8d39f60b7101fd8d8e816ff50353a/ghc
>---------------------------------------------------------------
commit 5be7ad7861c8d39f60b7101fd8d8e816ff50353a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Thu Mar 7 09:09:13 2019 +0000
Use captureTopConstraints in TcRnDriver calls
Trac #16376 showed the danger of failing to report an error
that exists only in the unsolved constraints, if an exception
is raised (via failM).
Well, the commit 5c1f268e (Fail fast in solveLocalEqualities)
did just that -- i.e. it found errors in the constraints, and
called failM to avoid a misleading cascade.
So we need to be sure to call captureTopConstraints to report
those insolubles. This was wrong in TcRnDriver.tcRnExpr and
in TcRnDriver.tcRnType.
As a result the error messages from test T13466 improved slightly,
a happy outcome.
>---------------------------------------------------------------
5be7ad7861c8d39f60b7101fd8d8e816ff50353a
compiler/typecheck/TcRnDriver.hs | 19 ++++++++++++-------
compiler/typecheck/TcRnMonad.hs | 2 +-
compiler/typecheck/TcSimplify.hs | 17 +++++++++++++++--
testsuite/tests/ghci/scripts/T13466.stderr | 2 ++
testsuite/tests/ghci/scripts/T16376.script | 4 ++++
testsuite/tests/ghci/scripts/T16376.stderr | 12 ++++++++++++
testsuite/tests/ghci/scripts/all.T | 1 +
7 files changed, 47 insertions(+), 10 deletions(-)
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index fcac5cb..9c60709 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -399,8 +399,8 @@ tcRnSrcDecls explicit_mod_hdr decls
-- Check for the 'main' declaration
-- Must do this inside the captureTopConstraints
+ -- NB: always set envs *before* captureTopConstraints
; (tcg_env, lie_main) <- setEnvs (tcg_env, tcl_env) $
- -- always set envs *before* captureTopConstraints
captureTopConstraints $
checkMain explicit_mod_hdr
@@ -502,10 +502,13 @@ run_th_modfinalizers = do
let run_finalizer (lcl_env, f) =
setLclEnv lcl_env (runRemoteModFinalizers f)
- (_, lie_th) <- captureTopConstraints $ mapM_ run_finalizer th_modfinalizers
+ (_, lie_th) <- captureTopConstraints $
+ mapM_ run_finalizer th_modfinalizers
+
-- Finalizers can add top-level declarations with addTopDecls, so
-- we have to run tc_rn_src_decls to get them
(tcg_env, tcl_env, lie_top_decls) <- tc_rn_src_decls []
+
setEnvs (tcg_env, tcl_env) $ do
-- Subsequent rounds of finalizers run after any new constraints are
-- simplified, or some types might not be complete when using reify
@@ -616,11 +619,12 @@ tcRnHsBootDecls hsc_src decls
, hs_defds = def_decls
, hs_ruleds = rule_decls
, hs_annds = _
- , hs_valds
- = XValBindsLR (NValBinds val_binds val_sigs) })
+ , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) })
<- rnTopSrcDecls first_group
+
-- The empty list is for extra dependencies coming from .hs-boot files
-- See Note [Extra dependencies from .hs-boot files] in RnSource
+
; (gbl_env, lie) <- setGblEnv tcg_env $ captureTopConstraints $ do {
-- NB: setGblEnv **before** captureTopConstraints so that
-- if the latter reports errors, it knows what's in scope
@@ -2360,8 +2364,9 @@ tcRnExpr hsc_env mode rdr_expr
uniq <- newUnique ;
let { fresh_it = itName uniq (getLoc rdr_expr)
; orig = lexprCtOrigin rn_expr } ;
- (tclvl, lie, res_ty)
- <- pushLevelAndCaptureConstraints $
+ ((tclvl, res_ty), lie)
+ <- captureTopConstraints $
+ pushTcLevelM $
do { (_tc_expr, expr_ty) <- tcInferSigma rn_expr
; if inst
then snd <$> deeplyInstantiate orig expr_ty
@@ -2430,7 +2435,7 @@ tcRnType hsc_env normalise rdr_type
-- First bring into scope any wildcards
; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type])
; ((ty, kind), lie) <-
- captureConstraints $
+ captureTopConstraints $
tcWildCardBinders wcs $ \ wcs' ->
do { emitWildCardHoleConstraints wcs'
; tcLHsTypeUnsaturated rn_type }
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 77ea116..8b720d6 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -1684,7 +1684,7 @@ Hence:
- insolublesOnly in tryCaptureConstraints
- emitConstraints in the Left case of captureConstraints
-Hover note that fresly-generated constraints like (Int ~ Bool), or
+However note that freshly-generated constraints like (Int ~ Bool), or
((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
insoluble. The constraint solver does that. So they'll be discarded.
That's probably ok; but see th/5358 as a not-so-good example:
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index f50b33e..418aa98 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -81,8 +81,21 @@ captureTopConstraints :: TcM a -> TcM (a, WantedConstraints)
-- generates plus the constraints produced by static forms inside.
-- If it fails with an exception, it reports any insolubles
-- (out of scope variables) before doing so
--- NB: bring any environments into scope before calling this, so that
--- the reportUnsolved has access to the most complete GlobalRdrEnv
+--
+-- captureTopConstraints is used exclusively by TcRnDriver at the top
+-- level of a module.
+--
+-- Importantly, if captureTopConstraints propagates an exception, it
+-- reports any insoluble constraints first, lest they be lost
+-- altogether. This is important, because solveLocalEqualities (maybe
+-- other things too) throws an exception without adding any error
+-- messages; it just puts the unsolved constraints back into the
+-- monad. See TcRnMonad Note [Constraints and errors]
+-- Trac #16376 is an example of what goes wrong if you don't do this.
+--
+-- NB: the caller should bring any environments into scope before
+-- calling this, so that the reportUnsolved has access to the most
+-- complete GlobalRdrEnv
captureTopConstraints thing_inside
= do { static_wc_var <- TcM.newTcRef emptyWC ;
; (mb_res, lie) <- TcM.updGblEnv (\env -> env { tcg_static_wc = static_wc_var } ) $
diff --git a/testsuite/tests/ghci/scripts/T13466.stderr b/testsuite/tests/ghci/scripts/T13466.stderr
index ba3d5fd..edd05c5 100644
--- a/testsuite/tests/ghci/scripts/T13466.stderr
+++ b/testsuite/tests/ghci/scripts/T13466.stderr
@@ -1,4 +1,6 @@
+<interactive>:1:1: error: Variable not in scope: out_of_scope
+
<interactive>:1:1: error:
• Cannot apply expression of type ‘t1’
to a visible type argument ‘[]’
diff --git a/testsuite/tests/ghci/scripts/T16376.script b/testsuite/tests/ghci/scripts/T16376.script
new file mode 100644
index 0000000..7bdc872
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16376.script
@@ -0,0 +1,4 @@
+:set -XTypeApplications -XPolyKinds -XDataKinds
+:t id @Maybe
+type Id (a :: k) = a
+:k Id @Maybe
diff --git a/testsuite/tests/ghci/scripts/T16376.stderr b/testsuite/tests/ghci/scripts/T16376.stderr
new file mode 100644
index 0000000..7b34531
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16376.stderr
@@ -0,0 +1,12 @@
+
+<interactive>:1:5: error:
+ • Expecting one more argument to ‘Maybe’
+ Expected a type, but ‘Maybe’ has kind ‘* -> *’
+ • In the type ‘Maybe’
+ In the expression: id @Maybe
+
+<interactive>:1:5: error:
+ • Expecting one more argument to ‘Maybe’
+ Expected a type, but ‘Maybe’ has kind ‘* -> *’
+ • In the first argument of ‘Id’, namely ‘Maybe’
+ In the type ‘Id @Maybe’
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 946c6ef..dd76a07 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -292,3 +292,4 @@ test('T16030', normal, ghci_script, ['T16030.script'])
test('T11606', normal, ghci_script, ['T11606.script'])
test('T16089', normal, ghci_script, ['T16089.script'])
test('T14828', expect_broken(14828), ghci_script, ['T14828.script'])
+test('T16376', normal, ghci_script, ['T16376.script'])
More information about the ghc-commits
mailing list