[Git][ghc/ghc][master] Parse qualified terms in type signatures
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jan 11 18:44:00 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00
Parse qualified terms in type signatures
This commit allows qualified terms in type
signatures to pass the parser and to be cathced by renamer
with more informative error message. Adds a few tests.
Fixes #21605
- - - - -
16 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error/Codes.hs
- + testsuite/tests/rename/should_fail/T21605a.hs
- + testsuite/tests/rename/should_fail/T21605a.stderr
- + testsuite/tests/rename/should_fail/T21605b.hs
- + testsuite/tests/rename/should_fail/T21605b.stderr
- + testsuite/tests/rename/should_fail/T21605c.hs
- + testsuite/tests/rename/should_fail/T21605c.stderr
- + testsuite/tests/rename/should_fail/T21605d.hs
- + testsuite/tests/rename/should_fail/T21605d.stderr
- testsuite/tests/rename/should_fail/all.T
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2263,6 +2263,10 @@ atype :: { LHsType GhcPs }
| STRING { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1)
(getSTRING $1) }
| '_' { reLocA $ sL1 $1 $ mkAnonWildCardTy }
+ -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer.
+ -- We let it pass the parser because the renamer can generate a better error message.
+ | QVARID {% let qname = mkQual tvName (getQVARID $1)
+ in acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glR $1) [] cs) NotPromoted (sL1n $1 $ qname)))}
-- An inst_type is what occurs in the head of an instance decl
-- e.g. (Foo a, Gaz b) => Wibble a b
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -1097,6 +1097,9 @@ lookup_demoted rdr_name
| otherwise
= star_is_type_hints
; unboundNameX looking_for rdr_name suggestion } }
+ | Just demoted_rdr_name <- demoteRdrNameTv rdr_name,
+ isQual rdr_name
+ = report_qualified_term_in_types rdr_name demoted_rdr_name
| otherwise
= reportUnboundName' (lf_which looking_for) rdr_name
@@ -1104,6 +1107,18 @@ lookup_demoted rdr_name
where
looking_for = LF WL_Constructor WL_Anywhere
+-- Report a qualified variable name in a type signature:
+-- badSig :: Prelude.head
+-- ^^^^^^^^^^^
+report_qualified_term_in_types :: RdrName -> RdrName -> RnM Name
+report_qualified_term_in_types rdr_name demoted_rdr_name =
+ do { mName <- lookupGlobalOccRn_maybe demoted_rdr_name
+ ; case mName of
+ (Just _) -> termNameInType looking_for rdr_name demoted_rdr_name []
+ Nothing -> unboundTermNameInTypes looking_for rdr_name demoted_rdr_name }
+ where
+ looking_for = LF WL_Constructor WL_Global
+
-- 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.
@@ -1152,14 +1167,26 @@ its namespace to DataName and do a second lookup.
The final result (after the renamer) will be:
HsTyVar ("Zero", DataName)
-Another case of demotion happens when the compiler needs to check
+Another case of demotion happens when the user tries to
+use a qualified term at the type level:
+
+ f :: Prelude.id -> Int
+
+This signature passes the parser to be caught by the renamer.
+It allows the compiler to create more informative error messages.
+
+'Prelude.id' in the type signature is parsed as
+ HsTyVar ("id", TvName)
+
+To separate the case of a typo from the case of an
+intentional attempt to use an imported term's name the compiler demotes
+the namespace to VarName (using 'demoteTvNameSpace') and does a lookup.
+
+The same type of demotion happens when the compiler needs to check
if a name of a type variable has already been used for a term that is in scope.
We need to do it to check if a user should change the name
to make his code compatible with the RequiredTypeArguments extension.
-This type of demotion is made via demoteTvNameSpace.
-
-
Note [Promotion]
~~~~~~~~~~~~~~~
When the user mentions a type constructor or a type variable in a
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -2039,7 +2039,7 @@ extract_hs_tv_bndrs_kvs tv_bndrs =
extract_tv :: LocatedN RdrName -> FreeKiTyVars -> FreeKiTyVars
extract_tv tv acc =
- if isRdrTyVar (unLoc tv) then tv:acc else acc
+ if isRdrTyVar (unLoc tv) && (not . isQual) (unLoc tv) then tv:acc else acc
-- Deletes duplicates in a list of Located things. This is used to:
--
=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -18,8 +18,11 @@ module GHC.Rename.Unbound
, LookingFor(..)
, unboundName
, unboundNameX
+ , unboundTermNameInTypes
+ , IsTermInTypes(..)
, notInScopeErr
, nameSpacesRelated
+ , termNameInType
)
where
@@ -32,6 +35,7 @@ import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique)
import GHC.Utils.Misc
+import GHC.Utils.Panic (panic)
import GHC.Data.Maybe
import GHC.Data.FastString
@@ -93,6 +97,8 @@ data LookingFor = LF { lf_which :: WhatLooking
, lf_where :: WhereLooking
}
+data IsTermInTypes = UnknownTermInTypes RdrName | TermInTypes RdrName | NoTermInTypes
+
mkUnboundNameRdr :: RdrName -> Name
mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
@@ -107,11 +113,24 @@ unboundName lf rdr = unboundNameX lf rdr []
unboundNameX :: LookingFor -> RdrName -> [GhcHint] -> RnM Name
unboundNameX looking_for rdr_name hints
+ = unboundNameOrTermInType NoTermInTypes looking_for rdr_name hints
+
+unboundTermNameInTypes :: LookingFor -> RdrName -> RdrName -> RnM Name
+unboundTermNameInTypes looking_for rdr_name demoted_rdr_name
+ = unboundNameOrTermInType (UnknownTermInTypes demoted_rdr_name) looking_for rdr_name []
+
+-- Catches imported qualified terms in type signatures
+-- with proper error message and suggestions
+termNameInType :: LookingFor -> RdrName -> RdrName -> [GhcHint] -> RnM Name
+termNameInType looking_for rdr_name demoted_rdr_name external_hints
+ = unboundNameOrTermInType (TermInTypes demoted_rdr_name) looking_for rdr_name external_hints
+
+unboundNameOrTermInType :: IsTermInTypes -> LookingFor -> RdrName -> [GhcHint] -> RnM Name
+unboundNameOrTermInType if_term_in_type looking_for rdr_name hints
= do { dflags <- getDynFlags
; let show_helpful_errors = gopt Opt_HelpfulErrors dflags
- err = notInScopeErr (lf_where looking_for) rdr_name
; if not show_helpful_errors
- then addErr $ TcRnNotInScope err rdr_name [] hints
+ then addErr $ make_error [] hints
else do { local_env <- getLocalRdrEnv
; global_env <- getGlobalRdrEnv
; impInfo <- getImports
@@ -122,9 +141,19 @@ unboundNameX looking_for rdr_name hints
dflags hpt currmod global_env local_env impInfo
rdr_name
; addErr $
- TcRnNotInScope err rdr_name imp_errs (hints ++ suggs) }
+ make_error imp_errs (hints ++ suggs) }
; return (mkUnboundNameRdr rdr_name) }
+ where
+ name_to_search = case if_term_in_type of
+ NoTermInTypes -> rdr_name
+ UnknownTermInTypes demoted_name -> demoted_name
+ TermInTypes demoted_name -> demoted_name
+
+ err = notInScopeErr (lf_where looking_for) name_to_search
+ make_error imp_errs hints = case if_term_in_type of
+ TermInTypes demoted_name -> TcRnTermNameInType demoted_name hints
+ _ -> TcRnNotInScope err name_to_search imp_errs hints
notInScopeErr :: WhereLooking -> RdrName -> NotInScopeError
notInScopeErr where_look rdr_name
@@ -288,7 +317,7 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
(mod_name, occ_name) = case rdr_name of
Unqual occ_name -> (Nothing, occ_name)
Qual mod_name occ_name -> (Just mod_name, occ_name)
- _ -> error "importSuggestions: dead code"
+ _ -> panic "importSuggestions: dead code"
-- What import statements provide "Mod" at all
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -718,6 +718,11 @@ instance Diagnostic TcRnMessage where
TcRnNotInScope err name imp_errs _
-> mkSimpleDecorated $
pprScopeError name err $$ vcat (map ppr imp_errs)
+ TcRnTermNameInType name _
+ -> mkSimpleDecorated $
+ quotes (ppr name) <+>
+ (text "is a term-level binding") $+$
+ (text " and can not be used at the type level.")
TcRnUntickedPromotedThing thing
-> mkSimpleDecorated $
text "Unticked promoted" <+> what
@@ -1475,6 +1480,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnNotInScope {}
-> ErrorWithoutFlag
+ TcRnTermNameInType {}
+ -> ErrorWithoutFlag
TcRnUntickedPromotedThing {}
-> WarningWithFlag Opt_WarnUntickedPromotedConstructors
TcRnIllegalBuiltinSyntax {}
@@ -1878,6 +1885,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnNotInScope err _ _ hints
-> scopeErrorHints err ++ hints
+ TcRnTermNameInType _ hints
+ -> hints
TcRnUntickedPromotedThing thing
-> [SuggestAddTick thing]
TcRnIllegalBuiltinSyntax {}
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -1717,6 +1717,7 @@ data TcRnMessage where
-> [ImportError] -- ^ import errors that are relevant
-> [GhcHint] -- ^ hints, e.g. enable DataKinds to refer to a promoted data constructor
-> TcRnMessage
+ TcRnTermNameInType :: RdrName -> [GhcHint] -> TcRnMessage
{-| TcRnUntickedPromotedThing is a warning (controlled with -Wunticked-promoted-constructors)
that is triggered by an unticked occurrence of a promoted data constructor.
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -432,6 +432,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnSectionWithoutParentheses" = 95880
GhcDiagnosticCode "TcRnIllegalImplicitParameterBindings" = 50730
GhcDiagnosticCode "TcRnIllegalTupleSection" = 59155
+ GhcDiagnosticCode "TcRnTermNameInType" = 37479
GhcDiagnosticCode "TcRnUntickedPromotedThing" = 49957
GhcDiagnosticCode "TcRnIllegalBuiltinSyntax" = 39716
=====================================
testsuite/tests/rename/should_fail/T21605a.hs
=====================================
@@ -0,0 +1,6 @@
+module T21605a where
+
+import Prelude
+
+wrongSig :: Prelude.true
+wrongSig = undefined
=====================================
testsuite/tests/rename/should_fail/T21605a.stderr
=====================================
@@ -0,0 +1,10 @@
+
+T21605a.hs:5:13: error: [GHC-76037]
+ Not in scope: ‘Prelude.true’
+ NB: the module ‘Prelude’ does not export ‘true’.
+ Suggested fix:
+ Perhaps use one of these:
+ type constructor or class ‘Prelude.Num’ (imported from Prelude),
+ type constructor or class ‘Prelude.Ord’ (imported from Prelude),
+ type constructor or class ‘Prelude.Enum’ (imported from Prelude)
+
=====================================
testsuite/tests/rename/should_fail/T21605b.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE DataKinds #-}
+module T21605b where
+
+import Prelude
+
+wrongSig :: Prelude.true
+wrongSig = undefined
=====================================
testsuite/tests/rename/should_fail/T21605b.stderr
=====================================
@@ -0,0 +1,9 @@
+
+T21605b.hs:6:13: error: [GHC-76037]
+ Not in scope: ‘Prelude.true’
+ NB: the module ‘Prelude’ does not export ‘true’.
+ Suggested fix:
+ Perhaps use one of these:
+ data constructor ‘Prelude.True’ (imported from Prelude),
+ type constructor or class ‘Prelude.Num’ (imported from Prelude),
+ type constructor or class ‘Prelude.Ord’ (imported from Prelude)
=====================================
testsuite/tests/rename/should_fail/T21605c.hs
=====================================
@@ -0,0 +1,6 @@
+module T21605b where
+
+import Prelude
+
+wrongSig :: Prelude.head
+wrongSig = undefined
=====================================
testsuite/tests/rename/should_fail/T21605c.stderr
=====================================
@@ -0,0 +1,9 @@
+
+T21605c.hs:5:13: error: [GHC-37479]
+ ‘Prelude.head’ is a term-level binding
+ and can not be used at the type level.
+ Suggested fix:
+ Perhaps use one of these:
+ type constructor or class ‘Prelude.Read’ (imported from Prelude),
+ type constructor or class ‘Prelude.Real’ (imported from Prelude),
+ type constructor or class ‘Prelude.ReadS’ (imported from Prelude)
=====================================
testsuite/tests/rename/should_fail/T21605d.hs
=====================================
@@ -0,0 +1,3 @@
+module T21605d where
+
+f (x :: Prelude.id) = x
\ No newline at end of file
=====================================
testsuite/tests/rename/should_fail/T21605d.stderr
=====================================
@@ -0,0 +1,8 @@
+T21605d.hs:3:9: [GHC-37479]
+ ‘Prelude.id’ is a term-level binding
+ and can not be used at the type level.
+ Suggested fix:
+ Perhaps use one of these:
+ type constructor or class ‘Prelude.Eq’ (imported from Prelude),
+ type constructor or class ‘Prelude.IO’ (imported from Prelude),
+ type constructor or class ‘Prelude.Ord’ (imported from Prelude)
\ No newline at end of file
=====================================
testsuite/tests/rename/should_fail/all.T
=====================================
@@ -177,6 +177,9 @@ test('T19843m', normal, compile_fail, [''])
test('T11167_ambig', normal, compile_fail, [''])
test('T18138', normal, compile_fail, [''])
test('T20147', normal, compile_fail, [''])
-
test('RnEmptyStatementGroup1', normal, compile_fail, [''])
test('RnImplicitBindInMdoNotation', normal, compile_fail, [''])
+test('T21605a', normal, compile_fail, [''])
+test('T21605b', normal, compile_fail, [''])
+test('T21605c', normal, compile_fail, [''])
+test('T21605d', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/300bcc1577772b6e2848c3432efb14d89af2df76
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/300bcc1577772b6e2848c3432efb14d89af2df76
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230111/14024fd9/attachment-0001.html>
More information about the ghc-commits
mailing list