Activation(..), RuleMatchInfo(..), defaultInlineSpec )
import DynFlags
import OrdList
-import HaddockParse
-import {-# SOURCE #-} HaddockLex hiding ( Token )
import HaddockUtils
import FastString
'{-# SCC' { L _ ITscc_prag }
'{-# GENERATED' { L _ ITgenerated_prag }
'{-# DEPRECATED' { L _ ITdeprecated_prag }
- '{-# WARNING' { L _ ITwarning_prag }
+ '{-# WARNING' { L _ ITwarning_prag }
'{-# UNPACK' { L _ ITunpack_prag }
- '{-# ANN' { L _ ITann_prag }
+ '{-# ANN' { L _ ITann_prag }
'#-}' { L _ ITclose_prag }
'..' { L _ ITdotdot } -- reserved symbols
module :: { Located (HsModule RdrName) }
: maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
- {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
- return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
- info doc) )}}
+ {% fileSrcSpan >>= \ loc ->
+ return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 $1
+ ) )}
| body2
{% fileSrcSpan >>= \ loc ->
return (L loc (HsModule Nothing Nothing
- (fst $1) (snd $1) Nothing emptyHaddockModInfo
- Nothing)) }
+ (fst $1) (snd $1) Nothing Nothing
+ )) }
-maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
+maybedocheader :: { Maybe LHsDocString }
: moduleheader { $1 }
- | {- empty -} { (emptyHaddockModInfo, Nothing) }
+ | {- empty -} { Nothing }
missing_module_keyword :: { () }
: {- empty -} {% pushCurrentContext }
header :: { Located (HsModule RdrName) }
: maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
- {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
- return (L loc (HsModule (Just $3) $5 $7 [] $4
- info doc))}}
+ {% fileSrcSpan >>= \ loc ->
+ return (L loc (HsModule (Just $3) $5 $7 [] $4 $1
+ ))}
| missing_module_keyword importdecls
{% fileSrcSpan >>= \ loc ->
return (L loc (HsModule Nothing Nothing $2 [] Nothing
- emptyHaddockModInfo Nothing)) }
+ Nothing)) }
header_body :: { [LImportDecl RdrName] }
: '{' importdecls { $2 }
| stand_alone_deriving { unitOL (LL (DerivD (unLoc $1))) }
| 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
| 'foreign' fdecl { unitOL (LL (unLoc $2)) }
- | '{-# DEPRECATED' deprecations '#-}' { $2 }
- | '{-# WARNING' warnings '#-}' { $2 }
+ | '{-# DEPRECATED' deprecations '#-}' { $2 }
+ | '{-# WARNING' warnings '#-}' { $2 }
| '{-# RULES' rules '#-}' { $2 }
| annotation { unitOL $1 }
| decl { unLoc $1 }
-- Template Haskell Extension
- | '$(' exp ')' { unitOL (LL $ SpliceD (SpliceDecl $2)) }
- | TH_ID_SPLICE { unitOL (LL $ SpliceD (SpliceDecl $
- L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
- )) }
+ -- The $(..) form is one possible form of infixexp
+ -- but we treat an arbitrary expression just as if
+ -- it had a $(..) wrapped around it
+ | infixexp { unitOL (LL $ mkTopSpliceDecl $1) }
-- Type classes
--
-- ordinary GADT declaration
| data_or_newtype tycl_hdr opt_kind_sig
- 'where' gadt_constrlist
+ gadt_constrlist
deriving
{% mkTyData (comb4 $1 $2 $4 $5) (unLoc $1) False $2
- (unLoc $3) (reverse (unLoc $5)) (unLoc $6) }
+ (unLoc $3) (unLoc $4) (unLoc $5) }
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
-- GADT instance declaration
| data_or_newtype 'instance' tycl_hdr opt_kind_sig
- 'where' gadt_constrlist
+ gadt_constrlist
deriving
- {% mkTyData (comb4 $1 $3 $6 $7) (unLoc $1) True $3
- (unLoc $4) (reverse (unLoc $6)) (unLoc $7) }
+ {% mkTyData (comb4 $1 $3 $5 $6) (unLoc $1) True $3
+ (unLoc $4) (unLoc $5) (unLoc $6) }
-- Associated type family declarations
--
-- GADT instance declaration
| data_or_newtype tycl_hdr opt_kind_sig
- 'where' gadt_constrlist
+ gadt_constrlist
deriving
- {% mkTyData (comb4 $1 $2 $5 $6) (unLoc $1) True $2
- (unLoc $3) (reverse (unLoc $5)) (unLoc $6) }
+ {% mkTyData (comb4 $1 $2 $4 $5) (unLoc $1) True $2
+ (unLoc $3) (unLoc $4) (unLoc $5) }
data_or_newtype :: { Located NewOrData }
: 'data' { L1 DataType }
-- 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
-----------------------------------------------------------------------------
-- Datatype declarations
-gadt_constrlist :: { Located [LConDecl RdrName] }
- : '{' gadt_constrs '}' { LL (unLoc $2) }
- | vocurly gadt_constrs close { $2 }
+gadt_constrlist :: { Located [LConDecl RdrName] } -- Returned in order
+ : 'where' '{' gadt_constrs '}' { L (comb2 $1 $3) (unLoc $3) }
+ | 'where' vocurly gadt_constrs close { L (comb2 $1 $3) (unLoc $3) }
+ | {- empty -} { noLoc [] }
gadt_constrs :: { Located [LConDecl RdrName] }
- : gadt_constrs ';' gadt_constr { sL (comb2 $1 (head $3)) ($3 ++ unLoc $1) }
- | gadt_constrs ';' { $1 }
- | gadt_constr { sL (getLoc (head $1)) $1 }
+ : gadt_constr ';' gadt_constrs { L (comb2 (head $1) $3) ($1 ++ unLoc $3) }
+ | gadt_constr { L (getLoc (head $1)) $1 }
+ | {- empty -} { noLoc [] }
-- We allow the following forms:
-- C :: Eq a => a -> T a
-- D { x,y :: a } :: T a
-- forall a. Eq a => D { x,y :: a } :: T a
-gadt_constr :: { [LConDecl RdrName] }
+gadt_constr :: { [LConDecl RdrName] } -- Returns a list because of: C,D :: ty
: con_list '::' sigtype
{ map (sL (comb2 $1 $3)) (mkGadtDecl (unLoc $1) $3) }
; return [cd] } }
constrs :: { Located [LConDecl RdrName] }
- : {- empty; a GHC extension -} { noLoc [] }
- | maybe_docnext '=' constrs1 { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
+ : maybe_docnext '=' constrs1 { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
constrs1 :: { Located [LConDecl RdrName] }
: constrs1 maybe_docnext '|' maybe_docprev constr { LL (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4) }
docdecl :: { LHsDecl RdrName }
: docdecld { L1 (DocD (unLoc $1)) }
-docdecld :: { LDocDecl RdrName }
+docdecld :: { LDocDecl }
: docnext { L1 (DocCommentNext (unLoc $1)) }
| docprev { L1 (DocCommentPrev (unLoc $1)) }
| docnamed { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
fbind :: { HsRecField RdrName (LHsExpr RdrName) }
: qvar '=' exp { HsRecField $1 $3 False }
- | qvar { HsRecField $1 (L (getLoc $1) (HsVar (unLoc $1))) True }
+ | qvar { HsRecField $1 (L (getLoc $1) placeHolderPunRhs) True }
-- Here's where we say that plain 'x'
-- means exactly 'x = x'. The pun-flag boolean is
-- there so we can still print it right
-----------------------------------------------------------------------------
-- Documentation comments
-docnext :: { LHsDoc RdrName }
- : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
- MyLeft err -> parseError (getLoc $1) err;
- MyRight doc -> return (L1 doc) } }
+docnext :: { LHsDocString }
+ : DOCNEXT {% return (L1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
-docprev :: { LHsDoc RdrName }
- : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
- MyLeft err -> parseError (getLoc $1) err;
- MyRight doc -> return (L1 doc) } }
+docprev :: { LHsDocString }
+ : DOCPREV {% return (L1 (HsDocString (mkFastString (getDOCPREV $1)))) }
-docnamed :: { Located (String, (HsDoc RdrName)) }
+docnamed :: { Located (String, HsDocString) }
: DOCNAMED {%
let string = getDOCNAMED $1
(name, rest) = break isSpace string
- in case parseHaddockParagraphs (tokenise rest) of {
- MyLeft err -> parseError (getLoc $1) err;
- MyRight doc -> return (L1 (name, doc)) } }
+ in return (L1 (name, HsDocString (mkFastString rest))) }
-docsection :: { Located (Int, HsDoc RdrName) }
+docsection :: { Located (Int, HsDocString) }
: DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
- case parseHaddockString (tokenise doc) of {
- MyLeft err -> parseError (getLoc $1) err;
- MyRight doc -> return (L1 (n, doc)) } }
+ return (L1 (n, HsDocString (mkFastString doc))) }
-moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
+moduleheader :: { Maybe LHsDocString }
: DOCNEXT {% let string = getDOCNEXT $1 in
- case parseModuleHeader string of {
- Right (str, info) ->
- case parseHaddockParagraphs (tokenise str) of {
- MyLeft err -> parseError (getLoc $1) err;
- MyRight doc -> return (info, Just doc);
- };
- Left err -> parseError (getLoc $1) err
- } }
-
-maybe_docprev :: { Maybe (LHsDoc RdrName) }
+ return (Just (L1 (HsDocString (mkFastString string)))) }
+
+maybe_docprev :: { Maybe LHsDocString }
: docprev { Just $1 }
| {- empty -} { Nothing }
-maybe_docnext :: { Maybe (LHsDoc RdrName) }
+maybe_docnext :: { Maybe LHsDocString }
: docnext { Just $1 }
| {- empty -} { Nothing }
projects / ghc-hetmet.git / blobdiff