Use 'default' rather than 'generic' for default-method signatures

Also get rid of the old {| |} brackets in the lexer.

Fewer keywords!

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index e86687b..338af4c 100644 (file)
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -335,11 +335,6 @@ $tab+         { warn Opt_WarnTabs (text "Warning: Tab character") }
          { token ITcubxparen }
 }
 
          { token ITcubxparen }
 }
 

-<0> {
-  "{|" / { ifExtension genericsEnabled } { token ITocurlybar }
-  "|}" / { ifExtension genericsEnabled } { token ITccurlybar }
-}
-

 <0,option_prags> {
   \(                                   { special IToparen }
   \)                                   { special ITcparen }
 <0,option_prags> {
   \(                                   { special IToparen }
   \)                                   { special ITcparen }

@@ -431,7 +426,6 @@ data Token
   | ITderiving
   | ITdo
   | ITelse
   | ITderiving
   | ITdo
   | ITelse

-  | ITgeneric

   | IThiding
   | ITif
   | ITimport
   | IThiding
   | ITif
   | ITimport

@@ -636,7 +630,6 @@ reservedWordsFM = listToUFM $
        ( "deriving",   ITderiving,     0 ), 
        ( "do",         ITdo,           0 ),       
        ( "else",       ITelse,         0 ),     
        ( "deriving",   ITderiving,     0 ), 
        ( "do",         ITdo,           0 ),       
        ( "else",       ITelse,         0 ),     

-       ( "generic",    ITgeneric,      bit genericsBit ),     

        ( "hiding",     IThiding,       0 ),
        ( "if",         ITif,           0 ),       
        ( "import",     ITimport,       0 ),   
        ( "hiding",     IThiding,       0 ),
        ( "if",         ITif,           0 ),       
        ( "import",     ITimport,       0 ),   

@@ -1753,8 +1746,10 @@ setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()
 -- -fglasgow-exts or -XParallelArrays) are represented by a bitmap stored in an unboxed
 -- integer
 
 -- -fglasgow-exts or -XParallelArrays) are represented by a bitmap stored in an unboxed
 -- integer
 

-genericsBit :: Int
-genericsBit = 0 -- {|, |} and "generic"
+-- The "genericsBit" is now unused, available for others
+-- genericsBit :: Int
+-- genericsBit = 0 -- {|, |} and "generic"
+

 ffiBit :: Int
 ffiBit    = 1
 parrBit :: Int
 ffiBit :: Int
 ffiBit    = 1
 parrBit :: Int

@@ -1805,8 +1800,6 @@ nondecreasingIndentationBit = 25
 
 always :: Int -> Bool
 always           _     = True
 
 always :: Int -> Bool
 always           _     = True

-genericsEnabled :: Int -> Bool
-genericsEnabled  flags = testBit flags genericsBit

 parrEnabled :: Int -> Bool
 parrEnabled      flags = testBit flags parrBit
 arrowsEnabled :: Int -> Bool
 parrEnabled :: Int -> Bool
 parrEnabled      flags = testBit flags parrBit
 arrowsEnabled :: Int -> Bool

@@ -1875,8 +1868,7 @@ mkPState flags buf loc =
       alr_justClosedExplicitLetBlock = False
     }
     where
       alr_justClosedExplicitLetBlock = False
     }
     where

-      bitmap =     genericsBit       `setBitIf` xopt Opt_Generics flags
-               .|. ffiBit            `setBitIf` xopt Opt_ForeignFunctionInterface flags
+      bitmap =     ffiBit            `setBitIf` xopt Opt_ForeignFunctionInterface flags

                .|. parrBit           `setBitIf` xopt Opt_ParallelArrays  flags
                .|. arrowsBit         `setBitIf` xopt Opt_Arrows          flags
                .|. thBit             `setBitIf` xopt Opt_TemplateHaskell flags
                .|. parrBit           `setBitIf` xopt Opt_ParallelArrays  flags
                .|. arrowsBit         `setBitIf` xopt Opt_Arrows          flags
                .|. thBit             `setBitIf` xopt Opt_TemplateHaskell flags

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 078cfa4..e009071 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -216,7 +216,6 @@ incorrect.
  'deriving'    { L _ ITderiving }
  'do'          { L _ ITdo }
  'else'        { L _ ITelse }
  'deriving'    { L _ ITderiving }
  'do'          { L _ ITdo }
  'else'        { L _ ITelse }

