diff options
| -rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 19 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnMonad.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcSimplify.hs | 17 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T13466.stderr | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T16376.script | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T16376.stderr | 12 | ||||
| -rwxr-xr-x | 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 fcac5cb33d..9c60709d3c 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 77ea116042..8b720d6b62 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 f50b33efc6..418aa987e4 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 ba3d5fda8f..edd05c5a4d 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 0000000000..7bdc872322 --- /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 0000000000..7b34531569 --- /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 946c6ef954..dd76a07f5c 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']) |