From 887454d8889ca5dbba70425de41d97939cb9ac60 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Thu, 14 Feb 2019 00:36:00 +0300 Subject: 'forall' always a keyword, plus the dot type operator --- compiler/parser/Lexer.x | 6 +-- compiler/parser/Parser.y | 47 ++++++++-------------- compiler/parser/RdrHsSyn.hs | 25 ++++++++---- compiler/prelude/PrelNames.hs | 4 -- compiler/rename/RnTypes.hs | 8 +--- compiler/rename/RnUnbound.hs | 15 ++----- docs/users_guide/8.8.1-notes.rst | 6 ++- testsuite/tests/ghci/prog006/prog006.stderr | 10 +++-- .../should_fail/ParserNoForallUnicode.stderr | 4 +- testsuite/tests/parser/should_fail/T12811.stderr | 6 ++- testsuite/tests/parser/should_fail/T3095.stderr | 4 +- .../tests/rename/should_fail/rnfail052.stderr | 4 +- .../tests/rename/should_fail/rnfail053.stderr | 10 +++-- testsuite/tests/typecheck/should_fail/T3155.stderr | 4 +- .../tests/typecheck/should_fail/tcfail166.stderr | 4 +- .../tests/typecheck/should_fail/tcfail183.stderr | 4 +- 16 files changed, 74 insertions(+), 87 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 929a6a6cbb..9eed1e6572 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -818,9 +818,7 @@ reservedWordsFM = listToUFM $ ( "type", ITtype, 0 ), ( "where", ITwhere, 0 ), - ( "forall", ITforall NormalSyntax, - xbit ExplicitForallBit .|. - xbit InRulePragBit), + ( "forall", ITforall NormalSyntax, 0), ( "mdo", ITmdo, xbit RecursiveDoBit), -- See Note [Lexing type pseudo-keywords] ( "family", ITfamily, 0 ), @@ -2304,7 +2302,7 @@ data ExtBits | ThQuotesBit | IpBit | OverloadedLabelsBit -- #x overloaded labels - | ExplicitForallBit -- the 'forall' keyword and '.' symbol + | ExplicitForallBit -- the 'forall' keyword | BangPatBit -- Tells the parser to understand bang-patterns -- (doesn't affect the lexer) | PatternSynonymsBit -- pattern synonyms diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index da9febdcd8..69114ee9c2 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1238,7 +1238,7 @@ ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] } ty_fam_inst_eqn :: { Located ([AddAnn],TyFamInstEqn GhcPs) } : 'forall' tv_bndrs '.' type '=' ktype - {% do { hintExplicitForall (getLoc $1) + {% do { hintExplicitForall $1 ; (eqn,ann) <- mkTyFamInstEqn (Just $2) $4 $6 ; return (sLL $1 $> (mu AnnForall $1:mj AnnDot $3:mj AnnEqual $5:ann,eqn)) } } @@ -1382,13 +1382,13 @@ tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } | type { sL1 $1 (Nothing, $1) } tycl_hdr_inst :: { Located ([AddAnn],(Maybe (LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs], LHsType GhcPs)) } - : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall (getLoc $1) + : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 >> (addAnnotation (gl $4) (toUnicodeAnn AnnDarrow $5) (gl $5) >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3] , (Just $4, Just $2, $6))) ) } - | 'forall' tv_bndrs '.' type {% hintExplicitForall (getLoc $1) + | 'forall' tv_bndrs '.' type {% hintExplicitForall $1 >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3] , (Nothing, Just $2, $4))) } @@ -1667,7 +1667,7 @@ rule_explicit_activation :: { ([AddAnn] rule_foralls :: { ([AddAnn], Maybe [LHsTyVarBndr GhcPs], [LRuleBndr GhcPs]) } : 'forall' rule_vars '.' 'forall' rule_vars '.' {% let tyvs = mkRuleTyVarBndrs $2 - in hintExplicitForall (getLoc $1) + in hintExplicitForall $1 >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs $2) >> return ([mu AnnForall $1,mj AnnDot $3, mu AnnForall $4,mj AnnDot $6], @@ -1855,7 +1855,7 @@ ktypedoc :: { LHsType GhcPs } -- A ctype is a for-all type ctype :: { LHsType GhcPs } - : 'forall' tv_bndrs '.' ctype {% hintExplicitForall (getLoc $1) >> + : 'forall' tv_bndrs '.' ctype {% hintExplicitForall $1 >> ams (sLL $1 $> $ HsForAllTy { hst_bndrs = $2 , hst_xforall = noExt @@ -1882,7 +1882,7 @@ ctype :: { LHsType GhcPs } -- to 'field' or to 'Int'. So we must use `ctype` to describe the type. ctypedoc :: { LHsType GhcPs } - : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >> + : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall $1 >> ams (sLL $1 $> $ HsForAllTy { hst_bndrs = $2 , hst_xforall = noExt @@ -3371,7 +3371,7 @@ tyvarop :: { Located RdrName } tyvarop : '`' tyvarid '`' {% ams (sLL $1 $> (unLoc $2)) [mj AnnBackquote $1,mj AnnVal $2 ,mj AnnBackquote $3] } - | '.' {% hintExplicitForall' (getLoc $1) } + | '.' { sL1 $1 $ mkUnqual tcClsName (fsLit ".") } tyvarid :: { Located RdrName } : VARID { sL1 $1 $! mkUnqual tvName (getVARID $1) } @@ -3472,7 +3472,7 @@ special_id special_sym :: { Located FastString } special_sym : '!' {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] } | '.' { sL1 $1 (fsLit ".") } - | '*' { sL1 $1 (fsLit (if isUnicode $1 then "\x2605" else "*")) } + | '*' { sL1 $1 (fsLit (starSym (isUnicode $1))) } ----------------------------------------------------------------------------- -- Data constructors @@ -3767,32 +3767,19 @@ hintIf span msg = do then parseErrorSDoc span $ text $ "parse error in if statement" else parseErrorSDoc span $ text $ "parse error in if statement: "++msg --- Hint about explicit-forall, assuming UnicodeSyntax is on -hintExplicitForall :: SrcSpan -> P () -hintExplicitForall span = do +-- Hint about explicit-forall +hintExplicitForall :: Located Token -> P () +hintExplicitForall tok = do forall <- getBit ExplicitForallBit rulePrag <- getBit InRulePragBit - unless (forall || rulePrag) $ parseErrorSDoc span $ vcat - [ text "Illegal symbol '\x2200' in type" -- U+2200 FOR ALL + unless (forall || rulePrag) $ parseErrorSDoc (getLoc tok) $ vcat + [ text "Illegal symbol" <+> quotes forallSymDoc <+> text "in type" , text "Perhaps you intended to use RankNTypes or a similar language" - , text "extension to enable explicit-forall syntax: \x2200 . " + , text "extension to enable explicit-forall syntax:" <+> + forallSymDoc <+> text ". " ] - --- Hint about explicit-forall, assuming UnicodeSyntax is off -hintExplicitForall' :: SrcSpan -> P (Located RdrName) -hintExplicitForall' span = do - forall <- getBit ExplicitForallBit - let illegalDot = "Illegal symbol '.' in type" - if forall - then parseErrorSDoc span $ vcat - [ text illegalDot - , text "Perhaps you meant to write 'forall . '?" - ] - else parseErrorSDoc span $ vcat - [ text illegalDot - , text "Perhaps you intended to use RankNTypes or a similar language" - , text "extension to enable explicit-forall syntax: forall . " - ] + where + forallSymDoc = text (forallSym (isUnicode tok)) checkIfBang :: LHsExpr GhcPs -> Bool checkIfBang (dL->L _ (HsVar _ (dL->L _ op))) = op == bang_RDR diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 91a27e93e6..ddbd885576 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -71,6 +71,10 @@ module RdrHsSyn ( mkImpExpSubSpec, checkImportSpec, + -- Token symbols + forallSym, + starSym, + -- Warnings and errors warnStarIsType, failOpFewArgs, @@ -97,7 +101,7 @@ import TysWiredIn ( cTupleTyConName, tupleTyCon, tupleDataCon, listTyConName, listTyConKey, eqTyCon_RDR, tupleTyConName, cTupleTyConNameArity_maybe ) import ForeignCall -import PrelNames ( forall_tv_RDR, allNameStrings ) +import PrelNames ( allNameStrings ) import SrcLoc import Unique ( hasKey ) import OrdList ( OrdList, fromOL ) @@ -575,14 +579,10 @@ tyConToDataCon loc tc = return (cL loc (setRdrNameSpace tc srcDataName)) | otherwise - = Left (loc, msg $$ extra) + = Left (loc, msg) where occ = rdrNameOcc tc - msg = text "Not a data constructor:" <+> quotes (ppr tc) - extra | tc == forall_tv_RDR - = text "Perhaps you intended to use ExistentialQuantification" - | otherwise = empty mkPatSynMatchGroup :: Located RdrName -> Located (OrdList (LHsDecl GhcPs)) @@ -959,7 +959,7 @@ checkTyClHdr is_cls ty -- workaround to define '*' despite StarIsType go lp (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix = do { warnStarBndr l - ; let name = mkOccName tcClsName (if isUni then "★" else "*") + ; let name = mkOccName tcClsName (starSym isUni) ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) } go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix @@ -2345,3 +2345,14 @@ mkLHsDocTy t doc = mkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs mkLHsDocTyMaybe t = maybe t (mkLHsDocTy t) + +----------------------------------------------------------------------------- +-- Token symbols + +starSym :: Bool -> String +starSym True = "★" +starSym False = "*" + +forallSym :: Bool -> String +forallSym True = "∀" +forallSym False = "forall" diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 94bb928cc2..600eb2ba4d 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -645,10 +645,6 @@ main_RDR_Unqual = mkUnqual varName (fsLit "main") -- We definitely don't want an Orig RdrName, because -- main might, in principle, be imported into module Main -forall_tv_RDR, dot_tv_RDR :: RdrName -forall_tv_RDR = mkUnqual tvName (fsLit "forall") -dot_tv_RDR = mkUnqual tvName (fsLit ".") - eq_RDR, ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR, ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName eq_RDR = nameRdrName eqName diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 1eaf89a7b9..8e390f0e17 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -44,7 +44,6 @@ import DynFlags import HsSyn import RnHsDoc ( rnLHsDoc, rnMbLHsDoc ) import RnEnv -import RnUnbound ( perhapsForallMsg ) import RnUtils ( HsDocContext(..), withHsDocContext, mapFvRn , pprHsDocContext, bindLocalNamesFV, typeAppErr , newLocalBndrRn, checkDupRdrNames, checkShadowedRdrNames ) @@ -1463,12 +1462,7 @@ warnUnusedForAll in_doc (dL->L loc tv) used_names opTyErr :: Outputable a => RdrName -> a -> SDoc opTyErr op overall_ty = hang (text "Illegal operator" <+> quotes (ppr op) <+> ptext (sLit "in type") <+> quotes (ppr overall_ty)) - 2 extra - where - extra | op == dot_tv_RDR - = perhapsForallMsg - | otherwise - = text "Use TypeOperators to allow operators in types" + 2 (text "Use TypeOperators to allow operators in types") {- ************************************************************************ diff --git a/compiler/rename/RnUnbound.hs b/compiler/rename/RnUnbound.hs index bdda66f00b..2de2fc1f0c 100644 --- a/compiler/rename/RnUnbound.hs +++ b/compiler/rename/RnUnbound.hs @@ -12,7 +12,6 @@ module RnUnbound ( mkUnboundName , WhereLooking(..) , unboundName , unboundNameX - , perhapsForallMsg , notInScopeErr ) where import GhcPrelude @@ -24,7 +23,7 @@ import Name import Module import SrcLoc import Outputable -import PrelNames ( mkUnboundName, forall_tv_RDR, isUnboundName, getUnique) +import PrelNames ( mkUnboundName, isUnboundName, getUnique) import Util import Maybes import DynFlags @@ -78,13 +77,10 @@ unboundNameX where_look rdr_name extra notInScopeErr :: RdrName -> SDoc notInScopeErr rdr_name - = vcat [ hang (text "Not in scope:") - 2 (what <+> quotes (ppr rdr_name)) - , extra ] + = hang (text "Not in scope:") + 2 (what <+> quotes (ppr rdr_name)) where what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) - extra | rdr_name == forall_tv_RDR = perhapsForallMsg - | otherwise = Outputable.empty type HowInScope = Either SrcSpan ImpDeclSpec -- Left loc => locally bound at loc @@ -352,11 +348,6 @@ extensionSuggestions rdrName = text "Perhaps you meant to use RecursiveDo" | otherwise = Outputable.empty -perhapsForallMsg :: SDoc -perhapsForallMsg - = vcat [ text "Perhaps you intended to use ExplicitForAll or similar flag" - , text "to enable explicit-forall syntax: forall . "] - qualsInScope :: GlobalRdrElt -> [(ModuleName, HowInScope)] -- Ones for which the qualified version is in scope qualsInScope GRE { gre_name = n, gre_lcl = lcl, gre_imp = is } diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst index 33b7f48e43..c5bc89a586 100644 --- a/docs/users_guide/8.8.1-notes.rst +++ b/docs/users_guide/8.8.1-notes.rst @@ -41,9 +41,13 @@ Language terminating value of type ``Void``. Accordingly, GHC will not warn about ``K2`` (whereas previous versions of GHC would). -- ``(!)`` is now a valid type operator: :: +- ``(!)`` and ``(.)`` are now valid type operators: :: type family a ! b + type family a . b + +- ``forall`` is now always a keyword in types to provide more helpful + error messages when ``-XExplicitForall`` is off. - An existential context no longer requires parenthesization: :: diff --git a/testsuite/tests/ghci/prog006/prog006.stderr b/testsuite/tests/ghci/prog006/prog006.stderr index d4a37124bc..aedba9717f 100644 --- a/testsuite/tests/ghci/prog006/prog006.stderr +++ b/testsuite/tests/ghci/prog006/prog006.stderr @@ -1,5 +1,7 @@ -Boot.hs:5:21: error: - Illegal symbol '.' in type - Perhaps you intended to use RankNTypes or a similar language - extension to enable explicit-forall syntax: forall . +Boot.hs:5:13: error: + • Data constructor ‘D’ has existential type variables, a context, or a specialised result type + D :: forall n. Class n => n -> Data + (Enable ExistentialQuantification or GADTs to allow this) + • In the definition of data constructor ‘D’ + In the data type declaration for ‘Data’ diff --git a/testsuite/tests/parser/should_fail/ParserNoForallUnicode.stderr b/testsuite/tests/parser/should_fail/ParserNoForallUnicode.stderr index 6c9843343a..6ad0cbba11 100644 --- a/testsuite/tests/parser/should_fail/ParserNoForallUnicode.stderr +++ b/testsuite/tests/parser/should_fail/ParserNoForallUnicode.stderr @@ -1,5 +1,5 @@ -ParserNoForallUnicode.hs:5:8: - Illegal symbol '∀' in type +ParserNoForallUnicode.hs:5:8: error: + Illegal symbol ‘∀’ in type Perhaps you intended to use RankNTypes or a similar language extension to enable explicit-forall syntax: ∀ . diff --git a/testsuite/tests/parser/should_fail/T12811.stderr b/testsuite/tests/parser/should_fail/T12811.stderr index e9cf78fe5c..a1550357d4 100644 --- a/testsuite/tests/parser/should_fail/T12811.stderr +++ b/testsuite/tests/parser/should_fail/T12811.stderr @@ -1,4 +1,6 @@ +T12811.hs:4:15: error: Not in scope: type constructor or class ‘.’ + T12811.hs:4:15: error: - Illegal symbol '.' in type - Perhaps you meant to write 'forall . '? + Illegal operator ‘.’ in type ‘foral a . a’ + Use TypeOperators to allow operators in types diff --git a/testsuite/tests/parser/should_fail/T3095.stderr b/testsuite/tests/parser/should_fail/T3095.stderr index 1cb7a0f41f..b2b684877c 100644 --- a/testsuite/tests/parser/should_fail/T3095.stderr +++ b/testsuite/tests/parser/should_fail/T3095.stderr @@ -1,5 +1,5 @@ -T3095.hs:5:21: - Illegal symbol '.' in type +T3095.hs:5:12: error: + Illegal symbol ‘forall’ in type Perhaps you intended to use RankNTypes or a similar language extension to enable explicit-forall syntax: forall . diff --git a/testsuite/tests/rename/should_fail/rnfail052.stderr b/testsuite/tests/rename/should_fail/rnfail052.stderr index 1884776392..7979dac313 100644 --- a/testsuite/tests/rename/should_fail/rnfail052.stderr +++ b/testsuite/tests/rename/should_fail/rnfail052.stderr @@ -1,5 +1,5 @@ -rnfail052.hs:6:14: - Illegal symbol '.' in type +rnfail052.hs:6:6: error: + Illegal symbol ‘forall’ in type Perhaps you intended to use RankNTypes or a similar language extension to enable explicit-forall syntax: forall . diff --git a/testsuite/tests/rename/should_fail/rnfail053.stderr b/testsuite/tests/rename/should_fail/rnfail053.stderr index 0376517c30..ab96278504 100644 --- a/testsuite/tests/rename/should_fail/rnfail053.stderr +++ b/testsuite/tests/rename/should_fail/rnfail053.stderr @@ -1,5 +1,7 @@ -rnfail053.hs:5:18: error: - Illegal symbol '.' in type - Perhaps you intended to use RankNTypes or a similar language - extension to enable explicit-forall syntax: forall . +rnfail053.hs:5:10: error: + • Data constructor ‘MkT’ has existential type variables, a context, or a specialised result type + MkT :: forall a. a -> T + (Enable ExistentialQuantification or GADTs to allow this) + • In the definition of data constructor ‘MkT’ + In the data type declaration for ‘T’ diff --git a/testsuite/tests/typecheck/should_fail/T3155.stderr b/testsuite/tests/typecheck/should_fail/T3155.stderr index 85a31c32af..0f04d76bff 100644 --- a/testsuite/tests/typecheck/should_fail/T3155.stderr +++ b/testsuite/tests/typecheck/should_fail/T3155.stderr @@ -1,5 +1,5 @@ -T3155.hs:13:18: - Illegal symbol '.' in type +T3155.hs:13:9: error: + Illegal symbol ‘forall’ in type Perhaps you intended to use RankNTypes or a similar language extension to enable explicit-forall syntax: forall . diff --git a/testsuite/tests/typecheck/should_fail/tcfail166.stderr b/testsuite/tests/typecheck/should_fail/tcfail166.stderr index 96229505b0..5cc11d4a4b 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail166.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail166.stderr @@ -1,5 +1,5 @@ -tcfail166.hs:5:21: - Illegal symbol '.' in type +tcfail166.hs:5:13: error: + Illegal symbol ‘forall’ in type Perhaps you intended to use RankNTypes or a similar language extension to enable explicit-forall syntax: forall . diff --git a/testsuite/tests/typecheck/should_fail/tcfail183.stderr b/testsuite/tests/typecheck/should_fail/tcfail183.stderr index 529a17aa36..7a0e2ab346 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail183.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail183.stderr @@ -1,5 +1,5 @@ -tcfail183.hs:4:38: - Illegal symbol '.' in type +tcfail183.hs:4:30: error: + Illegal symbol ‘forall’ in type Perhaps you intended to use RankNTypes or a similar language extension to enable explicit-forall syntax: forall . -- cgit v1.2.1