Fall back to types when looking up data constructors (#18740)wip/ghc-18740-lookup-update

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:
    • Illegal term-level use of the type constructor ‘Int’
        imported from ‘Prelude’ (and originally defined in ‘GHC.Types’)
    • In the first argument of ‘id’, namely ‘Int’
      In the expression: id Int

We also do this for type variables.

19 files changed, 190 insertions, 21 deletions

diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index d10ee63995..264fbd26f9 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -2247,8 +2247,11 @@ repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
 
 --------------- Expressions -----------------
 repVarOrCon :: Name -> Core TH.Name -> MetaM (Core (M TH.Exp))
-repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
-                   | otherwise                  = repVar str
+repVarOrCon vc str
+    | isVarNameSpace ns = repVar str  -- Both type and term variables (#18740)
+    | otherwise         = repCon str
+  where
+    ns = nameNameSpace vc
 
 repVar :: Core TH.Name -> MetaM (Core (M TH.Exp))
 repVar (MkC s) = rep2 varEName [s]
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 0a1d7a08cd..f497792c33 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP            #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-
 (c) The GRASP/AQUA Project, Glasgow University, 1992-2006
@@ -1006,6 +1007,17 @@ lookup_demoted rdr_name
            , text "instead of"
            , quotes (ppr name) <> dot ]
 
+-- If the given RdrName can be promoted to the type level and its promoted variant is in scope,
+-- lookup_promoted returns the corresponding type-level Name.
+-- Otherwise, the function returns Nothing.
+-- 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:"
@@ -1041,6 +1053,26 @@ 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 (#18740).
+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
+  • Illegal term-level use of the type constructor ‘Int’
+      imported from ‘Prelude’ (and originally defined in ‘GHC.Types’)
+  • In the first argument of ‘id’, namely ‘Int’
+    In the expression: id Int
+    In an equation for ‘x’: x = id Int
+
+when the user writes the following declaration
+
+  x = id Int
 -}
 
 lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName
@@ -1055,14 +1087,22 @@ 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].
+                        -- We try looking up the name as a
+                        -- type constructor or type variable, if
+                        -- we failed to look up the name at the term level.
+           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 312962a889..783e4b3773 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -755,6 +755,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
@@ -772,9 +773,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)
@@ -1144,4 +1167,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 83037a0704..b3d3b0855d 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
@@ -208,13 +209,21 @@ pprNameSpaceBrief TcClsName = text "tc"
 
 -- demoteNameSpace lowers the NameSpace if possible.  We can not know
 -- in advance, since a TvName can appear in an HsTyVar.
--- See Note [Demotion] in GHC.Rename.Env
+-- See Note [Demotion] in GHC.Rename.Env.
 demoteNameSpace :: NameSpace -> Maybe NameSpace
 demoteNameSpace VarName = Nothing
 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] in GHC.Rename.Env.
 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] in GHC.Rename.Env.
+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 27f1e20661..a978abb467 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,
 
@@ -182,13 +182,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 647a405bf9..37c934c70f 100644
--- a/testsuite/tests/module/mod132.stderr
+++ b/testsuite/tests/module/mod132.stderr
@@ -1,4 +1,7 @@
 
 mod132.hs:6:7: error:
-    • Data constructor not in scope: Foo
-    • Perhaps you meant variable ‘foo’ (line 6)
+     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
+      In an equation for ‘foo’: foo = Foo
diff --git a/testsuite/tests/module/mod147.stderr b/testsuite/tests/module/mod147.stderr
index 0a4e3fd662..80267f8f24 100644
--- a/testsuite/tests/module/mod147.stderr
+++ b/testsuite/tests/module/mod147.stderr
@@ -1,2 +1,7 @@
 
-mod147.hs:6:5: error: Data constructor not in scope: D :: t0 -> t
+mod147.hs:6:5:
+     Illegal term-level use of the type constructor ‘D’
+        imported from ‘Mod147_A’ at mod147.hs:4:1-15
+        (and originally defined at Mod147_A.hs:3:1-14)
+     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 ad574a619f..8beac36a43 100644
--- a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
@@ -1,3 +1,7 @@
 
