summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2019-02-14 00:36:00 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-02-15 07:29:05 -0500
commit887454d8889ca5dbba70425de41d97939cb9ac60 (patch)
tree6d7d57ee977f58fcceed0d59a95bcfdf057551dc
parentb31df5caaebb1c4f72a3c70a9cdb7893af4c3309 (diff)
downloadhaskell-887454d8889ca5dbba70425de41d97939cb9ac60.tar.gz
'forall' always a keyword, plus the dot type operator
-rw-r--r--compiler/parser/Lexer.x6
-rw-r--r--compiler/parser/Parser.y47
-rw-r--r--compiler/parser/RdrHsSyn.hs25
-rw-r--r--compiler/prelude/PrelNames.hs4
-rw-r--r--compiler/rename/RnTypes.hs8
-rw-r--r--compiler/rename/RnUnbound.hs15
-rw-r--r--docs/users_guide/8.8.1-notes.rst6
-rw-r--r--testsuite/tests/ghci/prog006/prog006.stderr10
-rw-r--r--testsuite/tests/parser/should_fail/ParserNoForallUnicode.stderr4
-rw-r--r--testsuite/tests/parser/should_fail/T12811.stderr6
-rw-r--r--testsuite/tests/parser/should_fail/T3095.stderr4
-rw-r--r--testsuite/tests/rename/should_fail/rnfail052.stderr4
-rw-r--r--testsuite/tests/rename/should_fail/rnfail053.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/T3155.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail166.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail183.stderr4
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 <tvs>. <type>"
+ , text "extension to enable explicit-forall syntax:" <+>
+ forallSymDoc <+> text "<tvs>. <type>"
]
-
--- 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 <tvs>. <type>'?"
- ]
- 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 <tvs>. <type>"
- ]
+ 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 <tvs>. <type>"]
-
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 <tvs>. <type>
+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: ∀ <tvs>. <type>
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 <tvs>. <type>'?
+ 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 <tvs>. <type>
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 <tvs>. <type>
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 <tvs>. <type>
+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 <tvs>. <type>
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 <tvs>. <type>
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 <tvs>. <type>