From: Ian Lynagh <igloo@earth.li>
Date: Wed, 20 Aug 2008 23:39:58 +0000 (+0000)
Subject: Fix more warnings
X-Git-Tag: 6_10_branch_has_been_forked~31
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2b2397221c29a275630c62d4982caedc2c7cd987;p=ghc-base.git

Fix more warnings
---

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index b9e52cb..f22aca8 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -99,7 +99,6 @@ import GHC.Exception
 import GHC.Conc         ( ThreadId(..), myThreadId, killThread, yield,
                           threadDelay, forkIO, childHandler )
 import qualified GHC.Conc
-import GHC.TopHandler   ( reportStackOverflow, reportError )
 import GHC.IOBase       ( IO(..) )
 import GHC.IOBase       ( unsafeInterleaveIO )
 import GHC.IOBase       ( newIORef, readIORef, writeIORef )
@@ -344,6 +343,7 @@ foreign export ccall forkOS_entry
 foreign import ccall "forkOS_entry" forkOS_entry_reimported
     :: StablePtr (IO ()) -> IO ()
 
+forkOS_entry :: StablePtr (IO ()) -> IO ()
 forkOS_entry stableAction = do
         action <- deRefStablePtr stableAction
         action
@@ -351,6 +351,7 @@ forkOS_entry stableAction = do
 foreign import ccall forkOS_createThread
     :: StablePtr (IO ()) -> IO CInt
 
+failNonThreaded :: IO a
 failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
                        ++"(use ghc -threaded when linking)"
 
@@ -431,7 +432,7 @@ runInUnboundThread action = do
         then do
             mv <- newEmptyMVar
             forkIO (Exception.try action >>= putMVar mv)
-            takeMVar mv >>= \either -> case either of
+            takeMVar mv >>= \ei -> case ei of
                 Left exception -> Exception.throw (exception :: SomeException)
                 Right result -> return result
         else action
diff --git a/Control/Concurrent/Chan.hs b/Control/Concurrent/Chan.hs
index ee2132a..12f75c9 100644
--- a/Control/Concurrent/Chan.hs
+++ b/Control/Concurrent/Chan.hs
@@ -63,9 +63,9 @@ data ChItem a = ChItem a (Stream a)
 newChan :: IO (Chan a)
 newChan = do
    hole  <- newEmptyMVar
-   read  <- newMVar hole
-   write <- newMVar hole
-   return (Chan read write)
+   readVar  <- newMVar hole
+   writeVar <- newMVar hole
+   return (Chan readVar writeVar)
 
 -- To put an element on a channel, a new hole at the write end is created.
 -- What was previously the empty @MVar@ at the back of the channel is then
@@ -74,16 +74,16 @@ newChan = do
 
 -- |Write a value to a 'Chan'.
 writeChan :: Chan a -> a -> IO ()
-writeChan (Chan _read write) val = do
+writeChan (Chan _ writeVar) val = do
   new_hole <- newEmptyMVar
-  modifyMVar_ write $ \old_hole -> do
+  modifyMVar_ writeVar $ \old_hole -> do
     putMVar old_hole (ChItem val new_hole)
     return new_hole
 
 -- |Read the next value from the 'Chan'.
 readChan :: Chan a -> IO a
-readChan (Chan read _write) = do
-  modifyMVar read $ \read_end -> do
+readChan (Chan readVar _) = do
+  modifyMVar readVar $ \read_end -> do
     (ChItem val new_read_end) <- readMVar read_end
         -- Use readMVar here, not takeMVar,
         -- else dupChan doesn't work
@@ -94,24 +94,24 @@ readChan (Chan read _write) = do
 -- a kind of broadcast channel, where data written by anyone is seen by
 -- everyone else.
 dupChan :: Chan a -> IO (Chan a)
-dupChan (Chan _read write) = do
-   hole     <- readMVar write
-   new_read <- newMVar hole
-   return (Chan new_read write)
+dupChan (Chan _ writeVar) = do
+   hole       <- readMVar writeVar
+   newReadVar <- newMVar hole
+   return (Chan newReadVar writeVar)
 
 -- |Put a data item back onto a channel, where it will be the next item read.
 unGetChan :: Chan a -> a -> IO ()
-unGetChan (Chan read _write) val = do
+unGetChan (Chan readVar _) val = do
    new_read_end <- newEmptyMVar
-   modifyMVar_ read $ \read_end -> do
+   modifyMVar_ readVar $ \read_end -> do
      putMVar new_read_end (ChItem val read_end)
      return new_read_end
 
 -- |Returns 'True' if the supplied 'Chan' is empty.
 isEmptyChan :: Chan a -> IO Bool
-isEmptyChan (Chan read write) = do
-   withMVar read $ \r -> do
-     w <- readMVar write
+isEmptyChan (Chan readVar writeVar) = do
+   withMVar readVar $ \r -> do
+     w <- readMVar writeVar
      let eq = r == w
      eq `seq` return eq
 
diff --git a/Control/Concurrent/QSem.hs b/Control/Concurrent/QSem.hs
index 0258810..87f5543 100644
--- a/Control/Concurrent/QSem.hs
+++ b/Control/Concurrent/QSem.hs
@@ -41,8 +41,8 @@ INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem")
 
 -- |Build a new 'QSem'
 newQSem :: Int -> IO QSem
-newQSem init = do
-   sem <- newMVar (init,[])
+newQSem initial = do
+   sem <- newMVar (initial, [])
    return (QSem sem)
 
 -- |Wait for a unit to become available
diff --git a/Control/Concurrent/QSemN.hs b/Control/Concurrent/QSemN.hs
index ed96a3c..014a72c 100644
--- a/Control/Concurrent/QSemN.hs
+++ b/Control/Concurrent/QSemN.hs
@@ -36,8 +36,8 @@ INSTANCE_TYPEABLE0(QSemN,qSemNTc,"QSemN")
 
 -- |Build a new 'QSemN' with a supplied initial quantity.
 newQSemN :: Int -> IO QSemN 
-newQSemN init = do
-   sem <- newMVar (init,[])
+newQSemN initial = do
+   sem <- newMVar (initial, [])
    return (QSemN sem)
 
 -- |Wait for the specified quantity to become available
diff --git a/Control/Concurrent/SampleVar.hs b/Control/Concurrent/SampleVar.hs
index 8084757..69c29c2 100644
--- a/Control/Concurrent/SampleVar.hs
+++ b/Control/Concurrent/SampleVar.hs
@@ -112,6 +112,6 @@ writeSampleVar svar v = do
 --
 isEmptySampleVar :: SampleVar a -> IO Bool
 isEmptySampleVar svar = do
-   (readers,val) <- readMVar svar
+   (readers, _) <- readMVar svar
    return (readers == 0)
 
diff --git a/Control/Monad/ST.hs b/Control/Monad/ST.hs
index 46ae8a2..b779664 100644
--- a/Control/Monad/ST.hs
+++ b/Control/Monad/ST.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Monad.ST
diff --git a/Control/OldException.hs b/Control/OldException.hs
index cdd5af8..37d5e1e 100644
--- a/Control/OldException.hs
+++ b/Control/OldException.hs
@@ -376,8 +376,8 @@ catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 #ifdef __NHC__
 catchDyn m k = m        -- can't catch dyn exceptions in nhc98
 #else
-catchDyn m k = New.catch m handle
-  where handle ex = case ex of
+catchDyn m k = New.catch m handler
+  where handler ex = case ex of
                            (DynException dyn) ->
                                 case fromDynamic dyn of
                                     Just exception  -> k exception
@@ -699,9 +699,6 @@ data Exception
         -- record update in the source program.
 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
 
-nonTermination :: SomeException
-nonTermination = New.toException NonTermination
-
 -- helper type for simplifying the type casting logic below
 data Caster = forall e . ExceptionBase.Exception e => Caster (e -> Exception)
 
@@ -709,8 +706,8 @@ instance New.Exception Exception where
   -- We need to collect all the sorts of exceptions that used to be
   -- bundled up into the Exception type, and rebundle them for
   -- legacy handlers.
-  fromException (SomeException exc) = foldr tryCast Nothing casters where
-    tryCast (Caster f) e = case cast exc of
+  fromException (SomeException exc0) = foldr tryCast Nothing casters where
+    tryCast (Caster f) e = case cast exc0 of
       Just exc -> Just (f exc)
       _        -> e
     casters =
diff --git a/Data/Foldable.hs b/Data/Foldable.hs
index eaf0ab6..cb573c4 100644
--- a/Data/Foldable.hs
+++ b/Data/Foldable.hs
@@ -143,10 +143,10 @@ class Foldable t where
 -- instances for Prelude types
 
 instance Foldable Maybe where
-        foldr f z Nothing = z
+        foldr _ z Nothing = z
         foldr f z (Just x) = f x z
 
-        foldl f z Nothing = z
+        foldl _ z Nothing = z
         foldl f z (Just x) = f z x
 
 instance Foldable [] where
@@ -161,25 +161,25 @@ instance Ix i => Foldable (Array i) where
 -- | Fold over the elements of a structure,
 -- associating to the right, but strictly.
 foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b
-foldr' f z xs = foldl f' id xs z
+foldr' f z0 xs = foldl f' id xs z0
   where f' k x z = k $! f x z
 
 -- | Monadic fold over the elements of a structure,
 -- associating to the right, i.e. from right to left.
 foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
-foldrM f z xs = foldl f' return xs z
+foldrM f z0 xs = foldl f' return xs z0
   where f' k x z = f x z >>= k
 
 -- | Fold over the elements of a structure,
 -- associating to the left, but strictly.
 foldl' :: Foldable t => (a -> b -> a) -> a -> t b -> a
-foldl' f z xs = foldr f' id xs z
+foldl' f z0 xs = foldr f' id xs z0
   where f' x k z = k $! f z x
 
 -- | Monadic fold over the elements of a structure,
 -- associating to the left, i.e. from left to right.
 foldlM :: (Foldable t, Monad m) => (a -> b -> m a) -> a -> t b -> m a
-foldlM f z xs = foldr f' return xs z
+foldlM f z0 xs = foldr f' return xs z0
   where f' x k z = f z x >>= k
 
 -- | Map each element of a structure to an action, evaluate
diff --git a/Data/Traversable.hs b/Data/Traversable.hs
index 969e720..30aaee6 100644
--- a/Data/Traversable.hs
+++ b/Data/Traversable.hs
@@ -103,7 +103,7 @@ class (Functor t, Foldable t) => Traversable t where
 -- instances for Prelude types
 
 instance Traversable Maybe where
-        traverse f Nothing = pure Nothing
+        traverse _ Nothing = pure Nothing
         traverse f (Just x) = Just <$> f x
 
 instance Traversable [] where
diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs
index 422b8b0..b5a7411 100644
--- a/GHC/TopHandler.lhs
+++ b/GHC/TopHandler.lhs
@@ -179,9 +179,6 @@ cleanUp = do
   hFlush stdout `catchAny` \_ -> return ()
   hFlush stderr `catchAny` \_ -> return ()
 
-cleanUpAndExit :: Int -> IO a
-cleanUpAndExit r = do cleanUp; safeExit r
-
 -- we have to use unsafeCoerce# to get the 'IO a' result type, since the
 -- compiler doesn't let us declare that as the result type of a foreign export.
 safeExit :: Int -> IO a
diff --git a/System/Exit.hs b/System/Exit.hs
index f11a071..e211ca5 100644
--- a/System/Exit.hs
+++ b/System/Exit.hs
@@ -23,7 +23,6 @@ module System.Exit
 import Prelude
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Exception
 import GHC.IOBase
 #endif
 
diff --git a/System/Info.hs b/System/Info.hs
index 597f2c8..b38aea2 100644
--- a/System/Info.hs
+++ b/System/Info.hs
@@ -27,8 +27,8 @@ import Data.Version
 -- | The version of 'compilerName' with which the program was compiled
 -- or is being interpreted.
 compilerVersion :: Version
-compilerVersion = Version {versionBranch=[maj,min], versionTags=[]}
-  where (maj,min) = compilerVersionRaw `divMod` 100
+compilerVersion = Version {versionBranch=[major, minor], versionTags=[]}
+  where (major, minor) = compilerVersionRaw `divMod` 100
 
 -- | The operating system on which the program is running.
 os :: String
diff --git a/System/Mem/Weak.hs b/System/Mem/Weak.hs
index e5d8d69..e6a8a37 100644
--- a/System/Mem/Weak.hs
+++ b/System/Mem/Weak.hs
@@ -69,8 +69,6 @@ module System.Mem.Weak (
 
 import Prelude
 
-import Data.Typeable
-
 #ifdef __HUGS__
 import Hugs.Weak
 #endif
diff --git a/System/Timeout.hs b/System/Timeout.hs
index 9ccc634..431f709 100644
--- a/System/Timeout.hs
+++ b/System/Timeout.hs
@@ -20,12 +20,11 @@ module System.Timeout ( timeout ) where
 
 #ifdef __GLASGOW_HASKELL__
 import Prelude             (Show(show), IO, Ord((<)), Eq((==)), Int,
-                            (.), otherwise, fmap)
+                            otherwise, fmap)
 import Data.Maybe          (Maybe(..))
-import Control.Monad       (Monad(..), guard)
+import Control.Monad       (Monad(..))
 import Control.Concurrent  (forkIO, threadDelay, myThreadId, killThread)
 import Control.Exception   (Exception, handleJust, throwTo, bracket)
-import Data.Dynamic        (Typeable, fromDynamic)
 import Data.Typeable
 import Data.Unique         (Unique, newUnique)
 
diff --git a/Text/Show/Functions.hs b/Text/Show/Functions.hs
index 315d4d3..8c76f4a 100644
--- a/Text/Show/Functions.hs
+++ b/Text/Show/Functions.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Text.Show.Functions