Add DoAndIfThenElse support

[ghc-hetmet.git] / compiler / parser / RdrHsSyn.lhs

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index ac1a028..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
@@ -362,7 +363,7 @@ splitCon ty
    split (L _ (HsAppTy t u)) ts = split t (u : ts)
    split (L l (HsTyVar tc))  ts = do data_con <- tyConToDataCon l tc
                                     return (data_con, mk_rest ts)
-   split (L l _) _             = parseError l "parse error in data/newtype declaration"
+   split (L l _) _             = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
 
    mk_rest [L _ (HsRecTy flds)] = RecCon flds
    mk_rest ts                   = PrefixCon ts
@@ -799,12 +800,14 @@ checkValSig
 checkValSig (L l (HsVar v)) ty 
   | isUnqual v && not (isDataOcc (rdrNameOcc v))
   = return (TypeSig (L l v) ty)
-checkValSig lhs@(L l _)         _
-  | looks_like_foreign lhs
-  = parseError l "Invalid type signature; perhaps you meant to use -XForeignFunctionInterface?"
-  | otherwise
-  = parseError l "Invalid type signature: should be of form <variable> :: <type>"
+checkValSig lhs@(L l _) ty
+  = parseErrorSDoc l ((text "Invalid type signature:" <+>
+                       ppr lhs <+> text "::" <+> ppr ty)
+                   $$ text hint)
   where
+    hint = if looks_like_foreign lhs
+           then "Perhaps you meant to use -XForeignFunctionInterface?"
+           else "Should be of form <variable> :: <type>"
     -- A common error is to forget the ForeignFunctionInterface flag
     -- so check for that, and suggest.  cf Trac #3805
     -- Sadly 'foreign import' still barfs 'parse error' because 'import' is a keyword
@@ -813,6 +816,27 @@ checkValSig lhs@(L l _)         _
     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}