[add bang pattern strictness annotations
John Meacham <john@repetae.net>**20090221105217
 Ignore-this: d9fcc2bf2181393cc336e16e5cf8b3ff
] hunk ./E/FromHs.hs 802
-    f ~(HsPIrrPat (Located ss p)) = f p >>= \ (p',fe) -> case p' of
+    f (HsPIrrPat (Located ss p)) = f p >>= \ (p',fe) -> case p' of
hunk ./E/FromHs.hs 812
+    f ~(HsPBangPat (Located ss (HsPAsPat v p))) = do
+        (p',fe) <- f p
+        v <- convertVar (toName Name.Val v)
+        return (p',eStrictLet v b . fe)
hunk ./FrontEnd/Desugar.hs 266
+    f name (HsPBangPat pat) = HsPBangPat $ fmap (f name) pat
hunk ./FrontEnd/HsParser.y 313
-      | infixexp srcloc '<-' exp      {% checkPattern $1 `thenP` \p ->
+      | pinfixexp srcloc '<-' exp      {% checkPattern $1 `thenP` \p ->
hunk ./FrontEnd/HsParser.y 599
-      | infixexp srcloc rhs                   {% checkValDef $2 $1 $3 []}
-      | infixexp srcloc rhs 'where' decllist  {% checkValDef $2 $1 $3 $5}
+      | pinfixexp srcloc rhs                   {% checkValDef $2 $1 $3 []}
+      | pinfixexp srcloc rhs 'where' decllist  {% checkValDef $2 $1 $3 $5}
hunk ./FrontEnd/HsParser.y 677
+--      | '!' srcloc aexp1 srcloc       { HsBangPat $ located ($2,$4) $3 }
hunk ./FrontEnd/HsParser.y 707
+-- Expressions
+
+pexp   :: { HsExp }
+      : pinfixexp '::' srcloc ctype    { HsExpTypeSig $3 $1 $4 }
+      | pinfixexp                      { $1 }
+
+pinfixexp :: { HsExp }
+      : pexp10                         { $1 }
+      | pinfixexp qop pexp10            { HsInfixApp $1 $2 $3 }
+
+pexp10 :: { HsExp }
+      : '-' pfexp                      { HsNegApp $2 }
+      | pfexp                          { $1 }
+
+pfexp :: { HsExp }
+      : pfexp paexp                     { HsApp $1 $2 }
+      | paexp                          { $1 }
+
+paexps :: { [HsExp] }
+      : paexps paexp                    { $2 : $1 }
+      | paexp                          { [$1] }
+
+-- UGLY: Because patterns and expressions are mixed, aexp has to be split into
+-- two rules: One left-recursive and one right-recursive. Otherwise we get two
+-- reduce/reduce-errors (for as-patterns and irrefutable patters).
+
+-- Note: The first alternative of aexp is not neccessarily a record update, it
+-- could be a labeled construction, too.
+
+paexp  :: { HsExp }
+      : paexp '{' pfbinds '}'           {% mkRecConstrOrUpdate $1 (reverse $3) }
+      | paexp1                         { $1 }
+
+-- Even though the variable in an as-pattern cannot be qualified, we use
+-- qvar here to avoid a shift/reduce conflict, and then check it ourselves
+-- (as for vars above).
+
+paexp1 :: { HsExp }
+      : qvar                          { HsVar $1 }
+      | gcon                          { $1 }
+      | literal                       { $1 }
+      | '(' pexp ')'                  { HsParen $2 }
+      | '(' ptexps ')'                { HsTuple (reverse $2) }
+      | '(#' '#)'                     { HsUnboxedTuple [] }
+      | '(#' pexp '#)'                { HsUnboxedTuple [$2] }
+      | '(#' ptexps '#)'              { HsUnboxedTuple (reverse $2) }
+      | '[' plist ']'                 { $2 }
+      | '(' pinfixexp qop ')'          { HsLeftSection $3 $2  }
+      | '(' qopm pinfixexp ')'         { HsRightSection $3 $2 }
+      | qvar '@' paexp                {% checkUnQual $1 `thenP` \n ->
+                                         returnP (HsAsPat n $3) }
+      | srcloc '_'                    { HsWildCard $1 }
+      | '~' srcloc paexp1 srcloc      { HsIrrPat $ located ($2,$4) $3 }
+      | '!' srcloc paexp1 srcloc      { HsBangPat $ located ($2,$4) $3 }
+
+
+ptexps :: { [HsExp] }
+      : ptexps ',' pexp                 { $3 : $1 }
+      | pexp ',' pexp                   { [$3,$1] }
+
+-- -----------------------------------------------------------------------------
+-- List expressions
+
+-- The rules below are little bit contorted to keep lexps left-recursive while
+-- avoiding another shift/reduce-conflict.
+
+plist :: { HsExp }
+      : pexp                           { HsList [$1] }
+      | plexps                         { HsList (reverse $1) }
+
+plexps :: { [HsExp] }
+      : plexps ',' pexp                 { $3 : $1 }
+      | pexp ',' pexp                   { [$3,$1] }
+-- -----------------------------------------------------------------------------
hunk ./FrontEnd/HsParser.y 806
-      : infixexp srcloc ralt  {% checkPattern $1 `thenP` \p ->
+      : pinfixexp srcloc ralt  {% checkPattern $1 `thenP` \p ->
hunk ./FrontEnd/HsParser.y 808
-      | infixexp srcloc ralt 'where' decllist
+      | pinfixexp srcloc ralt 'where' decllist
hunk ./FrontEnd/HsParser.y 848
+pfbinds :: { [HsFieldUpdate] }
+      : pfbinds ',' pfbind              { $3 : $1 }
+      | pfbind                         { [$1] }
+
+pfbind :: { HsFieldUpdate }
+      : qvar '=' pexp                  { HsFieldUpdate $1 $3 }
+
hunk ./FrontEnd/HsPretty.hs 516
+ppHsExp (HsBangPat (Located _ exp)) = char '!' <> ppHsExp exp
hunk ./FrontEnd/HsPretty.hs 555
-ppHsPat	~(HsPIrrPat (Located _ pat)) = char '~' <> ppHsPat pat
+ppHsPat	(HsPIrrPat (Located _ pat)) = char '~' <> ppHsPat pat
+ppHsPat	~(HsPBangPat (Located _ pat)) = char '!' <> ppHsPat pat
hunk ./FrontEnd/HsSyn.hs 383
+	| HsBangPat { hsExpLExp :: LHsExp }
hunk ./FrontEnd/HsSyn.hs 407
+	| HsPBangPat { hsPatLPat :: LHsPat }
hunk ./FrontEnd/Infix.hs 245
+    HsPBangPat p -> tf $ HsPBangPat (fmap pp p)
hunk ./FrontEnd/Infix.hs 316
+    HsBangPat e1            -> (HsBangPat (fmap processExp' e1), terminalFixity)
hunk ./FrontEnd/ParseUtils.hs 168
+	HsBangPat e         -> do
+			      p <- T.mapM checkPattern e
+			      return (HsPBangPat p)
hunk ./FrontEnd/Syn/Traverse.hs 98
+    f (HsBangPat hsExp)  = do
+        hsExp' <- fnl hsExp
+        return (HsBangPat hsExp')
hunk ./FrontEnd/Syn/Traverse.hs 209
+    f (HsPBangPat hsPat)  = do
+          hsPat' <- fnl hsPat
+          return (HsPBangPat hsPat')
hunk ./FrontEnd/Tc/Main.hs 435
-tiPat (HsPNeg pat) typ = tiPat pat typ
+--tiPat (HsPNeg pat) typ = tiPat pat typ
hunk ./FrontEnd/Tc/Main.hs 440
+tiPat (HsPBangPat (Located l p@HsPAsPat {})) typ = do
+    (p,ns) <- tiPat p typ
+    return (HsPBangPat (Located l p),ns)
+tiPat (HsPBangPat (Located l p)) typ = do
+    v <- newHsVar "Bang"
+    tiPat (HsPBangPat (Located l (HsPAsPat (nameName v) p))) typ
hunk ./regress/tests/3_shootout/PartialSums.hs 31
-    where k3 = k2*k; k2 = k*k; dk = 1/k; k = fromIntegral i; sk = sin k; ck = cos k; x!y = x`seq`y
+    where k3 = k2*k; k2 = k*k; dk = 1/k; k = fromIntegral i; sk = sin k; ck = cos k; (!) x y = x`seq`y