Move the standalone-deriving flag test from parser to renamer
authorsimonpj@microsoft.com <unknown>
Tue, 25 Aug 2009 07:33:24 +0000 (07:33 +0000)
committersimonpj@microsoft.com <unknown>
Tue, 25 Aug 2009 07:33:24 +0000 (07:33 +0000)
This is just a tiny refactoring.  In general, we're trying to
get rid of parser errors in favour of later, more civlised, errors.

compiler/parser/Parser.y.pp
compiler/parser/RdrHsSyn.lhs
compiler/rename/RnSource.lhs

index a9b96a0..9f3dd27 100644 (file)
@@ -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
index e8d00a2..a299dc5 100644 (file)
@@ -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]
index bbf4938..3e31905 100644 (file)
@@ -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}
 
 %*********************************************************