Refactor Haddock options
[ghc-hetmet.git] / compiler / parser / Parser.y.pp
index 98ca052..8adc381 100644 (file)
@@ -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