'forall' always a keyword, plus the dot type operatorwip/ghc-8.8-cherries

16 files changed, 74 insertions, 87 deletions

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index c4d0d4d127..c8a55c6b2f 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 07515679b1..f69ad9f096 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1239,7 +1239,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
                     ; ams (sLL $4 $> (mj AnnEqual $5:ann, eqn))
                           [mu AnnForall $1, mj AnnDot $3]  } }
@@ -1383,12 +1383,12 @@ tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) }
         | type                      { sL1 $1 (Nothing, $1) }
 
 tycl_hdr_inst :: { Located (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)
                                                            >> ams (sLL $1 $> $ (Just $4, Just $2, $6))
                                                                   [mu AnnForall $1, mj AnnDot $3])
                                                     }
-        | 'forall' tv_bndrs '.' type   {% hintExplicitForall (getLoc $1)
+        | 'forall' tv_bndrs '.' type   {% hintExplicitForall $1
                                           >> ams (sLL $1 $> $ (Nothing, Just $2, $4))
                                                  [mu AnnForall $1, mj AnnDot $3]
                                        }
@@ -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
@@ -3369,7 +3369,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) }
@@ -3470,7 +3470,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
@@ -3765,32 +3765,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 c1777759da..5c995c71ca 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 )
@@ -571,14 +575,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))
@@ -958,7 +958,7 @@ checkTyClHdr is_cls ty
     -- workaround to define '*' despite StarIsType
     go _ (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) }
 
     go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix
@@ -2333,3 +2333,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 5c86f65bb8..d586219e36 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 3703f1ac63..8ec8f3e69f 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 cd4c00d1a4..43f420b02d 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>