- 'generic'     { L _ ITgeneric }

  'hiding'      { L _ IThiding }
  'if'          { L _ ITif }
  'import'      { L _ ITimport }
  'hiding'      { L _ IThiding }
  'if'          { L _ ITif }
  'import'      { L _ ITimport }

@@ -722,6 +721,11 @@ decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
 decl_cls  : at_decl_cls                        { LL (unitOL (L1 (TyClD (unLoc $1)))) }
          | decl                        { $1 }
 
 decl_cls  : at_decl_cls                        { LL (unitOL (L1 (TyClD (unLoc $1)))) }
          | decl                        { $1 }
 

+         -- A 'default' signature used with the generic-programming extension
+          | 'default' infixexp '::' sigtypedoc
+                    {% do { (TypeSig l ty) <- checkValSig $2 $4
+                          ; return (LL $ unitOL (LL $ SigD (GenericSig l ty))) } }
+

 decls_cls :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
          : decls_cls ';' decl_cls      { LL (unLoc $1 `appOL` unLoc $3) }
          | decls_cls ';'               { LL (unLoc $1) }
 decls_cls :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
          : decls_cls ';' decl_cls      { LL (unLoc $1 `appOL` unLoc $3) }
          | decls_cls ';'               { LL (unLoc $1) }

@@ -1233,11 +1237,9 @@ gdrh :: { LGRHS RdrName }
        : '|' guardquals '=' exp        { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
 
 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
        : '|' guardquals '=' exp        { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
 
 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }

-        : 'generic' infixexp '::' sigtypedoc
-                        {% do (TypeSig l ty) <- checkValSig $2 $4
-                        ; return (LL $ unitOL (LL $ SigD (GenericSig l ty))) }
+        : 

        -- See Note [Declaration/signature overlap] for why we need infixexp here
        -- See Note [Declaration/signature overlap] for why we need infixexp here

-       | infixexp '::' sigtypedoc
+         infixexp '::' sigtypedoc

                         {% do s <- checkValSig $1 $3 
                         ; return (LL $ unitOL (LL $ SigD s)) }
        | var ',' sig_vars '::' sigtypedoc
                         {% do s <- checkValSig $1 $3 
                         ; return (LL $ unitOL (LL $ SigD s)) }
        | var ',' sig_vars '::' sigtypedoc

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index a18dfce..b0dd3b5 100644 (file)
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -713,7 +713,9 @@ renameSig mb_names sig@(TypeSig v ty)
        ; return (TypeSig new_v new_ty) }
 
 renameSig mb_names sig@(GenericSig v ty)
        ; return (TypeSig new_v new_ty) }
 
 renameSig mb_names sig@(GenericSig v ty)

-  = do { new_v <- lookupSigOccRn mb_names sig v
+  = do { generics_on <- xoptM Opt_Generics
+        ; unless generics_on (addErr (genericSigErr sig))
+        ; new_v <- lookupSigOccRn mb_names sig v

        ; new_ty <- rnHsSigType (quotes (ppr v)) ty
        ; return (GenericSig new_v new_ty) } -- JPM: ?
 
        ; new_ty <- rnHsSigType (quotes (ppr v)) ty
        ; return (GenericSig new_v new_ty) } -- JPM: ?
 

@@ -838,6 +840,11 @@ misplacedSigErr (L loc sig)
   = addErrAt loc $
     sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]
 
   = addErrAt loc $
     sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]
 

+genericSigErr :: Sig RdrName -> SDoc
+genericSigErr sig = vcat [ hang (ptext (sLit "Unexpected generic default signature:"))
+                              2 (ppr sig)
+                         , ptext (sLit "Use -XGenerics to enable generic default signatures") ] 
+

 methodBindErr :: HsBindLR RdrName RdrName -> SDoc
 methodBindErr mbind
  =  hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
 methodBindErr :: HsBindLR RdrName RdrName -> SDoc
 methodBindErr mbind
  =  hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))

@@ -852,4 +859,5 @@ nonStdGuardErr :: [LStmtLR Name Name] -> SDoc
 nonStdGuardErr guards
   = hang (ptext (sLit "accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
        4 (interpp'SP guards)
 nonStdGuardErr guards
   = hang (ptext (sLit "accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
        4 (interpp'SP guards)

+

 \end{code}
 \end{code}