Remove GHC's haskell98 dependency

[ghc-hetmet.git] / compiler / rename / RnExpr.lhs

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 32d4c4c..beee037 100644 (file)
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -41,16 +41,13 @@ import NameSet
 import RdrName
 import LoadIface       ( loadInterfaceForName )
 import UniqSet
-import List            ( nub )
+import Data.List
 import Util            ( isSingleton )
 import ListSetOps      ( removeDups )
 import Maybes          ( expectJust )
 import Outputable
 import SrcLoc
 import FastString
-
-import List            ( unzip4 )
-import Control.Monad
 \end{code}
 
 
@@ -240,10 +237,14 @@ rnExpr (ExplicitPArr _ exps)
   = rnExprs exps                       `thenM` \ (exps', fvs) ->
     return  (ExplicitPArr placeHolderType exps', fvs)
 
-rnExpr (ExplicitTuple exps boxity)
-  = checkTupSize (length exps)                 `thenM_`
-    rnExprs exps                               `thenM` \ (exps', fvs) ->
-    return (ExplicitTuple exps' boxity, fvs)
+rnExpr (ExplicitTuple tup_args boxity)
+  = do { checkTupleSection tup_args
+       ; checkTupSize (length tup_args)
+       ; (tup_args', fvs) <- mapAndUnzipM rnTupArg tup_args
+       ; return (ExplicitTuple tup_args' boxity, plusFVs fvs) }
+  where
+    rnTupArg (Present e) = do { (e',fvs) <- rnLExpr e; return (Present e', fvs) }
+    rnTupArg (Missing _) = return (Missing placeHolderType, emptyFVs)
 
 rnExpr (RecordCon con_id _ rbinds)
   = do { conname <- lookupLocatedOccRn con_id
@@ -569,7 +570,7 @@ rnBracket :: HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
 rnBracket (VarBr n) = do { name <- lookupOccRn n
                         ; this_mod <- getModule
                         ; checkM (nameIsLocalOrFrom this_mod name) $   -- Reason: deprecation checking asumes the
-                          do { loadInterfaceForName msg name           -- home interface is loaded, and this is the
+                          do { _ <- loadInterfaceForName msg name      -- home interface is loaded, and this is the
                              ; return () }                             -- only way that is going to happen
                         ; return (VarBr name, unitFV name) }
                    where
@@ -794,7 +795,7 @@ rnParallelStmts ctxt segs thing_inside = do
             let (bndrs', dups) = removeDups cmpByOcc bndrs
                 inner_env = extendLocalRdrEnv orig_lcl_env bndrs'
             
-            mapM dupErr dups
+            mapM_ dupErr dups
             (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
             return (([], thing), fvs)
 
@@ -1194,7 +1195,15 @@ checkTransformStmt (TransformStmtCtxt ctxt) = checkTransformStmt ctxt    -- Ok to n
 checkTransformStmt ctxt = addErr msg
   where
     msg = ptext (sLit "Illegal transform or grouping in") <+> pprStmtContext ctxt
-    
+
+---------
+checkTupleSection :: [HsTupArg RdrName] -> RnM ()
+checkTupleSection args
+  = do { tuple_section <- doptM Opt_TupleSections
+       ; checkErr (all tupArgPresent args || tuple_section) msg }
+  where
+    msg = ptext (sLit "Illegal tuple section: use -XTupleSections")
+
 ---------
 sectionErr :: HsExpr RdrName -> SDoc
 sectionErr expr