Add {-# OPTIONS_GHC -w #-} and some blurb to all compiler modules

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

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index cc348bd..16ed88d 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -8,6 +8,13 @@
 -- ---------------------------------------------------------------------------
 
 {
+{-# OPTIONS_GHC -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/WorkingConventions#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 )
@@ -200,7 +208,6 @@ incorrect.
  'data'        { L _ ITdata } 
  'default'     { L _ ITdefault }
  'deriving'    { L _ ITderiving }
- 'derive'      { L _ ITderive }
  'do'          { L _ ITdo }
  'else'        { L _ ITelse }
  'hiding'      { L _ IThiding }
@@ -345,6 +352,7 @@ identifier :: { Located RdrName }
        | qcon                          { $1 }
        | qvarop                        { $1 }
        | qconop                        { $1 }
+    | '(' '->' ')'      { LL $ getRdrName funTyCon }
 
 -----------------------------------------------------------------------------
 -- Module Header
@@ -754,7 +762,7 @@ tycl_hdr :: { Located (LHsContext RdrName,
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
-       : 'derive' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
+       : 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
 
 -----------------------------------------------------------------------------
 -- Nested declarations
@@ -1136,7 +1144,7 @@ forall :: { Located [LHsTyVarBndr RdrName] }
        : 'forall' tv_bndrs '.'         { LL $2 }
        | {- empty -}                   { noLoc [] }
 
-constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
+constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
 -- We parse the constructor declaration 
 --     C t1 t2
 -- as a btype (treating C as a type constructor) and then convert C to be
@@ -1149,7 +1157,7 @@ constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrN
        | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
        | btype conop btype             { LL ($2, InfixCon $1 $3) }
 
-constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
+constr_stuff_record :: { Located (Located RdrName, HsConDeclDetails RdrName) }
        : oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
        | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
 
@@ -1270,7 +1278,7 @@ exp10 :: { LHsExpr RdrName }
        | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
        | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
        | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
-       | '-' fexp                              { LL $ mkHsNegApp $2 }
+       | '-' fexp                              { LL $ NegApp $2 noSyntaxExpr }
 
        | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
                                           checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
@@ -1296,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)) }
@@ -1321,9 +1330,8 @@ aexp      :: { LHsExpr RdrName }
        | aexp1                         { $1 }
 
 aexp1  :: { LHsExpr RdrName }
-        : aexp1 '{' fbinds '}'         {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) 
-                                                       $3;
-                                       return (LL r) }}
+        : aexp1 '{' fbinds '}'         {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3
+                                     ; return (LL r) }}
        | aexp2                 { $1 }
 
 -- Here was the syntax for type applications that I was planning
@@ -1495,7 +1503,7 @@ gdpat     :: { LGRHS RdrName }
 -- Bangs inside are parsed as infix operator applications, so that
 -- we parse them right when bang-patterns are off
 pat     :: { LPat RdrName }
-pat    : infixexp              {% checkPattern $1 }
+pat    :  exp                  {% checkPattern $1 }
        | '!' aexp              {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
 
 apat   :: { LPat RdrName }     
@@ -1535,9 +1543,6 @@ maybe_stmt :: { Maybe (LStmt RdrName) }
 
 stmt  :: { LStmt RdrName }
        : qual                          { $1 }
--- What is this next production doing?  I have no clue!  SLPJ Dec06
-       | infixexp '->' exp             {% checkPattern $3 >>= \p ->
-                                          return (LL $ mkBindStmt p $1) }
        | 'rec' stmtlist                { LL $ mkRecStmt (unLoc $2) }
 
 qual  :: { LStmt RdrName }
@@ -1548,16 +1553,21 @@ qual  :: { LStmt RdrName }
 -----------------------------------------------------------------------------
 -- Record Field Update/Construction
 
-fbinds         :: { HsRecordBinds RdrName }
-       : fbinds1                       { HsRecordBinds (reverse $1) }
-       | {- empty -}                   { HsRecordBinds [] }
+fbinds         :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
+       : fbinds1                       { $1 }
+       | {- empty -}                   { ([], False) }
 
-fbinds1        :: { [(Located id, LHsExpr id)] }
-       : fbinds1 ',' fbind             { $3 : $1 }
-       | fbind                         { [$1] }
+fbinds1        :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
+       : fbind ',' fbinds1             { case $3 of (flds, dd) -> ($1 : flds, dd) } 
+       | fbind                         { ([$1], False) }
+       | '..'                          { ([],   True) }
   
-fbind  :: { (Located RdrName, LHsExpr RdrName) }
-       : qvar '=' exp                  { ($1,$3) }
+fbind  :: { HsRecField RdrName (LHsExpr RdrName) }
+       : qvar '=' exp  { HsRecField $1 $3 False }
+       | qvar          { HsRecField $1 (L (getLoc $1) (HsVar (unLoc $1))) 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
 
 -----------------------------------------------------------------------------
 -- Implicit Parameter Bindings
@@ -1755,7 +1765,6 @@ special_id
        : 'as'                  { L1 FSLIT("as") }
        | 'qualified'           { L1 FSLIT("qualified") }
        | 'hiding'              { L1 FSLIT("hiding") }
-       | 'derive'              { L1 FSLIT("derive") }
        | 'export'              { L1 FSLIT("export") }
        | 'label'               { L1 FSLIT("label")  }
        | 'dynamic'             { L1 FSLIT("dynamic") }