Commit 6c06fdc7 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

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 '*'
parent f0c99958
......@@ -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
......
......@@ -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)
......
......@@ -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 <tvs>. <type>")])
}
tyvarid :: { Located RdrName }
: VARID { L1 $! mkUnqual tvName (getVARID $1) }
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment