Initial commit for Pedro's new generic default methods

(See his Haskell Symposium 2010 paper
    "A generic deriving mechaism for Haskell")

3 files changed, 19 insertions, 9 deletions

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 5c41d7238d..26f7e485bb 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -431,6 +431,7 @@ data Token
   | ITderiving
   | ITdo
   | ITelse
+  | ITgeneric
   | IThiding
   | ITif
   | ITimport
@@ -635,6 +636,7 @@ reservedWordsFM = listToUFM $
 	( "deriving",	ITderiving, 	0 ), 
 	( "do",		ITdo, 		0 ),       
 	( "else",	ITelse, 	0 ),     
+	( "generic",	ITgeneric, 	bit genericsBit ),     
 	( "hiding",	IThiding, 	0 ),
 	( "if",		ITif, 		0 ),       
 	( "import",	ITimport, 	0 ),   
@@ -1752,7 +1754,7 @@ setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()
 -- integer
 
 genericsBit :: Int
-genericsBit = 0 -- {| and |}
+genericsBit = 0 -- {|, |} and "generic"
 ffiBit :: Int
 ffiBit	   = 1
 parrBit :: Int
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index bfadfbaff8..078cfa4374 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -216,6 +216,7 @@ incorrect.
  'deriving' 	{ L _ ITderiving }
  'do' 		{ L _ ITdo }
  'else' 	{ L _ ITelse }
+ 'generic' 	{ L _ ITgeneric }
  'hiding' 	{ L _ IThiding }
  'if' 		{ L _ ITif }
  'import' 	{ L _ ITimport }
@@ -1232,9 +1233,13 @@ gdrh :: { LGRHS RdrName }
 	: '|' guardquals '=' exp  	{ sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
 
 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
-	: infixexp '::' sigtypedoc	{% do s <- checkValSig $1 $3 
-				         ; return (LL $ unitOL (LL $ SigD s)) }
-		-- See Note [Declaration/signature overlap] for why we need infixexp here
+        : '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
+                        {% do s <- checkValSig $1 $3 
+                        ; return (LL $ unitOL (LL $ SigD s)) }
 	| var ',' sig_vars '::' sigtypedoc
 				{ LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
 	| infix prec ops	{ LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 47abf232e2..052b9a689c 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -812,17 +812,20 @@ checkValSig lhs@(L l _) ty
                        ppr lhs <+> text "::" <+> ppr ty)
                    $$ text hint)
   where
-    hint = if looks_like_foreign lhs
+    hint = if foreign_RDR `looks_like` lhs
            then "Perhaps you meant to use -XForeignFunctionInterface?"
-           else "Should be of form <variable> :: <type>"
+           else if generic_RDR `looks_like` lhs
+                then "Perhaps you meant to use -XGenerics?"
+                else "Should be of form <variable> :: <type>"
     -- A common error is to forget the ForeignFunctionInterface flag
     -- so check for that, and suggest.  cf Trac #3805
     -- Sadly 'foreign import' still barfs 'parse error' because 'import' is a keyword
-    looks_like_foreign (L _ (HsVar v))     = v == foreign_RDR
-    looks_like_foreign (L _ (HsApp lhs _)) = looks_like_foreign lhs
-    looks_like_foreign _                   = False
+    looks_like s (L _ (HsVar v))     = v == s
+    looks_like s (L _ (HsApp lhs _)) = looks_like s lhs
+    looks_like s _                   = False
 
     foreign_RDR = mkUnqual varName (fsLit "foreign")
+    generic_RDR = mkUnqual varName (fsLit "generic")
 
 checkDoAndIfThenElse :: LHsExpr RdrName
                      -> Bool