From c26e6dac5feeffbb096070f4f46600090401a0c9 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Fri, 11 Jun 2021 23:14:56 +0300 Subject: Suggest similar names when reporting types in terms (#19978) This fixes an error message regression. --- compiler/GHC/Tc/Gen/Head.hs | 58 ++++++++++++---------- testsuite/tests/module/mod132.stderr | 5 +- testsuite/tests/typecheck/should_fail/T19978.hs | 25 ++++++++++ .../tests/typecheck/should_fail/T19978.stderr | 21 ++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 5 files changed, 83 insertions(+), 27 deletions(-) create mode 100644 testsuite/tests/typecheck/should_fail/T19978.hs create mode 100644 testsuite/tests/typecheck/should_fail/T19978.stderr diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs index f71b424ffa..0e90a22862 100644 --- a/compiler/GHC/Tc/Gen/Head.hs +++ b/compiler/GHC/Tc/Gen/Head.hs @@ -44,6 +44,8 @@ import GHC.Tc.Instance.Family ( tcLookupDataFamInst ) import GHC.Core.FamInstEnv ( FamInstEnvs ) import GHC.Core.UsageEnv ( unitUE ) import GHC.Rename.Utils ( unknownSubordinateErr ) +import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) ) +import GHC.Unit.Module ( getModule ) import GHC.Tc.Errors.Types import GHC.Tc.Solver ( InferMode(..), simplifyInfer ) import GHC.Tc.Utils.Env @@ -702,46 +704,52 @@ tc_infer_assert assert_name tc_infer_id :: Name -> TcM (HsExpr GhcTc, TcSigmaType) tc_infer_id id_name = do { thing <- tcLookup id_name - ; global_env <- getGlobalRdrEnv ; case thing of ATcId { tct_id = id } -> do { check_local_id id ; return_id id } - AGlobal (AnId id) - -> return_id id + AGlobal (AnId id) -> return_id id -- A global cannot possibly be ill-staged -- nor does it need the 'lifting' treatment -- Hence no checkTh stuff here - AGlobal (AConLike cl) -> case cl of - RealDataCon con -> tcInferDataCon con - PatSynCon ps -> tcInferPatSyn id_name ps - - AGlobal (ATyCon ty_con) - -> fail_tycon global_env ty_con - - ATyVar name _ - -> failWithTc $ - text "Illegal term-level use of the type variable" - <+> quotes (ppr name) - $$ nest 2 (text "bound at" <+> ppr (getSrcLoc name)) - - ATcTyCon ty_con - -> fail_tycon global_env ty_con + AGlobal (AConLike (RealDataCon con)) -> tcInferDataCon con + AGlobal (AConLike (PatSynCon ps)) -> tcInferPatSyn id_name ps + AGlobal (ATyCon tc) -> fail_tycon tc + ATcTyCon tc -> fail_tycon tc + ATyVar name _ -> fail_tyvar name _ -> failWithTc $ ppr thing <+> text "used where a value identifier was expected" } where - fail_tycon global_env ty_con = - let pprov = case lookupGRE_Name global_env (tyConName ty_con) of + fail_tycon tc = do + gre <- getGlobalRdrEnv + let msg = text "Illegal term-level use of the type constructor" + <+> quotes (ppr (tyConName tc)) + pprov = case lookupGRE_Name gre (tyConName tc) of Just gre -> nest 2 (pprNameProvenance gre) Nothing -> empty - in failWithTc (term_level_tycons ty_con $$ pprov) - - term_level_tycons ty_con - = text "Illegal term-level use of the type constructor" - <+> quotes (ppr (tyConName ty_con)) + suggestions <- get_suggestions dataName + failWithTc (msg $$ pprov $$ suggestions) + + fail_tyvar name = do + let msg = text "Illegal term-level use of the type variable" + <+> quotes (ppr name) + pprov = nest 2 (text "bound at" <+> ppr (getSrcLoc name)) + suggestions <- get_suggestions varName + failWithTc (msg $$ pprov $$ suggestions) + + get_suggestions ns = do + let occ = mkOccNameFS ns (occNameFS (occName id_name)) + dflags <- getDynFlags + rdr_env <- getGlobalRdrEnv + lcl_env <- getLocalRdrEnv + imp_info <- getImports + curr_mod <- getModule + hpt <- getHpt + return $ unknownNameSuggestions WL_Anything dflags hpt curr_mod rdr_env + lcl_env imp_info (mkRdrUnqual occ) return_id id = return (HsVar noExtField (noLocA id), idType id) diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr index 37c934c70f..31d9c8eeb6 100644 --- a/testsuite/tests/module/mod132.stderr +++ b/testsuite/tests/module/mod132.stderr @@ -1,7 +1,8 @@ mod132.hs:6:7: error: - Illegal term-level use of the type constructor ‘Foo’ + • Illegal term-level use of the type constructor ‘Foo’ imported from ‘Mod132_B’ at mod132.hs:4:1-15 (and originally defined in ‘Mod132_A’ at Mod132_A.hs:3:1-14) - In the expression: Foo + Perhaps you meant variable ‘foo’ (line 6) + • In the expression: Foo In an equation for ‘foo’: foo = Foo diff --git a/testsuite/tests/typecheck/should_fail/T19978.hs b/testsuite/tests/typecheck/should_fail/T19978.hs new file mode 100644 index 0000000000..fd96697db9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T19978.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module T19978 where + +----------------------------------------- +-- Type constructor in terms -- +----------------------------------------- +ex1 = Bool + +-- to be suggested instead of "Bool" in "ex1": +data T1 = Bowl +bool = Bowl + +ex2 = Let -- should suggest Left (imported from Prelude) + +----------------------------------------- +-- Type variable in terms -- +----------------------------------------- + +ex3 :: forall mytv. mytv +ex3 = mytv + +-- to be suggested instead of "mytv" in "ex3": +data T3 = Mytv +myvv = Mytv diff --git a/testsuite/tests/typecheck/should_fail/T19978.stderr b/testsuite/tests/typecheck/should_fail/T19978.stderr new file mode 100644 index 0000000000..7f41c37ad4 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T19978.stderr @@ -0,0 +1,21 @@ + +T19978.hs:8:7: error: + • Illegal term-level use of the type constructor ‘Bool’ + imported from ‘Prelude’ at T19978.hs:3:8-13 + (and originally defined in ‘GHC.Types’) + Perhaps you meant one of these: + ‘Bowl’ (line 11), variable ‘bool’ (line 12) + • In the expression: Bool + In an equation for ‘ex1’: ex1 = Bool + +T19978.hs:14:7: error: + • Data constructor not in scope: Let + • Perhaps you meant ‘Left’ (imported from Prelude) + +T19978.hs:21:7: error: + • Illegal term-level use of the type variable ‘mytv’ + bound at T19978.hs:20:15 + Perhaps you meant one of these: + data constructor ‘Mytv’ (line 24), ‘myvv’ (line 25) + • In the expression: mytv + In an equation for ‘ex3’: ex3 = mytv diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 54af02c6f5..b776f1d5dd 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -631,3 +631,4 @@ test('T19415', normal, compile_fail, ['']) test('T19615', normal, compile_fail, ['']) test('T17817', normal, compile_fail, ['']) test('T17817_elab', normal, compile_fail, ['-fprint-typechecker-elaboration']) +test('T19978', normal, compile_fail, ['']) -- cgit v1.2.1