Add -XTypeOperators flag

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index a56a409..a675ff3 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -200,6 +200,7 @@ data DynFlag
    | Opt_PatternGuards
    | Opt_Rank2Types
    | Opt_RankNTypes
    | Opt_PatternGuards
    | Opt_Rank2Types
    | Opt_RankNTypes

+   | Opt_TypeOperators

 
    | Opt_PrintExplicitForalls
 
 
    | Opt_PrintExplicitForalls
 

@@ -1127,6 +1128,7 @@ xFlags = [
 
   ( "Rank2Types",                       Opt_Rank2Types ),
   ( "RankNTypes",                       Opt_RankNTypes ),
 
   ( "Rank2Types",                       Opt_Rank2Types ),
   ( "RankNTypes",                       Opt_RankNTypes ),

+  ( "TypeOperators",                    Opt_TypeOperators ),

   ( "RecursiveDo",                      Opt_RecursiveDo ),
   ( "Arrows",                          Opt_Arrows ), -- arrow syntax
   ( "Parr",                            Opt_PArr ),
   ( "RecursiveDo",                      Opt_RecursiveDo ),
   ( "Arrows",                          Opt_Arrows ), -- arrow syntax
   ( "Parr",                            Opt_PArr ),

@@ -1185,6 +1187,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
            , Opt_UnicodeSyntax
            , Opt_PatternGuards
            , Opt_RankNTypes
            , Opt_UnicodeSyntax
            , Opt_PatternGuards
            , Opt_RankNTypes

+           , Opt_TypeOperators

            , Opt_RecursiveDo
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_RecursiveDo
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 94a65ac..33c0d11 100644 (file)
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -571,10 +571,7 @@ lookupFixityRn name
 
 ---------------
 lookupTyFixityRn :: Located Name -> RnM Fixity
 
 ---------------
 lookupTyFixityRn :: Located Name -> RnM Fixity

-lookupTyFixityRn (L loc n)
-  = do { glaExts <- doptM Opt_GlasgowExts
-       ; when (not glaExts) (addWarnAt loc (infixTyConWarn n))
-       ; lookupFixityRn n }
+lookupTyFixityRn (L loc n) = lookupFixityRn n

 
 ---------------
 dataTcOccs :: RdrName -> [RdrName]
 
 ---------------
 dataTcOccs :: RdrName -> [RdrName]

@@ -937,8 +934,4 @@ dupNamesErr descriptor located_names
 
 badQualBndrErr rdr_name
   = ptext SLIT("Qualified name in binding position:") <+> ppr rdr_name
 
 badQualBndrErr rdr_name
   = ptext SLIT("Qualified name in binding position:") <+> ppr rdr_name

-
-infixTyConWarn op
-  = vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
-         ftext FSLIT("Use -fglasgow-exts to avoid this warning")]

 \end{code}
 \end{code}

diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 2cc232c..25a1c45 100644 (file)
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -124,7 +124,7 @@ rnHsType doc (HsTyVar tyvar)
 
 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
   = setSrcSpan loc $ 
 
 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
   = setSrcSpan loc $ 

-    do { ty_ops_ok <- doptM Opt_ScopedTypeVariables    -- Badly named option
+    do { ty_ops_ok <- doptM Opt_TypeOperators

        ; checkErr ty_ops_ok (opTyErr op ty)
        ; op' <- lookupOccRn op
        ; let l_op' = L loc op'
        ; checkErr ty_ops_ok (opTyErr op ty)
        ; op' <- lookupOccRn op
        ; let l_op' = L loc op'

@@ -808,7 +808,7 @@ forAllWarn doc ty (L loc tyvar)
 
 opTyErr op ty 
   = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
 
 opTyErr op ty 
   = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))

-        2 (parens (ptext SLIT("Use -fscoped-type-variables to allow operators in types")))
+        2 (parens (ptext SLIT("Use -XTypeOperators to allow operators in types")))

 
 bogusCharError c
   = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''
 
 bogusCharError c
   = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''