X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=8adc381319c1c2d1e1751abca3de7c69f256347a;hb=03d8585e0940e28e024548654fe3505685aca94f;hp=98ca0524b33c9f6741458e8ae8e4522261312d49;hpb=ad94d40948668032189ad22a0ad741ac1f645f50;p=ghc-hetmet.git diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 98ca052..8adc381 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -12,7 +12,7 @@ -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module Parser ( parseModule, parseStmt, parseIdentifier, parseType, @@ -322,7 +322,6 @@ incorrect. DOCPREV { L _ (ITdocCommentPrev _) } DOCNAMED { L _ (ITdocCommentNamed _) } DOCSECTION { L _ (ITdocSection _ _) } - DOCOPTIONS { L _ (ITdocOptions _) } -- Template Haskell '[|' { L _ ITopenExpQuote } @@ -365,22 +364,19 @@ identifier :: { Located RdrName } -- know what they are doing. :-) module :: { Located (HsModule RdrName) } - : optdoc 'module' modid maybemoddeprec maybeexports 'where' body - {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) -> - return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 - opt info doc) )}} + : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' body + {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) -> + return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 + info doc) )}} | body2 {% fileSrcSpan >>= \ loc -> - return (L loc (HsModule Nothing Nothing - (fst $1) (snd $1) Nothing Nothing emptyHaddockModInfo + return (L loc (HsModule Nothing Nothing + (fst $1) (snd $1) Nothing emptyHaddockModInfo Nothing)) } -optdoc :: { (Maybe String, HaddockModInfo RdrName, Maybe (HsDoc RdrName)) } - : moduleheader { (Nothing, fst $1, snd $1) } - | docoptions { (Just $1, emptyHaddockModInfo, Nothing)} - | docoptions moduleheader { (Just $1, fst $2, snd $2) } - | moduleheader docoptions { (Just $2, fst $1, snd $1) } - | {- empty -} { (Nothing, emptyHaddockModInfo, Nothing) } +maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) } + : moduleheader { (fst $1, snd $1) } + | {- empty -} { (emptyHaddockModInfo, Nothing) } missing_module_keyword :: { () } : {- empty -} {% pushCurrentContext } @@ -409,14 +405,14 @@ cvtopdecls :: { [LHsDecl RdrName] } -- Module declaration & imports only header :: { Located (HsModule RdrName) } - : optdoc 'module' modid maybemoddeprec maybeexports 'where' header_body - {% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) -> - return (L loc (HsModule (Just $3) $5 $7 [] $4 - opt info doc))}} + : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' header_body + {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) -> + return (L loc (HsModule (Just $3) $5 $7 [] $4 + info doc))}} | missing_module_keyword importdecls {% fileSrcSpan >>= \ loc -> - return (L loc (HsModule Nothing Nothing $2 [] Nothing - Nothing emptyHaddockModInfo Nothing)) } + return (L loc (HsModule Nothing Nothing $2 [] Nothing + emptyHaddockModInfo Nothing)) } header_body :: { [LImportDecl RdrName] } : '{' importdecls { $2 } @@ -971,7 +967,7 @@ gentypedoc :: { LHsType RdrName } ctypedoc :: { LHsType RdrName } : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 } - | context '=>' gentypedoc { LL $ mkImplicitHsForAllTy $1 $3 } + | context '=>' ctypedoc { LL $ mkImplicitHsForAllTy $1 $3 } -- A type of form (context => type) is an *implicit* HsForAllTy | gentypedoc { $1 } @@ -1327,7 +1323,7 @@ fexp :: { LHsExpr RdrName } aexp :: { LHsExpr RdrName } : qvar '@' aexp { LL $ EAsPat $1 $3 } | '~' aexp { LL $ ELazyPat $2 } - | aexp1 { $1 } + | aexp1 { $1 } aexp1 :: { LHsExpr RdrName } : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3 @@ -1348,16 +1344,18 @@ aexp2 :: { LHsExpr RdrName } | literal { L1 (HsLit $! unLoc $1) } -- This will enable overloaded strings permanently. Normally the renamer turns HsString -- into HsOverLit when -foverloaded-strings is on. --- | STRING { L1 (HsOverLit $! mkHsIsString (getSTRING $1)) } - | INTEGER { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) } - | RATIONAL { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) } - | '(' exp ')' { LL (HsPar $2) } +-- | STRING { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRING $1) placeHolderType) } + | INTEGER { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGER $1) placeHolderType) } + | RATIONAL { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) } + -- N.B.: sections get parsed by these next two productions. + -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98 + -- (you'd have to write '((+ 3), (4 -))') + -- but the less cluttered version fell out of having texps. + | '(' texp ')' { LL (HsPar $2) } | '(' texp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed } | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed } | '[' list ']' { LL (unLoc $2) } | '[:' parr ':]' { LL (unLoc $2) } - | '(' infixexp qop ')' { LL $ SectionL $2 $3 } - | '(' qopm infixexp ')' { LL $ SectionR $2 $3 } | '_' { L1 EWildPat } -- Template Haskell Extension @@ -1395,11 +1393,17 @@ cvtopdecls0 :: { [LHsDecl RdrName] } : {- empty -} { [] } | cvtopdecls { $1 } +-- tuple expressions: things that can appear unparenthesized as long as they're +-- inside parens or delimitted by commas texp :: { LHsExpr RdrName } : exp { $1 } - | qopm infixexp { LL $ SectionR $1 $2 } - -- The second production is really here only for bang patterns - -- but + -- Technically, this should only be used for bang patterns, + -- but we can be a little more liberal here and avoid parens + -- inside tuples + | infixexp qop { LL $ SectionL $1 $2 } + | qopm infixexp { LL $ SectionR $1 $2 } + -- view patterns get parenthesized above + | exp '->' exp { LL $ EViewPat $1 $3 } texps :: { [LHsExpr RdrName] } : texps ',' texp { $3 : $1 } @@ -1858,9 +1862,6 @@ docsection :: { Located (n, HsDoc RdrName) } Left err -> parseError (getLoc $1) err; Right doc -> return (L1 (n, doc)) } } -docoptions :: { String } - : DOCOPTIONS { getDOCOPTIONS $1 } - moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) } : DOCNEXT {% let string = getDOCNEXT $1 in case parseModuleHeader string of { @@ -1910,7 +1911,6 @@ getDOCNEXT (L _ (ITdocCommentNext x)) = x getDOCPREV (L _ (ITdocCommentPrev x)) = x getDOCNAMED (L _ (ITdocCommentNamed x)) = x getDOCSECTION (L _ (ITdocSection n x)) = (n, x) -getDOCOPTIONS (L _ (ITdocOptions x)) = x -- Utilities for combining source spans comb2 :: Located a -> Located b -> SrcSpan