Commit cb8044eb authored by bjorn@bringert.net's avatar bjorn@bringert.net

Added parser and abstract syntax support for stand-alone deriving declarations.

parent 52f8fed4
......@@ -9,7 +9,7 @@ Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
\begin{code}
module HsDecls (
HsDecl(..), LHsDecl, TyClDecl(..), LTyClDecl,
InstDecl(..), LInstDecl, NewOrData(..),
InstDecl(..), LInstDecl, DerivDecl(..), LDerivDecl, NewOrData(..),
RuleDecl(..), LRuleDecl, RuleBndr(..),
DefaultDecl(..), LDefaultDecl, SpliceDecl(..),
ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
......@@ -67,6 +67,7 @@ type LHsDecl id = Located (HsDecl id)
data HsDecl id
= TyClD (TyClDecl id)
| InstD (InstDecl id)
| DerivD (DerivDecl id)
| ValD (HsBind id)
| SigD (Sig id)
| DefD (DefaultDecl id)
......@@ -153,6 +154,7 @@ instance OutputableBndr name => Outputable (HsDecl name) where
ppr (ValD binds) = ppr binds
ppr (DefD def) = ppr def
ppr (InstD inst) = ppr inst
ppr (DerivD deriv) = ppr deriv
ppr (ForD fd) = ppr fd
ppr (SigD sd) = ppr sd
ppr (RuleD rd) = ppr rd
......@@ -713,6 +715,23 @@ instDeclATs :: InstDecl name -> [LTyClDecl name]
instDeclATs (InstDecl _ _ _ ats) = ats
\end{code}
%************************************************************************
%* *
\subsection[DerivDecl]{A stand-alone instance deriving declaration
%* *
%************************************************************************
\begin{code}
type LDerivDecl name = Located (DerivDecl name)
data DerivDecl name
= DerivDecl (Located name) (LHsType name)
instance (OutputableBndr name) => Outputable (DerivDecl name) where
ppr (DerivDecl cls ty)
= hsep [ptext SLIT("deriving"), ppr cls, ppr ty]
\end{code}
%************************************************************************
%* *
\subsection[DefaultDecl]{A @default@ declaration}
......
......@@ -27,7 +27,7 @@ module Lexer (
failLocMsgP, failSpanMsgP, srcParseFail,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
extension, bangPatEnabled
extension, glaExtsEnabled, bangPatEnabled
) where
#include "HsVersions.h"
......
......@@ -455,9 +455,8 @@ topdecl :: { OrdList (LHsDecl RdrName) }
: cl_decl { unitOL (L1 (TyClD (unLoc $1))) }
| ty_decl { unitOL (L1 (TyClD (unLoc $1))) }
| 'instance' inst_type where
{ let (binds, sigs, ats) = cvBindsAndSigs (unLoc $3)
in unitOL (L (comb3 $1 $2 $3)
(InstD (InstDecl $2 binds sigs ats))) }
{ let (binds,sigs) = cvBindsAndSigs (unLoc $3)
in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
| 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
| 'foreign' fdecl { unitOL (LL (unLoc $2)) }
| '{-# DEPRECATED' deprecations '#-}' { $2 }
......
......@@ -40,6 +40,7 @@ module RdrHsSyn (
checkSynHdr, -- LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName], [LHsType RdrName])
checkKindSigs, -- [LTyClDecl RdrName] -> P ()
checkInstType, -- HsType -> P HsType
checkDerivDecl, -- LDerivDecl RdrName -> P (LDerivDecl RdrName)
checkPattern, -- HsExp -> P HsPat
checkPatterns, -- SrcLoc -> [HsExp] -> P [HsPat]
checkDo, -- [Stmt] -> P [Stmt]
......@@ -56,7 +57,7 @@ import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
isRdrDataCon, isUnqual, getRdrName, isQual,
setRdrNameSpace )
import BasicTypes ( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
import Lexer ( P, failSpanMsgP, extension, bangPatEnabled )
import Lexer ( P, failSpanMsgP, extension, glaExtsEnabled, bangPatEnabled )
import TysWiredIn ( unitTyCon )
import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
DNCallSpec(..), DNKind(..), CLabelString )
......@@ -559,6 +560,16 @@ checkDictTy (L spn ty) = check ty []
check (HsParTy t) args = check (unLoc t) args
check _ _ = parseError spn "Malformed context in instance header"
---------------------------------------------------------------------------
-- Checking stand-alone deriving declarations
checkDerivDecl :: LDerivDecl RdrName -> P (LDerivDecl RdrName)
checkDerivDecl d@(L loc _) =
do glaExtOn <- extension glaExtsEnabled
if glaExtOn then return d
else parseError loc "Illegal stand-alone deriving declaration (use -fglasgow-exts)"
---------------------------------------------------------------------------
-- Checking statements in a do-expression
-- We parse do { e1 ; e2 ; }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment