FIX: parsing of doc options

[ghc-hetmet.git] / compiler / parser / Parser.y.pp

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 4567e07..d91143f 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -8,6 +8,13 @@
 -- ---------------------------------------------------------------------------
 
 {
+{-# OPTIONS -w #-}
+-- 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/Commentary/CodingStyle#Warnings
+-- for details
+
 module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
                parseHeader ) where
 
@@ -35,6 +42,7 @@ import StaticFlags    ( opt_SccProfilingOn, opt_Hpc )
 import Type            ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
 import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
                          Activation(..), defaultInlineSpec )
+import DynFlags
 import OrdList
 import HaddockParse
 import {-# SOURCE #-} HaddockLex hiding ( Token )
@@ -344,6 +352,7 @@ identifier :: { Located RdrName }
        | qcon                          { $1 }
        | qvarop                        { $1 }
        | qconop                        { $1 }
+    | '(' '->' ')'      { LL $ getRdrName funTyCon }
 
 -----------------------------------------------------------------------------
 -- Module Header
@@ -962,7 +971,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 }
        
@@ -1295,7 +1304,8 @@ exp10 :: { LHsExpr RdrName }
        | fexp                                  { $1 }
 
 scc_annot :: { Located FastString }
-       : '_scc_' STRING                        { LL $ getSTRING $2 }
+       : '_scc_' STRING                        {% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
+                                   (return $ LL $ getSTRING $2) }
        | '{-# SCC' STRING '#-}'                { LL $ getSTRING $2 }
 
 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
@@ -1849,7 +1859,7 @@ docsection :: { Located (n, HsDoc RdrName) }
       Right doc -> return (L1 (n, doc)) } }
 
 docoptions :: { String }
-  : DOCOPTIONS { getDOCOPTIONS $1 }
+  : DOCOPTIONS '#-}' { getDOCOPTIONS $1 }
 
 moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }                                    
         : DOCNEXT {% let string = getDOCNEXT $1 in