From: simonpj@microsoft.com <unknown>
Date: Tue, 25 Aug 2009 07:33:24 +0000 (+0000)
Subject: Move the standalone-deriving flag test from parser to renamer
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=21c5c9c09a8d36b4ae8a83b17b543c332bc9cb0c

Move the standalone-deriving flag test from parser to renamer

This is just a tiny refactoring.  In general, we're trying to
get rid of parser errors in favour of later, more civlised, errors.
---

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a9b96a0..9f3dd27 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -707,7 +707,7 @@ tycl_hdr :: { Located (LHsContext RdrName, LHsType RdrName) }
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
-  	: 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
+  	: 'deriving' 'instance' inst_type { LL (DerivDecl $3) }
 
 -----------------------------------------------------------------------------
 -- Nested declarations
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index e8d00a2..a299dc5 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -38,7 +38,6 @@ module RdrHsSyn (
 	checkTyVars,          -- [LHsType RdrName] -> P ()
 	checkKindSigs,	      -- [LTyClDecl RdrName] -> P ()
 	checkInstType,	      -- HsType -> P HsType
-        checkDerivDecl,       -- LDerivDecl RdrName -> P (LDerivDecl RdrName)
 	checkPattern,	      -- HsExp -> P HsPat
 	bang_RDR,
 	checkPatterns,	      -- SrcLoc -> [HsExp] -> P [HsPat]
@@ -659,15 +658,6 @@ checkPred (L spn ty)
 					        "malformed class assertion"
 
 ---------------------------------------------------------------------------
--- Checking stand-alone deriving declarations
-
-checkDerivDecl :: LDerivDecl RdrName -> P (LDerivDecl RdrName)
-checkDerivDecl d@(L loc _) = 
-    do stDerivOn <- extension standaloneDerivingEnabled
-       if stDerivOn then return d
-	 else parseError loc "Illegal stand-alone deriving declaration (use -XStandaloneDeriving)"
-
----------------------------------------------------------------------------
 -- Checking statements in a do-expression
 -- 	We parse   do { e1 ; e2 ; }
 -- 	as [ExprStmt e1, ExprStmt e2]
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index bbf4938..3e31905 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -499,9 +499,16 @@ extendTyVarEnvForMethodBinds tyvars thing_inside
 \begin{code}
 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
 rnSrcDerivDecl (DerivDecl ty)
-  = do ty' <- rnLHsType (text "a deriving decl") ty
-       let fvs = extractHsTyNames ty'
-       return (DerivDecl ty', fvs)
+  = do { standalone_deriv_ok <- doptM Opt_StandaloneDeriving
+       ; unless standalone_deriv_ok (addErr standaloneDerivErr)
+       ; ty' <- rnLHsType (text "a deriving decl") ty
+       ; let fvs = extractHsTyNames ty'
+       ; return (DerivDecl ty', fvs) }
+
+standaloneDerivErr :: SDoc
+standaloneDerivErr 
+  = hang (ptext (sLit "Illegal standalone deriving declaration"))
+       2 (ptext (sLit "Use -XStandaloneDeriving to enable this extension"))
 \end{code}
 
 %*********************************************************