Add DoAndIfThenElse support

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ccf5050..85554cb 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -305,6 +305,7 @@ data ExtensionFlag
    | Opt_GADTs
    | Opt_RelaxedPolyRec
    | Opt_NPlusKPatterns
+   | Opt_DoAndIfThenElse
 
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
@@ -814,6 +815,7 @@ languageExtensions (Just Haskell2010)
        Opt_EmptyDataDecls,
        Opt_ForeignFunctionInterface,
        Opt_PatternGuards,
+       Opt_DoAndIfThenElse,
        Opt_RelaxedPolyRec]
 
 -- The DOpt class is a temporary workaround, to avoid having to do
@@ -1773,6 +1775,7 @@ xFlags = [
   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
   ( "NPlusKPatterns",                   Opt_NPlusKPatterns, const Supported ),
+  ( "DoAndIfThenElse",                  Opt_DoAndIfThenElse, const Supported ),
   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
   ( "ExplicitForAll",                   Opt_ExplicitForAll, const Supported ),
   ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, const Supported ),

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a2e2ff0..6f1b2e4 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -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 ) }

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 90220d3..32f81a7 100644 (file)
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -44,6 +44,7 @@ module RdrHsSyn (
        checkMDo,             -- [Stmt] -> P [Stmt]
        checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
        checkValSig,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
+       checkDoAndIfThenElse,
        parseError,         
        parseErrorSDoc,     
     ) where
@@ -815,6 +816,27 @@ checkValSig lhs@(L l _) ty
     looks_like_foreign _                   = False
 
     foreign_RDR = mkUnqual varName (fsLit "foreign")
+
+checkDoAndIfThenElse :: LHsExpr RdrName
+                     -> Bool
+                     -> LHsExpr RdrName
+                     -> Bool
+                     -> LHsExpr RdrName
+                     -> P ()
+checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
+ | semiThen || semiElse
+    = do pState <- getPState
+         unless (dopt Opt_DoAndIfThenElse (dflags pState)) $ do
+             parseErrorSDoc (combineLocs guardExpr elseExpr)
+                            (text "Unexpected semi-colons in conditional:"
+                          $$ nest 4 expr
+                          $$ text "Perhaps you meant to use -XDoAndIfThenElse?")
+ | otherwise            = return ()
+    where pprOptSemi True  = semi
+          pprOptSemi False = empty
+          expr = text "if"   <+> ppr guardExpr <> pprOptSemi semiThen <+>
+                 text "then" <+> ppr thenExpr  <> pprOptSemi semiElse <+>
+                 text "else" <+> ppr elseExpr
 \end{code}