From 6e89b7a7e32aae249dd2ab419ed8b08ebac02c46 Mon Sep 17 00:00:00 2001
From: Daniel Rogozin <daniel.rogozin@serokell.io>
Date: Thu, 24 Sep 2020 16:30:59 +0300
Subject: [PATCH] Fall back to types when looking up data constructors (#18740)
Before this patch, referring to a data constructor in a term-level
context led to a scoping error:
ghci> id Int
<interactive>:1:4: error: Data constructor not in scope: Int
After this patch, the renamer falls back to the type namespace
and successfully finds the Int. It is then rejected in the type
checker with a more useful error message:
<interactive>:1:4: error:
Type constructor 'Int' used where a value identifier was expected
We also do this for type variables.
---
compiler/GHC/Rename/Env.hs | 48 +++++++++++++++----
compiler/GHC/Tc/Gen/Head.hs | 24 +++++++++-
compiler/GHC/Types/Name/Occurrence.hs | 18 ++++++-
compiler/GHC/Types/Name/Reader.hs | 12 ++++-
testsuite/tests/module/mod132.stderr | 5 +-
testsuite/tests/module/mod147.stderr | 5 +-
.../should_fail/RnStaticPointersFail02.stderr | 7 ++-
testsuite/tests/rename/should_fail/T18740a.hs | 3 ++
.../tests/rename/should_fail/T18740a.stderr | 5 ++
testsuite/tests/rename/should_fail/T18740b.hs | 6 +++
.../tests/rename/should_fail/T18740b.stderr | 5 ++
testsuite/tests/rename/should_fail/all.T | 2 +
12 files changed, 122 insertions(+), 18 deletions(-)
create mode 100644 testsuite/tests/rename/should_fail/T18740a.hs
create mode 100644 testsuite/tests/rename/should_fail/T18740a.stderr
create mode 100644 testsuite/tests/rename/should_fail/T18740b.hs
create mode 100644 testsuite/tests/rename/should_fail/T18740b.stderr
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 13978bf4f179..4d38cc388548 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names.
-}
-{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-}
+{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-}
module GHC.Rename.Env (
newTopSrcBinder,
@@ -1005,6 +1005,14 @@ lookup_demoted rdr_name
, text "instead of"
, quotes (ppr name) <> dot ]
+-- See Note [Promotion] below.
+lookup_promoted :: RdrName -> RnM (Maybe Name)
+lookup_promoted rdr_name
+ | Just promoted_rdr <- promoteRdrName rdr_name
+ = lookupOccRn_maybe promoted_rdr
+ | otherwise
+ = return Nothing
+
badVarInType :: RdrName -> RnM Name
badVarInType rdr_name
= do { addErr (text "Illegal promoted term variable in a type:"
@@ -1040,6 +1048,23 @@ its namespace to DataName and do a second lookup.
The final result (after the renamer) will be:
HsTyVar ("Zero", DataName)
+
+Note [Promotion]
+~~~~~~~~~~~~~~~
+When the user mentions a type constructor or a type variable in a
+term-level context, then we report that a value identifier was expected
+instead of a type-level one. That makes error messages more precise.
+Previously, such errors contained only the info that a given value was
+out of scope. We promote the namespace of RdrName and look up after that
+(see the functions promotedRdrName and lookup_promoted).
+
+In particular, we have the following error message
+ • Type constructor 'Int' used where a value identifier was expected
+
+when the user writes the following term
+
+ id Int
+
-}
lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName
@@ -1054,14 +1079,19 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id
lookupOccRn_overloaded :: Bool -> RdrName
-> RnM (Maybe (Either Name [Name]))
-lookupOccRn_overloaded overload_ok
- = lookupOccRnX_maybe global_lookup Left
- where
- global_lookup :: RdrName -> RnM (Maybe (Either Name [Name]))
- global_lookup n =
- runMaybeT . msum . map MaybeT $
- [ lookupGlobalOccRn_overloaded overload_ok n
- , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ]
+lookupOccRn_overloaded overload_ok rdr_name
+ = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name
+ ; case mb_name of
+ Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name
+ -- See Note [Promotion].
+ p -> return p }
+
+ where
+ global_lookup :: RdrName -> RnM (Maybe (Either Name [Name]))
+ global_lookup n =
+ runMaybeT . msum . map MaybeT $
+ [ lookupGlobalOccRn_overloaded overload_ok n
+ , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ]
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 530f985a95df..d9e4f4ee91e8 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -751,6 +751,7 @@ 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 occ id
@@ -768,9 +769,31 @@ tc_infer_id id_name
| otherwise
-> nonBidirectionalErr id_name
+ 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
+
_ -> 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
+ 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))
+
occ = nameOccName id_name
return_id id = return (HsVar noExtField (noLoc id), idType id)
@@ -1140,4 +1163,3 @@ addExprCtxt e thing_inside
exprCtxt :: HsExpr GhcRn -> SDoc
exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr))
-
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index 83037a070413..0d5c148ea955 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence (
mkDFunOcc,
setOccNameSpace,
demoteOccName,
+ promoteOccName,
HasOccName(..),
-- ** Derived 'OccName's
@@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing
demoteNameSpace TvName = Nothing
demoteNameSpace TcClsName = Just DataName
+-- promoteNameSpace promotes the NameSpace as follows.
+-- See Note [Promotion] in GHC.Rename.Env
+promoteNameSpace :: NameSpace -> Maybe NameSpace
+promoteNameSpace DataName = Just TcClsName
+promoteNameSpace VarName = Just TvName
+promoteNameSpace TcClsName = Nothing
+promoteNameSpace TvName = Nothing
+
{-
************************************************************************
* *
@@ -336,12 +345,19 @@ mkClsOccFS :: FastString -> OccName
mkClsOccFS = mkOccNameFS clsName
-- demoteOccName lowers the Namespace of OccName.
--- see Note [Demotion]
+-- See Note [Demotion].
demoteOccName :: OccName -> Maybe OccName
demoteOccName (OccName space name) = do
space' <- demoteNameSpace space
return $ OccName space' name
+-- promoteOccName promotes the NameSpace of OccName.
+-- See Note [Promotion].
+promoteOccName :: OccName -> Maybe OccName
+promoteOccName (OccName space name) = do
+ space' <- promoteNameSpace space
+ return $ OccName space' name
+
-- Name spaces are related if there is a chance to mean the one when one writes
-- the other, i.e. variables <-> data constructors and type variables <-> type constructors
nameSpacesRelated :: NameSpace -> NameSpace -> Bool
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 5c56abed9023..90d1aba93070 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -32,7 +32,7 @@ module GHC.Types.Name.Reader (
nameRdrName, getRdrName,
-- ** Destruction
- rdrNameOcc, rdrNameSpace, demoteRdrName,
+ rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName,
isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
@@ -179,13 +179,21 @@ rdrNameSpace :: RdrName -> NameSpace
rdrNameSpace = occNameSpace . rdrNameOcc
-- demoteRdrName lowers the NameSpace of RdrName.
--- see Note [Demotion] in GHC.Types.Name.Occurrence
+-- See Note [Demotion] in GHC.Rename.Env
demoteRdrName :: RdrName -> Maybe RdrName
demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)
demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
demoteRdrName (Orig _ _) = Nothing
demoteRdrName (Exact _) = Nothing
+-- promoteRdrName promotes the NameSpace of RdrName.
+-- See Note [Promotion] in GHC.Rename.Env.
+promoteRdrName :: RdrName -> Maybe RdrName
+promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ)
+promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ)
+promoteRdrName (Orig _ _) = Nothing
+promoteRdrName (Exact _) = Nothing
+
-- These two are the basic constructors
mkRdrUnqual :: OccName -> RdrName
mkRdrUnqual occ = Unqual occ
diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr
index 647a405bf973..e7d6ccc9dccb 100644
--- a/testsuite/tests/module/mod132.stderr
+++ b/testsuite/tests/module/mod132.stderr
@@ -1,4 +1,5 @@
mod132.hs:6:7: error:
- • Data constructor not in scope: Foo
- • Perhaps you meant variable ‘foo’ (line 6)
+ Type constructor ‘Foo’ used where a value identifier was expected
+ In the expression: Foo
+ In an equation for ‘foo’: foo = Foo
diff --git a/testsuite/tests/module/mod147.stderr b/testsuite/tests/module/mod147.stderr
index 0a4e3fd66284..6c9ecc3002dd 100644
--- a/testsuite/tests/module/mod147.stderr
+++ b/testsuite/tests/module/mod147.stderr
@@ -1,2 +1,5 @@
-mod147.hs:6:5: error: Data constructor not in scope: D :: t0 -> t
+mod147.hs:6:5:
+ Type constructor 'D' used where a value identifier was expected
+ In the expression: D 4
+ In an equation for 'x': x = D 4
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
index ad574a619f37..6c09a540d96c 100644
--- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
@@ -1,3 +1,6 @@
-RnStaticPointersFail02.hs:5:12: error:
- Data constructor not in scope: T
+RnStaticPointersFail02.hs:5:12:
+Type constructor ‘T’ used where a value identifier was expected
+In the body of a static form: T
+ In the expression: static T
+ In an equation for ‘f’: f = static T
diff --git a/testsuite/tests/rename/should_fail/T18740a.hs b/testsuite/tests/rename/should_fail/T18740a.hs
new file mode 100644
index 000000000000..b827dbeac84d
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T18740a.hs
@@ -0,0 +1,3 @@
+module T18740a where
+
+x = Int
diff --git a/testsuite/tests/rename/should_fail/T18740a.stderr b/testsuite/tests/rename/should_fail/T18740a.stderr
new file mode 100644
index 000000000000..acf8b28639f8
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T18740a.stderr
@@ -0,0 +1,5 @@
+
+T18740a.hs:3:5: error:
+ • Type constructor ‘Int’ used where a value identifier was expected
+ • In the expression: Int
+ In an equation for ‘x’: x = Int
diff --git a/testsuite/tests/rename/should_fail/T18740b.hs b/testsuite/tests/rename/should_fail/T18740b.hs
new file mode 100644
index 000000000000..e2961093a9df
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T18740b.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module T18740b where
+
+import Data.Proxy
+
+f (Proxy :: Proxy a) = a
diff --git a/testsuite/tests/rename/should_fail/T18740b.stderr b/testsuite/tests/rename/should_fail/T18740b.stderr
new file mode 100644
index 000000000000..890038314bb7
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T18740b.stderr
@@ -0,0 +1,5 @@
+
+T18740b.hs:6:24: error:
+ • Illegal term-level use of the type variable ‘a’
+ • In the expression: a
+ In an equation for ‘f’: f (Proxy :: Proxy a) = a
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index 2647ac706b09..e380a913add2 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, [''])
test('T18145', normal, compile_fail, [''])
test('T18240a', normal, compile_fail, [''])
test('T18240b', normal, compile_fail, [''])
+test('T18740a', normal, compile_fail, [''])
+test('T18740b', normal, compile_fail, [''])
--
GitLab