Add DoAndIfThenElse support

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

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 42cb96f..6f1b2e4 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -697,9 +697,9 @@ opt_kind_sig :: { Located (Maybe Kind) }
 --     (Eq a, Ord b) => T a b
 --      T Int [a]                      -- for associated types
 -- Rather a lot of inlining here, else we get reduce/reduce errors
-tycl_hdr :: { Located (LHsContext RdrName, LHsType RdrName) }
-       : context '=>' type             { LL ($1, $3) }
-       | type                          { L1 (noLoc [], $1) }
+tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
+       : context '=>' type             { LL (Just $1, $3) }
+       | type                          { L1 (Nothing, $1) }
 
 -----------------------------------------------------------------------------
 -- Stand-alone deriving
@@ -936,7 +936,7 @@ infixtype :: { LHsType RdrName }
 
 strict_mark :: { Located HsBang }
        : '!'                           { L1 HsStrict }
-       | '{-# UNPACK' '#-}' '!'        { LL HsUnbox }
+       | '{-# UNPACK' '#-}' '!'        { LL HsUnpack }
 
 -- A ctype is a for-all type
 ctype  :: { LHsType RdrName }
@@ -1269,7 +1269,9 @@ exp10 :: { LHsExpr RdrName }
                                                                (unguardedGRHSs $6)
                                                            ]) }
        | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
-       | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
+       | 'if' exp optSemi 'then' exp optSemi 'else' exp
+                                        {% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
+                                           return (LL $ HsIf $2 $5 $8) }
        | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
        | '-' fexp                              { LL $ NegApp $2 noSyntaxExpr }
 
@@ -1296,6 +1298,10 @@ exp10 :: { LHsExpr RdrName }
                                                    -- hdaume: core annotation
        | fexp                                  { $1 }
 
+optSemi :: { Bool }
+       : ';'         { True }
+       | {- empty -} { False }
+
 scc_annot :: { Located FastString }
        : '_scc_' STRING                        {% (addWarning Opt_WarnWarningsDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
                                    ( do scc <- getSCC $2; return $ LL scc ) }