diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Lexer.x | 5 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 20 |
2 files changed, 17 insertions, 8 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 2887edff04..a6650acb15 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -68,7 +68,6 @@ module Lexer ( explicitNamespacesEnabled, patternSynonymsEnabled, sccProfilingOn, hpcEnabled, - typeOperatorsEnabled, starIsTypeEnabled, addWarning, lexTokenStream, @@ -2264,7 +2263,6 @@ data ExtBits | TypeApplicationsBit | StaticPointersBit | NumericUnderscoresBit - | TypeOperatorsBit | StarIsTypeBit deriving Enum @@ -2334,8 +2332,6 @@ staticPointersEnabled :: ExtsBitmap -> Bool staticPointersEnabled = xtest StaticPointersBit numericUnderscoresEnabled :: ExtsBitmap -> Bool numericUnderscoresEnabled = xtest NumericUnderscoresBit -typeOperatorsEnabled :: ExtsBitmap -> Bool -typeOperatorsEnabled = xtest TypeOperatorsBit starIsTypeEnabled :: ExtsBitmap -> Bool starIsTypeEnabled = xtest StarIsTypeBit @@ -2392,7 +2388,6 @@ mkParserFlags flags = .|. TypeApplicationsBit `xoptBit` LangExt.TypeApplications .|. StaticPointersBit `xoptBit` LangExt.StaticPointers .|. NumericUnderscoresBit `xoptBit` LangExt.NumericUnderscores - .|. TypeOperatorsBit `xoptBit` LangExt.TypeOperators .|. StarIsTypeBit `xoptBit` LangExt.StarIsType optBits = HaddockBit `goptBit` Opt_Haddock diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 7dc3aafb91..1ffde2222c 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -870,6 +870,12 @@ checkTyClHdr is_cls ty where goL (L l ty) acc ann fix = go l ty acc ann fix + -- workaround to define '*' despite StarIsType + go _ (HsParTy _ (L l (HsStarTy _ isUni))) acc ann fix + = do { warnStarBndr l + ; let name = mkOccName tcClsName (if isUni then "★" else "*") + ; return (L l (Unqual name), acc, fix, ann) } + go l (HsTyVar _ _ (L _ tc)) acc ann fix | isRdrTc tc = return (L l tc, acc, fix, ann) go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ann _fix @@ -1747,11 +1753,19 @@ warnStarIsType span = addWarning Opt_WarnStarIsType span msg $$ text "Suggested fix: use" <+> quotes (text "Type") <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead." +warnStarBndr :: SrcSpan -> P () +warnStarBndr span = addWarning Opt_WarnStarBinder span msg + where + msg = text "Found binding occurrence of" <+> quotes (text "*") + <+> text "yet StarIsType is enabled." + $$ text "NB. To use (or export) this operator in" + <+> text "modules with StarIsType," + $$ text " including the definition module, you must qualify it." + failOpFewArgs :: Located RdrName -> P a failOpFewArgs (L loc op) = - do { type_operators <- extension typeOperatorsEnabled - ; star_is_type <- extension starIsTypeEnabled - ; let msg = too_few $$ starInfo (type_operators, star_is_type) op + do { star_is_type <- extension starIsTypeEnabled + ; let msg = too_few $$ starInfo star_is_type op ; parseErrorSDoc loc msg } where too_few = text "Operator applied to too few arguments:" <+> ppr op |