-RnStaticPointersFail02.hs:5:12: error:
-    Data constructor not in scope: T
+RnStaticPointersFail02.hs:5:12:
+Illegal term-level use of the type constructor ‘T’
+  defined at RnStaticPointersFail02.hs:7:1
+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 0000000000..b827dbeac8
--- /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 0000000000..2a0463adf0
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T18740a.stderr
@@ -0,0 +1,7 @@
+
+T18740a.hs:3:5: error:
+    • Illegal term-level use of the type constructor ‘Int’
+        imported from ‘Prelude’ at T18740a.hs:1:8-14
+        (and originally defined in ‘GHC.Types’)
+    • 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 0000000000..e2961093a9
--- /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 0000000000..86c6c74961
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T18740b.stderr
@@ -0,0 +1,6 @@
+
+T18740b.hs:6:24: error:
+    • Illegal term-level use of the type variable ‘a’
+         bound at T18740b.hs:6:4
+    • 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 2647ac706b..e380a913ad 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, [''])
diff --git a/testsuite/tests/th/T14627.stderr b/testsuite/tests/th/T14627.stderr
index 1db648811b..e9e8486256 100644
--- a/testsuite/tests/th/T14627.stderr
+++ b/testsuite/tests/th/T14627.stderr
@@ -1,2 +1,7 @@
 
-T14627.hs:4:1: error: Data constructor not in scope: Bool
+T14627.hs:4:1:
+Illegal term-level use of the type constructor ‘Bool’
+  imported from ‘Prelude’ at T14627.hs:1:1
+  (and originally defined in ‘GHC.Types’)
+In the expression: Bool
+ In an equation for ‘f’: f = Bool
diff --git a/testsuite/tests/th/T18740c.hs b/testsuite/tests/th/T18740c.hs
new file mode 100644
index 0000000000..825e6faaf0
--- /dev/null
+++ b/testsuite/tests/th/T18740c.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module T18740c where
+
+import Data.Proxy
+import Language.Haskell.TH.Syntax
+
+[d| f (Proxy :: Proxy a) = a |] >>= addTopDecls >> return []
diff --git a/testsuite/tests/th/T18740c.stderr b/testsuite/tests/th/T18740c.stderr
new file mode 100644
index 0000000000..dd718cbf33
--- /dev/null
+++ b/testsuite/tests/th/T18740c.stderr
@@ -0,0 +1,6 @@
+
+T18740c.hs:9:1: error:
+    • Illegal term-level use of the type variable ‘a’
+        bound at T18740c.hs:9:1
+    • In the expression: a
+      In an equation for ‘f’: f (Proxy :: Proxy a) = a
diff --git a/testsuite/tests/th/T18740d.hs b/testsuite/tests/th/T18740d.hs
new file mode 100644
index 0000000000..e828a273e6
--- /dev/null
+++ b/testsuite/tests/th/T18740d.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T18740d where
+
+import Language.Haskell.TH
+
+-- If we used 'ConE' here, then we would expect this error message:
+--
+--   Illegal term-level use of the type constructor ‘Bool’
+--     imported from ‘Prelude’ at T18740d.hs:3:8-14
+--     (and originally defined in ‘GHC.Types’)
+--
+-- But we used 'VarE', so the error message should say:
+--
+--   Illegal variable name: ‘Bool’
+--
+e1 = $(return (VarE ''Bool))
diff --git a/testsuite/tests/th/T18740d.stderr b/testsuite/tests/th/T18740d.stderr
new file mode 100644
index 0000000000..65c9607e88
--- /dev/null
+++ b/testsuite/tests/th/T18740d.stderr
@@ -0,0 +1,5 @@
+
+T18740d.hs:17:7: error:
+    • Illegal variable name: ‘Bool’
+      When splicing a TH expression: GHC.Types.Bool
+    • In the untyped splice: $(return (VarE ''Bool))
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 6dae863564..7e4f389b84 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -515,3 +515,5 @@ test('T18121', normal, compile, [''])
 test('T18123', normal, compile, [''])
 test('T18388', normal, compile, [''])
 test('T18612', normal, compile, [''])
+test('T18740c', normal, compile_fail, [''])
+test('T18740d', normal, compile_fail, [''])