From 6c06fdc7ad20682f0f52b5a78e5e3487a2ed047b Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 9 Apr 2009 14:40:04 +0000 Subject: [PATCH] Fix Trac #3155: better error message when -XRankNTypes is omitted This patch sligtly re-adjusts the way in which the syntax of types is handled: * In the lexer, '.' and '*' are always accepted in types (previously it was conditional). This things can't mean anything else in H98, which is the only reason for doing things conditionally in the lexer. * As a result '.' in types is never treated as an operator. Instead, lacking a 'forall' keyword, it turns into a plain parse error. * Test for -XKindSignatures in the renamer when processing a) type variable bindings b) types with sigs (ty :: kind-sig) * Make -XKindSignatures be implied by -XTypeFamilies Previously this was buried in the conditonal lexing of '*' --- compiler/main/DynFlags.hs | 2 ++ compiler/parser/Lexer.x | 4 ++-- compiler/parser/Parser.y.pp | 5 +++++ compiler/parser/RdrHsSyn.lhs | 3 ++- compiler/rename/RnEnv.lhs | 24 ++++++++++++++++-------- compiler/rename/RnTypes.lhs | 8 +++++--- 6 files changed, 32 insertions(+), 14 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 47cc3fe..2c6163c 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1809,6 +1809,8 @@ impliedFlags -- be completely rigid for GADTs , (Opt_TypeFamilies, Opt_RelaxedPolyRec) -- Trac #2944 gives a nice example + , (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures + -- all over the place , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see -- Note [Scoped tyvars] in TcBinds diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 5c595f5..aa2703e 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -719,9 +719,9 @@ reservedSymsFM = listToUFM $ ,("!", ITbang, always) -- For data T (a::*) = MkT - ,("*", ITstar, \i -> kindSigsEnabled i || tyFamEnabled i) + ,("*", ITstar, always) -- \i -> kindSigsEnabled i || tyFamEnabled i) -- For 'forall a . t' - ,(".", ITdot, \i -> explicitForallEnabled i || inRulePrag i) + ,(".", ITdot, always) -- \i -> explicitForallEnabled i || inRulePrag i) ,("-<", ITlarrowtail, arrowsEnabled) ,(">-", ITrarrowtail, arrowsEnabled) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index b73deb5..f0fc523 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1829,6 +1829,11 @@ tyvar : tyvarid { $1 } tyvarop :: { Located RdrName } tyvarop : '`' tyvarid '`' { LL (unLoc $2) } | tyvarsym { $1 } + | '.' {% parseErrorSDoc (getLoc $1) + (vcat [ptext (sLit "Illegal symbol '.' in type"), + ptext (sLit "Perhaps you intended -XRankNTypes or similar flag"), + ptext (sLit "to enable explicit-forall syntax: forall . ")]) + } tyvarid :: { Located RdrName } : VARID { L1 $! mkUnqual tvName (getVARID $1) } diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 382b333..187d64d 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -49,7 +49,8 @@ module RdrHsSyn ( checkMDo, -- [Stmt] -> P [Stmt] checkValDef, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl checkValSig, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl - parseError, -- String -> Pa + parseError, + parseErrorSDoc, ) where import HsSyn -- Lots of it diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 72ec8c4..56f18ab 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -30,7 +30,7 @@ module RnEnv ( mapFvRn, mapFvRnCPS, warnUnusedMatches, warnUnusedModules, warnUnusedImports, warnUnusedTopBinds, warnUnusedLocalBinds, - dataTcOccs, unknownNameErr, perhapsForallMsg, + dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg, checkM ) where @@ -824,13 +824,15 @@ bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName] -> RnM a -- Haskell-98 binding of type variables; e.g. within a data type decl bindTyVarsRn doc_str tyvar_names enclosed_scope - = let - located_tyvars = hsLTyVarLocNames tyvar_names - in - bindLocatedLocalsRn doc_str located_tyvars $ \ names -> - enclosed_scope (zipWith replace tyvar_names names) - where - replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2) + = bindLocatedLocalsRn doc_str located_tyvars $ \ names -> + do { kind_sigs_ok <- doptM Opt_KindSignatures + ; checkM (null kinded_tyvars || kind_sigs_ok) + (mapM_ (addErr . kindSigErr) kinded_tyvars) + ; enclosed_scope (zipWith replace tyvar_names names) } + where + replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2) + located_tyvars = hsLTyVarLocNames tyvar_names + kinded_tyvars = [n | L _ (KindedTyVar n _) <- tyvar_names] bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a -- Find the type variables in the pattern type @@ -1087,6 +1089,12 @@ dupNamesErr get_loc descriptor names | otherwise = ptext (sLit "Bound at:") <+> vcat (map ppr (sortLe (<=) locs)) +kindSigErr :: Outputable a => a -> SDoc +kindSigErr thing + = hang (ptext (sLit "Illegal kind signature for") <+> quotes (ppr thing)) + 2 (ptext (sLit "Perhaps you intended to use -XKindSignatures")) + + badQualBndrErr :: RdrName -> SDoc badQualBndrErr rdr_name = ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index d5fc150..4f9672b 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -148,9 +148,11 @@ rnHsType doc (HsListTy ty) = do ty' <- rnLHsType doc ty return (HsListTy ty') -rnHsType doc (HsKindSig ty k) = do - ty' <- rnLHsType doc ty - return (HsKindSig ty' k) +rnHsType doc (HsKindSig ty k) + = do { kind_sigs_ok <- doptM Opt_KindSignatures + ; checkM kind_sigs_ok (addErr (kindSigErr ty)) + ; ty' <- rnLHsType doc ty + ; return (HsKindSig ty' k) } rnHsType doc (HsPArrTy ty) = do ty' <- rnLHsType doc ty -- 1.7.10.4