More modules that need LANGUAGE BangPatterns

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

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 7ab7c44..5a181cf 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -248,6 +248,7 @@ incorrect.
  'dynamic'     { L _ ITdynamic }
  'safe'                { L _ ITsafe }
  'threadsafe'  { L _ ITthreadsafe }  -- ToDo: remove deprecated alias
+ 'interruptible' { L _ ITinterruptible }
  'unsafe'      { L _ ITunsafe }
  'mdo'         { L _ ITmdo }
  'family'      { L _ ITfamily }
@@ -896,6 +897,7 @@ callconv :: { CCallConv }
 safety :: { Safety }
        : 'unsafe'                      { PlayRisky }
        | 'safe'                        { PlaySafe  False }
+       | 'interruptible'               { PlayInterruptible }
        | 'threadsafe'                  { PlaySafe  True } -- deprecated alias
 
 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
@@ -1206,15 +1208,20 @@ docdecld :: { LDocDecl }
         | docsection                            { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
 
 decl   :: { Located (OrdList (LHsDecl RdrName)) }
-       : sigdecl                       { $1 }
-       | '!' aexp rhs                  {% do { pat <- checkPattern $2;
-                                               return (LL $ unitOL $ LL $ ValD ( 
-                                                       PatBind (LL $ BangPat pat) (unLoc $3)
-                                                               placeHolderType placeHolderNames)) } }
-        | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 $3;
-                                                let { l = comb2 $1 $> };
-                                                return $! (sL l (unitOL $! (sL l $ ValD r))) } }
-        | docdecl                       { LL $ unitOL $1 }
+       : sigdecl               { $1 }
+
+        | '!' aexp rhs          {% do { let { e = LL (SectionR (LL (HsVar bang_RDR)) $2) };
+                                        pat <- checkPattern e;
+                                        return $ LL $ unitOL $ LL $ ValD $
+                                               PatBind pat (unLoc $3)
+                                                       placeHolderType placeHolderNames } }
+                                -- Turn it all into an expression so that
+                                -- checkPattern can check that bangs are enabled
+
+        | infixexp opt_sig rhs  {% do { r <- checkValDef $1 $2 $3;
+                                        let { l = comb2 $1 $> };
+                                        return $! (sL l (unitOL $! (sL l $ ValD r))) } }
+        | docdecl               { LL $ unitOL $1 }
 
 rhs    :: { Located (GRHSs RdrName) }
        : '=' exp wherebinds    { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
@@ -1275,7 +1282,7 @@ exp10 :: { LHsExpr RdrName }
        | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
        | 'if' exp optSemi 'then' exp optSemi 'else' exp
                                         {% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
-                                           return (LL $ HsIf $2 $5 $8) }
+                                           return (LL $ mkHsIf $2 $5 $8) }
        | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
        | '-' fexp                              { LL $ NegApp $2 noSyntaxExpr }
 
@@ -1791,6 +1798,7 @@ tyvarid   :: { Located RdrName }
        | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
        | 'unsafe'              { L1 $! mkUnqual tvName (fsLit "unsafe") }
        | 'safe'                { L1 $! mkUnqual tvName (fsLit "safe") }
+       | 'interruptible'       { L1 $! mkUnqual tvName (fsLit "interruptible") }
        | 'threadsafe'          { L1 $! mkUnqual tvName (fsLit "threadsafe") }
 
 tyvarsym :: { Located RdrName }
@@ -1824,6 +1832,7 @@ varid :: { Located RdrName }
        | special_id            { L1 $! mkUnqual varName (unLoc $1) }
        | 'unsafe'              { L1 $! mkUnqual varName (fsLit "unsafe") }
        | 'safe'                { L1 $! mkUnqual varName (fsLit "safe") }
+       | 'interruptible'       { L1 $! mkUnqual varName (fsLit "interruptible") }
        | 'threadsafe'          { L1 $! mkUnqual varName (fsLit "threadsafe") }
        | 'forall'              { L1 $! mkUnqual varName (fsLit "forall") }
        | 'family'              { L1 $! mkUnqual varName (fsLit "family") }
@@ -1850,7 +1859,7 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-'
 
 -- These special_ids are treated as keywords in various places, 
 -- but as ordinary ids elsewhere.   'special_id' collects all these
--- except 'unsafe', 'forall', and 'family' whose treatment differs
+-- except 'unsafe', 'interruptible', 'forall', and 'family' whose treatment differs
 -- depending on context 
 special_id :: { Located FastString }
 special_id