From: Pepe Iborra <mnislaih@gmail.com>
Date: Mon, 18 Dec 2006 09:53:43 +0000 (+0000)
Subject: Remove uses of Data.Traversable to fix stage1 on pre ghc-6.6 systems
X-Git-Tag: 2007-02-05~178
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=fbb68f1d6abfa3391e2cd0ea8f3c1a62ef911634

Remove uses of Data.Traversable to fix stage1 on pre ghc-6.6 systems
---

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 99b14c9..9c7c1f9 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -38,12 +38,12 @@ import ErrUtils
 import FastString
 import SrcLoc
 import Util
+import Maybes
 
 import Control.Exception
 import Control.Monad
 import qualified Data.Map as Map
 import Data.Array.Unboxed
-import Data.Traversable ( traverse )
 import Data.Typeable             ( Typeable )
 import Data.Maybe
 import Data.IORef
@@ -77,9 +77,9 @@ pprintClosureCommand bindThings force str = do
 
   -- Give names to suspensions and bind them in the local env
   mb_terms' <- if bindThings
-               then io$ mapM (traverse (bindSuspensions cms)) mb_terms
+               then io$ mapM (fmapMMaybe (bindSuspensions cms)) mb_terms
                else return mb_terms
-  ppr_terms <- io$ mapM (traverse (printTerm cms)) mb_terms' 
+  ppr_terms <- io$ mapM (fmapMMaybe (printTerm cms)) mb_terms' 
   let docs = [ ppr id <+> char '=' <+> t | (Just t,id) <- zip ppr_terms ids]
   unqual  <- io$ GHC.getPrintUnqual cms
   io . putStrLn . showSDocForUser unqual $ Outputable.vcat docs
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 9161ae4..a4d853e 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -76,6 +76,7 @@ import TysWiredIn
 import Constants        ( wORD_SIZE )
 import FastString       ( mkFastString )
 import Outputable
+import Maybes
 import Panic
 
 import GHC.Arr          ( Array(..) )
@@ -87,13 +88,10 @@ import GHC.Word         ( Word32(..), Word64(..) )
 import Control.Monad    ( liftM, liftM2, msum )
 import Data.Maybe
 import Data.List
-import Data.Traversable ( mapM )
 import Data.Array.Base
 import Foreign.Storable
 import Foreign          ( unsafePerformIO )
 
-import Prelude hiding ( mapM )
-
 ---------------------------------------------
 -- * A representation of semi evaluated Terms
 ---------------------------------------------
@@ -546,7 +544,7 @@ zonkTerm = foldTerm idTermFoldM {
               fTerm = \ty dc v tt -> sequence tt      >>= \tt ->
                                      zonkTcType ty    >>= \ty' ->
                                      return (Term ty' dc v tt)
-             ,fSuspension = \ct ty v b -> mapM zonkTcType ty >>= \ty ->
+             ,fSuspension = \ct ty v b -> fmapMMaybe zonkTcType ty >>= \ty ->
                                           return (Suspension ct ty v b)}  
 
 {-
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index ad52387..966976b 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -280,7 +280,6 @@ import System.Exit	( exitWith, ExitCode(..) )
 import System.Time	( ClockTime )
 import Control.Exception as Exception hiding (handle)
 import Data.IORef
-import Data.Traversable ( traverse )
 import System.IO
 import System.IO.Error	( isDoesNotExistError )
 import Prelude hiding (init)
diff --git a/compiler/utils/Maybes.lhs b/compiler/utils/Maybes.lhs
index 7d1fa4e..af7d3f6 100644
--- a/compiler/utils/Maybes.lhs
+++ b/compiler/utils/Maybes.lhs
@@ -17,7 +17,7 @@ module Maybes (
 	expectJust,
 	maybeToBool,
 
-	thenMaybe, seqMaybe, returnMaybe, failMaybe
+	thenMaybe, seqMaybe, returnMaybe, failMaybe, fmapMMaybe
     ) where
 
 #include "HsVersions.h"
@@ -100,6 +100,11 @@ failMaybe = Nothing
 orElse :: Maybe a -> a -> a
 (Just x) `orElse` y = x
 Nothing  `orElse` y = y
+
+fmapMMaybe :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
+fmapMMaybe f Nothing  = return Nothing
+fmapMMaybe f (Just x) = f x >>= \x' -> return (Just x')
+
 \end{code}