[project @ 2003-09-24 13:04:45 by simonmar]

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

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 985e501..7976b1b 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-                                                             -*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.123 2003/09/16 13:03:44 simonmar Exp $
+$Id: Parser.y,v 1.125 2003/09/24 13:04:51 simonmar Exp $
 
 Haskell grammar.
 
@@ -127,7 +127,6 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  'safe'                { T _ _ ITsafe }
  'threadsafe'  { T _ _ ITthreadsafe }
  'unsafe'      { T _ _ ITunsafe }
- 'with'        { T _ _ ITwith }
  'mdo'         { T _ _ ITmdo }
  'stdcall'      { T _ _ ITstdcallconv }
  'ccall'        { T _ _ ITccallconv }
@@ -461,8 +460,8 @@ where       :: { [RdrBinding] }     -- Reversed
 
 binds  ::  { RdrNameHsBinds }  -- May have implicit parameters
        : decllist                      { cvBinds $1 }
-       | '{'            dbinds '}'     { IPBinds $2 False{-not with-} }
-       |     vocurly    dbinds close   { IPBinds $2 False{-not with-} }
+       | '{'            dbinds '}'     { IPBinds $2 }
+       |     vocurly    dbinds close   { IPBinds $2 }
 
 wherebinds :: { RdrNameHsBinds }       -- May have implicit parameters
        : 'where' binds                 { $2 }
@@ -814,19 +813,19 @@ forall :: { [RdrNameHsTyVar] }
 
 constr_stuff :: { (RdrName, RdrNameConDetails) }
        : btype                         {% mkPrefixCon $1 [] }
-       | btype '!' atype satypes       {% mkPrefixCon $1 (BangType MarkedUserStrict $3 : $4) }
+       | btype strict_mark atype satypes {% mkPrefixCon $1 (BangType $2 $3 : $4) }
        | oqtycon '{' '}'               {% mkRecCon $1 [] }
        | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 }
        | sbtype conop sbtype           { ($2, InfixCon $1 $3) }
 
 satypes        :: { [RdrNameBangType] }
        : atype satypes                 { unbangedType $1 : $2 }
-       | '!' atype satypes             { BangType MarkedUserStrict $2 : $3 }
+       | strict_mark atype satypes     { BangType $1 $2 : $3 }
        | {- empty -}                   { [] }
 
 sbtype :: { RdrNameBangType }
        : btype                         { unbangedType $1 }
-       | '!' atype                     { BangType MarkedUserStrict $2 }
+       | strict_mark atype             { BangType $1 $2 }
 
 fielddecls :: { [([RdrName],RdrNameBangType)] }
        : fielddecl ',' fielddecls      { $1 : $3 }
@@ -837,7 +836,11 @@ fielddecl :: { ([RdrName],RdrNameBangType) }
 
 stype :: { RdrNameBangType }
        : ctype                         { unbangedType $1 }
-       | '!' atype                     { BangType MarkedUserStrict $2 }
+       | strict_mark atype             { BangType $1 $2 }
+
+strict_mark :: { StrictnessMark }
+       : '!'                           { MarkedUserStrict }
+       | '!' '!'                       { MarkedUserUnboxed }
 
 deriving :: { Maybe RdrNameContext }
        : {- empty -}                   { Nothing }
@@ -905,7 +908,6 @@ sigdecl :: { RdrBinding }
 
 exp   :: { RdrNameHsExpr }
        : infixexp '::' sigtype         { ExprWithTySig $1 $3 }
-       | infixexp 'with' dbinding      { HsLet (IPBinds $3 True{-not a let-}) $1 }
        | fexp srcloc '-<' exp          { HsArrApp $1 $4 placeHolderType HsFirstOrderApp True $2 }
        | fexp srcloc '>-' exp          { HsArrApp $4 $1 placeHolderType HsFirstOrderApp False $2 }
        | fexp srcloc '-<<' exp         { HsArrApp $1 $4 placeHolderType HsHigherOrderApp True $2 }