summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2011-04-28 09:24:30 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2011-04-28 09:24:30 +0100
commit60401bfe16c49ef2e06e5e81fd58e030bea02013 (patch)
tree7622c6708be8ddace6544498d7999742c5d9a7f1 /compiler
parentfbff1b7b9c89f6369c4394a0b10fa7c06e011698 (diff)
downloadhaskell-60401bfe16c49ef2e06e5e81fd58e030bea02013.tar.gz
Use 'default' rather than 'generic' for default-method signatures
Also get rid of the old {| |} brackets in the lexer. Fewer keywords!
Diffstat (limited to 'compiler')
-rw-r--r--compiler/parser/Lexer.x18
-rw-r--r--compiler/parser/Parser.y.pp12
-rw-r--r--compiler/rename/RnBinds.lhs10
3 files changed, 21 insertions, 19 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index e86687bd8d..338af4c6dc 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -335,11 +335,6 @@ $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") }
{ token ITcubxparen }
}
-<0> {
- "{|" / { ifExtension genericsEnabled } { token ITocurlybar }
- "|}" / { ifExtension genericsEnabled } { token ITccurlybar }
-}
-
<0,option_prags> {
\( { special IToparen }
\) { special ITcparen }
@@ -431,7 +426,6 @@ data Token
| ITderiving
| ITdo
| ITelse
- | ITgeneric
| IThiding
| ITif
| ITimport
@@ -636,7 +630,6 @@ reservedWordsFM = listToUFM $
( "deriving", ITderiving, 0 ),
( "do", ITdo, 0 ),
( "else", ITelse, 0 ),
- ( "generic", ITgeneric, bit genericsBit ),
( "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
-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
@@ -1805,8 +1800,6 @@ nondecreasingIndentationBit = 25
always :: Int -> Bool
always _ = True
-genericsEnabled :: Int -> Bool
-genericsEnabled flags = testBit flags genericsBit
parrEnabled :: Int -> Bool
parrEnabled flags = testBit flags parrBit
arrowsEnabled :: Int -> Bool
@@ -1875,8 +1868,7 @@ mkPState flags buf loc =
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
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 078cfa4374..e009071ebc 100644
--- 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 }
- 'generic' { L _ ITgeneric }
'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 }
+ -- 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) }
@@ -1233,11 +1237,9 @@ gdrh :: { LGRHS 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
- | infixexp '::' sigtypedoc
+ infixexp '::' 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 a18dfcef11..b0dd3b52f4 100644
--- 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)
- = 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: ?
@@ -838,6 +840,11 @@ misplacedSigErr (L loc 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"))
@@ -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)
+
\end{code}