Fix some more warnings
authorIan Lynagh <igloo@earth.li>
Wed, 20 Aug 2008 22:32:52 +0000 (22:32 +0000)
committerIan Lynagh <igloo@earth.li>
Wed, 20 Aug 2008 22:32:52 +0000 (22:32 +0000)
14 files changed:
Control/Exception/Base.hs
Foreign/Marshal/Alloc.hs
Foreign/Marshal/Array.hs
GHC/Conc.lhs
GHC/Handle.hs
GHC/IO.hs
GHC/Read.lhs
GHC/Word.hs
Prelude.hs
System/IO.hs
System/Posix/Internals.hs
System/Posix/Types.hs
base.cabal
include/HsBase.h

index c8f4d09..b6893fb 100644 (file)
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 #include "Typeable.h"
 
@@ -106,7 +107,6 @@ module Control.Exception.Base (
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
 import GHC.IOBase
-import GHC.List
 import GHC.Show
 import GHC.IOBase
 import GHC.Exception hiding ( Exception )
index 9911718..9fd576d 100644 (file)
@@ -109,14 +109,14 @@ alloca  = doAlloca undefined
 --
 #ifdef __GLASGOW_HASKELL__
 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
-allocaBytes (I# size) action = IO $ \ s ->
-     case newPinnedByteArray# size s      of { (# s, mbarr# #) ->
-     case unsafeFreezeByteArray# mbarr# s of { (# s, barr#  #) ->
+allocaBytes (I# size) action = IO $ \ s0 ->
+     case newPinnedByteArray# size s0      of { (# s1, mbarr# #) ->
+     case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr#  #) ->
      let addr = Ptr (byteArrayContents# barr#) in
-     case action addr    of { IO action ->
-     case action s       of { (# s, r #) ->
-     case touch# barr# s of { s ->
-     (# s, r #)
+     case action addr     of { IO action' ->
+     case action' s2      of { (# s3, r #) ->
+     case touch# barr# s3 of { s4 ->
+     (# s4, r #)
   }}}}}
 #else
 allocaBytes      :: Int -> (Ptr a -> IO b) -> IO b
index ce28ddb..2297a4d 100644 (file)
@@ -152,8 +152,8 @@ pokeArray :: Storable a => Ptr a -> [a] -> IO ()
 #ifndef __GLASGOW_HASKELL__
 pokeArray ptr vals =  zipWithM_ (pokeElemOff ptr) [0..] vals
 #else
-pokeArray ptr vals = go vals 0#
-  where go [] n#         = return ()
+pokeArray ptr vals0 = go vals0 0#
+  where go []          = return ()
         go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
 #endif
 
@@ -166,7 +166,7 @@ pokeArray0 marker ptr vals  = do
   pokeArray ptr vals
   pokeElemOff ptr (length vals) marker
 #else
-pokeArray0 marker ptr vals = go vals 0#
+pokeArray0 marker ptr vals0 = go vals0 0#
   where go [] n#         = pokeElemOff ptr (I# n#) marker
         go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
 #endif
index 6ae157e..f2875be 100644 (file)
@@ -205,7 +205,7 @@ GHC note: the new thread inherits the /blocked/ state of the parent
 -}
 forkIO :: IO () -> IO ThreadId
 forkIO action = IO $ \ s -> 
-   case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
+   case (fork# action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)
  where
   action_plus = catchException action childHandler
 
@@ -224,7 +224,7 @@ equivalent).
 -}
 forkOnIO :: Int -> IO () -> IO ThreadId
 forkOnIO (I# cpu) action = IO $ \ s -> 
-   case (forkOn# cpu action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
+   case (forkOn# cpu action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)
  where
   action_plus = catchException action childHandler
 
@@ -300,13 +300,13 @@ a pending 'throwTo'.  This is arguably undesirable behaviour.
 
  -}
 throwTo :: Exception e => ThreadId -> e -> IO ()
-throwTo (ThreadId id) ex = IO $ \ s ->
-   case (killThread# id (toException ex) s) of s1 -> (# s1, () #)
+throwTo (ThreadId tid) ex = IO $ \ s ->
+   case (killThread# tid (toException ex) s) of s1 -> (# s1, () #)
 
 -- | Returns the 'ThreadId' of the calling thread (GHC only).
 myThreadId :: IO ThreadId
 myThreadId = IO $ \s ->
-   case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
+   case (myThreadId# s) of (# s1, tid #) -> (# s1, ThreadId tid #)
 
 
 -- |The 'yield' action allows (forces, in a co-operative multitasking
@@ -439,7 +439,7 @@ bindSTM (STM m) k = STM ( \s ->
 thenSTM :: STM a -> STM b -> STM b
 thenSTM (STM m) k = STM ( \s ->
   case m s of 
-    (# new_s, a #) -> unSTM k new_s
+    (# new_s, _ #) -> unSTM k new_s
   )
 
 returnSTM :: a -> STM a
@@ -634,8 +634,8 @@ putMVar (MVar mvar#) x = IO $ \ s# ->
 tryTakeMVar :: MVar a -> IO (Maybe a)
 tryTakeMVar (MVar m) = IO $ \ s ->
     case tryTakeMVar# m s of
-        (# s, 0#, _ #) -> (# s, Nothing #)      -- MVar is empty
-        (# s, _,  a #) -> (# s, Just a  #)      -- MVar is full
+        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty
+        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full
 
 -- |A non-blocking version of 'putMVar'.  The 'tryPutMVar' function
 -- attempts to put the value @a@ into the 'MVar', returning 'True' if
@@ -661,7 +661,7 @@ isEmptyMVar (MVar mv#) = IO $ \ s# ->
 -- "System.Mem.Weak" for more about finalizers.
 addMVarFinalizer :: MVar a -> IO () -> IO ()
 addMVarFinalizer (MVar m) finalizer = 
-  IO $ \s -> case mkWeak# m () finalizer s of { (# s1, w #) -> (# s1, () #) }
+  IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
 
 withMVar :: MVar a -> (a -> IO b) -> IO b
 withMVar m io = 
@@ -730,7 +730,7 @@ threadWaitRead fd
 #endif
   | otherwise = IO $ \s -> 
         case fromIntegral fd of { I# fd# ->
-        case waitRead# fd# s of { s -> (# s, () #)
+        case waitRead# fd# s of { s' -> (# s', () #)
         }}
 
 -- | Block the current thread until data can be written to the
@@ -742,7 +742,7 @@ threadWaitWrite fd
 #endif
   | otherwise = IO $ \s -> 
         case fromIntegral fd of { I# fd# ->
-        case waitWrite# fd# s of { s -> (# s, () #)
+        case waitWrite# fd# s of { s' -> (# s', () #)
         }}
 
 -- | Suspends the current thread for a given number of microseconds
@@ -757,7 +757,7 @@ threadDelay time
   | threaded  = waitForDelayEvent time
   | otherwise = IO $ \s -> 
         case fromIntegral time of { I# time# ->
-        case delay# time# s of { s -> (# s, () #)
+        case delay# time# s of { s' -> (# s', () #)
         }}
 
 
@@ -1045,7 +1045,7 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do
 
   -- pick up new delay requests
   new_delays <- atomicModifyIORef pendingDelays (\a -> ([],a))
-  let  delays = foldr insertDelay old_delays new_delays
+  let  delays0 = foldr insertDelay old_delays new_delays
 
   -- build the FDSets for select()
   fdZero readfds
@@ -1078,7 +1078,7 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do
              else
                 return (False,delays')
 
-  (wakeup_all,delays') <- do_select delays
+  (wakeup_all,delays') <- do_select delays0
 
   exit <-
     if wakeup_all then return False
@@ -1108,8 +1108,9 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do
 
   service_loop wakeup readfds writefds ptimeval reqs' delays'
 
-io_MANAGER_WAKEUP = 0xff :: CChar
-io_MANAGER_DIE    = 0xfe :: CChar
+io_MANAGER_WAKEUP, io_MANAGER_DIE :: CChar
+io_MANAGER_WAKEUP = 0xff
+io_MANAGER_DIE    = 0xfe
 
 stick :: IORef Fd
 {-# NOINLINE stick #-}
@@ -1135,18 +1136,21 @@ foreign import ccall "setIOManagerPipe"
 -- -----------------------------------------------------------------------------
 -- IO requests
 
-buildFdSets maxfd readfds writefds [] = return maxfd
-buildFdSets maxfd readfds writefds (Read fd m : reqs)
+buildFdSets :: Fd -> Ptr CFdSet -> Ptr CFdSet -> [IOReq] -> IO Fd
+buildFdSets maxfd _       _        [] = return maxfd
+buildFdSets maxfd readfds writefds (Read fd _ : reqs)
   | fd >= fD_SETSIZE =  error "buildFdSets: file descriptor out of range"
   | otherwise        =  do
         fdSet fd readfds
         buildFdSets (max maxfd fd) readfds writefds reqs
-buildFdSets maxfd readfds writefds (Write fd m : reqs)
+buildFdSets maxfd readfds writefds (Write fd _ : reqs)
   | fd >= fD_SETSIZE =  error "buildFdSets: file descriptor out of range"
   | otherwise        =  do
         fdSet fd writefds
         buildFdSets (max maxfd fd) readfds writefds reqs
 
+completeRequests :: [IOReq] -> Ptr CFdSet -> Ptr CFdSet -> [IOReq]
+                 -> IO [IOReq]
 completeRequests [] _ _ reqs' = return reqs'
 completeRequests (Read fd m : reqs) readfds writefds reqs' = do
   b <- fdIsSet fd readfds
@@ -1159,9 +1163,10 @@ completeRequests (Write fd m : reqs) readfds writefds reqs' = do
     then do putMVar m (); completeRequests reqs readfds writefds reqs'
     else completeRequests reqs readfds writefds (Write fd m : reqs')
 
+wakeupAll :: [IOReq] -> IO ()
 wakeupAll [] = return ()
-wakeupAll (Read  fd m : reqs) = do putMVar m (); wakeupAll reqs
-wakeupAll (Write fd m : reqs) = do putMVar m (); wakeupAll reqs
+wakeupAll (Read  _ m : reqs) = do putMVar m (); wakeupAll reqs
+wakeupAll (Write _ m : reqs) = do putMVar m (); wakeupAll reqs
 
 waitForReadEvent :: Fd -> IO ()
 waitForReadEvent fd = do
@@ -1184,7 +1189,7 @@ waitForWriteEvent fd = do
 -- and return the smallest delay to wait for.  The queue of pending
 -- delays is kept ordered.
 getDelay :: USecs -> Ptr CTimeVal -> [DelayReq] -> IO ([DelayReq], Ptr CTimeVal)
-getDelay now ptimeval [] = return ([],nullPtr)
+getDelay _   _        [] = return ([],nullPtr)
 getDelay now ptimeval all@(d : rest) 
   = case d of
      Delay time m | now >= time -> do
@@ -1197,7 +1202,7 @@ getDelay now ptimeval all@(d : rest)
         setTimevalTicks ptimeval (delayTime d - now)
         return (all,ptimeval)
 
-newtype CTimeVal = CTimeVal ()
+data CTimeVal
 
 foreign import ccall unsafe "sizeofTimeVal"
   sizeofTimeVal :: Int
@@ -1216,7 +1221,7 @@ foreign import ccall unsafe "setTimevalTicks"
 
 -- ToDo: move to System.Posix.Internals?
 
-newtype CFdSet = CFdSet ()
+data CFdSet
 
 foreign import ccall safe "select"
   c_select :: CInt -> Ptr CFdSet -> Ptr CFdSet -> Ptr CFdSet -> Ptr CTimeVal
@@ -1228,12 +1233,6 @@ foreign import ccall unsafe "hsFD_SETSIZE"
 fD_SETSIZE :: Fd
 fD_SETSIZE = fromIntegral c_fD_SETSIZE
 
-foreign import ccall unsafe "hsFD_CLR"
-  c_fdClr :: CInt -> Ptr CFdSet -> IO ()
-
-fdClr :: Fd -> Ptr CFdSet -> IO ()
-fdClr (Fd fd) fdset = c_fdClr fd fdset
-
 foreign import ccall unsafe "hsFD_ISSET"
   c_fdIsSet :: CInt -> Ptr CFdSet -> IO CInt
 
index e94d2d5..2876260 100644 (file)
@@ -74,7 +74,7 @@ import GHC.List
 import GHC.IOBase
 import GHC.Exception
 import GHC.Enum
-import GHC.Num          ( Integer(..), Num(..) )
+import GHC.Num          ( Integer, Num(..) )
 import GHC.Show
 #if defined(DEBUG_DUMP)
 import GHC.Pack
@@ -96,7 +96,8 @@ import GHC.Conc
 -- Are files opened by default in text or binary mode, if the user doesn't
 -- specify?
 
-dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE = False
 
 -- ---------------------------------------------------------------------------
 -- Creating a new handle
@@ -171,6 +172,8 @@ withAllHandles__ fun h@(DuplexHandle _ r w) act = do
   withHandle__' fun h r act
   withHandle__' fun h w act
 
+withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
+              -> IO ()
 withHandle__' fun h m act =
    block $ do
    h_ <- takeMVar m
@@ -181,13 +184,14 @@ withHandle__' fun h m act =
    putMVar m h'
    return ()
 
+augmentIOError :: IOException -> String -> Handle -> IOException
 augmentIOError (IOError _ iot _ str fp) fun h
   = IOError (Just h) iot fun str filepath
   where filepath
           | Just _ <- fp = fp
           | otherwise = case h of
-                          FileHandle fp _     -> Just fp
-                          DuplexHandle fp _ _ -> Just fp
+                          FileHandle path _     -> Just path
+                          DuplexHandle path _ _ -> Just path
 
 -- ---------------------------------------------------------------------------
 -- Wrapper for write operations.
@@ -205,6 +209,7 @@ wantWritableHandle'
 wantWritableHandle' fun h m act
    = withHandle_' fun h m (checkWritableHandle act)
 
+checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
 checkWritableHandle act handle_
   = case haType handle_ of
       ClosedHandle         -> ioe_closedHandle
@@ -238,6 +243,7 @@ wantReadableHandle'
 wantReadableHandle' fun h m act
   = withHandle_' fun h m (checkReadableHandle act)
 
+checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
 checkReadableHandle act handle_ =
     case haType handle_ of
       ClosedHandle         -> ioe_closedHandle
@@ -263,6 +269,7 @@ wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
 wantSeekableHandle fun h@(FileHandle _ m) act =
   withHandle_' fun h m (checkSeekableHandle act)
 
+checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
 checkSeekableHandle act handle_ =
     case haType handle_ of
       ClosedHandle      -> ioe_closedHandle
@@ -297,6 +304,7 @@ ioe_notSeekable_notBin = ioException
       "seek operations on text-mode handles are not allowed on this platform"
         Nothing)
 
+ioe_finalizedHandle :: FilePath -> Handle__
 ioe_finalizedHandle fp = throw
    (IOError Nothing IllegalOperation ""
         "handle is finalized" (Just fp))
@@ -344,6 +352,7 @@ handleFinalizer fp m = do
 -- ---------------------------------------------------------------------------
 -- Grimy buffer operations
 
+checkBufferInvariants :: Handle__ -> IO ()
 #ifdef DEBUG
 checkBufferInvariants h_ = do
  let ref = haBuffer h_
@@ -359,7 +368,7 @@ checkBufferInvariants h_ = do
    then error "buffer invariant violation"
    else return ()
 #else
-checkBufferInvariants h_ = return ()
+checkBufferInvariants _ = return ()
 #endif
 
 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
@@ -370,18 +379,18 @@ allocateBuffer :: Int -> BufferState -> IO Buffer
 allocateBuffer sz@(I# size) state = IO $ \s -> 
    -- We sometimes need to pass the address of this buffer to
    -- a "safe" foreign call, hence it must be immovable.
-  case newPinnedByteArray# size s of { (# s, b #) ->
-  (# s, newEmptyBuffer b state sz #) }
+  case newPinnedByteArray# size s of { (# s', b #) ->
+  (# s', newEmptyBuffer b state sz #) }
 
 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
 writeCharIntoBuffer slab (I# off) (C# c)
   = IO $ \s -> case writeCharArray# slab off c s of 
-                 s -> (# s, I# (off +# 1#) #)
+               s' -> (# s', I# (off +# 1#) #)
 
 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
 readCharFromBuffer slab (I# off)
   = IO $ \s -> case readCharArray# slab off s of 
-                 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
+                 (# s', c #) -> (# s', (C# c, I# (off +# 1#)) #)
 
 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
 getBuffer fd state = do
@@ -472,6 +481,8 @@ fillReadBuffer fd is_line is_stream
 -- appears to be what GHC has done for a long time, and I suspect it
 -- is more useful than line buffering in most cases.
 
+fillReadBufferLoop :: FD -> Bool -> Bool -> Buffer -> RawBuffer -> Int -> Int
+                   -> IO Buffer
 fillReadBufferLoop fd is_line is_stream buf b w size = do
   let bytes = size - w
   if bytes == 0  -- buffer full?
@@ -775,9 +786,10 @@ foreign import ccall safe "__hscore_PrelHandle_write"
 -- or output channel respectively.  The third manages output to the
 -- standard error channel. These handles are initially open.
 
-fd_stdin  = 0 :: FD
-fd_stdout = 1 :: FD
-fd_stderr = 2 :: FD
+fd_stdin, fd_stdout, fd_stderr :: FD
+fd_stdin  = 0
+fd_stdout = 1
+fd_stderr = 2
 
 -- | A handle managing input from the Haskell program's standard input channel.
 stdin :: Handle
@@ -812,6 +824,7 @@ stderr = unsafePerformIO $ do
 -- ---------------------------------------------------------------------------
 -- Opening and Closing Files
 
+addFilePathToIOError :: String -> FilePath -> IOException -> IOException
 addFilePathToIOError fun fp (IOError h iot _ str _)
   = IOError h iot fun str (Just fp)
 
@@ -862,6 +875,7 @@ openBinaryFile fp m =
     (openFile' fp m True)
     (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
 
+openFile' :: String -> IOMode -> Bool -> IO Handle
 openFile' filepath mode binary =
   withCString filepath $ \ f ->
 
@@ -913,6 +927,8 @@ openFile' filepath mode binary =
     return h
 
 
+std_flags, output_flags, read_flags, write_flags, rw_flags,
+    append_flags :: CInt
 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 output_flags = std_flags    .|. o_CREAT
 read_flags   = std_flags    .|. o_RDONLY 
@@ -1090,7 +1106,7 @@ mkDuplexHandle fd is_stream filepath binary = do
   addMVarFinalizer write_side (handleFinalizer filepath write_side)
   return (DuplexHandle filepath read_side write_side)
    
-
+initBufferState :: HandleType -> BufferState
 initBufferState ReadHandle = ReadBuffer
 initBufferState _          = WriteBuffer
 
@@ -1119,6 +1135,7 @@ hClose h@(DuplexHandle _ r w) = do
      Nothing -> return ()
      Just e  -> throwIO e
 
+hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
 hClose' h m = withHandle' "hClose" h m $ hClose_help
 
 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
@@ -1175,6 +1192,7 @@ hClose_handle_ handle_ = do
             maybe_exception)
 
 {-# NOINLINE noBuffer #-}
+noBuffer :: Buffer
 noBuffer = unsafePerformIO $ allocateBuffer 1 ReadBuffer
 
 -----------------------------------------------------------------------------
@@ -1252,7 +1270,6 @@ hLookAhead' :: Handle__ -> IO Char
 hLookAhead' handle_ = do
   let ref     = haBuffer handle_
       fd      = haFD handle_
-      is_line = haBufferMode handle_ == LineBuffering
   buf <- readIORef ref
 
   -- fill up the read buffer if necessary
@@ -1660,6 +1677,8 @@ dupHandle h other_side h_ = do
                 Just r -> withHandle_' "dupHandle" h r (return . haFD)
   dupHandle_ other_side h_ new_fd
 
+dupHandleTo :: Maybe (MVar Handle__) -> Handle__ -> Handle__
+            -> IO (Handle__, Handle__)
 dupHandleTo other_side hto_ h_ = do
   flushBuffer h_
   -- Windows' dup2 does not return the new descriptor, unlike Unix
@@ -1719,6 +1738,7 @@ hShow :: Handle -> IO String
 hShow h@(FileHandle path _) = showHandle' path False h
 hShow h@(DuplexHandle path _ _) = showHandle' path True h
 
+showHandle' :: String -> Bool -> Handle -> IO String
 showHandle' filepath is_duplex h = 
   withHandle_ "showHandle" h $ \hdl_ ->
     let
index a5e34f2..f0d2fc1 100644 (file)
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -143,8 +143,9 @@ hGetChar handle =
            else do (c,_) <- readCharFromBuffer raw 0
                    return c
 
-hGetcBuffered fd ref buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }
- = do (c,r) <- readCharFromBuffer b r
+hGetcBuffered :: FD -> IORef Buffer -> Buffer -> IO Char
+hGetcBuffered _ ref buf@Buffer{ bufBuf=b, bufRPtr=r0, bufWPtr=w }
+ = do (c, r) <- readCharFromBuffer b r0
       let new_buf | r == w    = buf{ bufRPtr=0, bufWPtr=0 }
                   | otherwise = buf{ bufRPtr=r }
       writeIORef ref new_buf
@@ -192,7 +193,7 @@ hGetLineBuffered handle_ = do
 hGetLineBufferedLoop :: Handle__ -> IORef Buffer -> Buffer -> [String]
                      -> IO String
 hGetLineBufferedLoop handle_ ref
-        buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss =
+        buf@Buffer{ bufRPtr=r0, bufWPtr=w, bufBuf=raw0 } xss =
   let
         -- find the end-of-line character, if there is one
         loop raw r
@@ -203,13 +204,13 @@ hGetLineBufferedLoop handle_ ref
                    then return (True, r) -- NB. not r': don't include the '\n'
                    else loop raw r'
   in do
-  (eol, off) <- loop raw r
+  (eol, off) <- loop raw0 r0
 
 #ifdef DEBUG_DUMP
-  puts ("hGetLineBufferedLoop: r=" ++ show r ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")
+  puts ("hGetLineBufferedLoop: r=" ++ show r0 ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")
 #endif
 
-  xs <- unpack raw r off
+  xs <- unpack raw0 r0 off
 
   -- if eol == True, then off is the offset of the '\n'
   -- otherwise off == w and the buffer is now empty.
@@ -233,11 +234,11 @@ hGetLineBufferedLoop handle_ ref
                 Just new_buf ->
                      hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
 
-
+maybeFillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO (Maybe Buffer)
 maybeFillReadBuffer fd is_line is_stream buf
   = catch 
-     (do buf <- fillReadBuffer fd is_line is_stream buf
-         return (Just buf)
+     (do buf' <- fillReadBuffer fd is_line is_stream buf
+         return (Just buf')
      )
      (\e -> do if isEOFError e 
                   then return Nothing 
@@ -245,14 +246,14 @@ maybeFillReadBuffer fd is_line is_stream buf
 
 
 unpack :: RawBuffer -> Int -> Int -> IO [Char]
-unpack buf r 0   = return ""
-unpack buf (I# r) (I# len) = IO $ \s -> unpack [] (len -# 1#) s
+unpack _   _      0        = return ""
+unpack buf (I# r) (I# len) = IO $ \s -> unpackRB [] (len -# 1#) s
    where
-    unpack acc i s
+    unpackRB acc i s
      | i <# r  = (# s, acc #)
      | otherwise = 
           case readCharArray# buf i s of
-            (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
+          (# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'
 
 
 hGetLineUnBuffered :: Handle -> IO String
@@ -340,6 +341,7 @@ lazyRead handle =
                   (IOError (Just handle) IllegalOperation "lazyRead"
                         "illegal handle type" Nothing)
 
+lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])
 lazyRead' h handle_ = do
   let ref = haBuffer handle_
       fd  = haFD handle_
@@ -357,8 +359,8 @@ lazyRead' h handle_ = do
         let raw = bufBuf buf
         r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1
         if r == 0
-           then do (handle_,_) <- hClose_help handle_ 
-                   return (handle_, "")
+           then do (handle_', _) <- hClose_help handle_ 
+                   return (handle_', "")
            else do (c,_) <- readCharFromBuffer raw 0
                    rest <- lazyRead h
                    return (handle_, c : rest)
@@ -368,17 +370,20 @@ lazyRead' h handle_ = do
 
 -- we never want to block during the read, so we call fillReadBuffer with
 -- is_line==True, which tells it to "just read what there is".
+lazyReadBuffered :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer
+                 -> IO (Handle__, [Char])
 lazyReadBuffered h handle_ fd ref buf = do
    catch 
-        (do buf <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf
-            lazyReadHaveBuffer h handle_ fd ref buf
+        (do buf' <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf
+            lazyReadHaveBuffer h handle_ fd ref buf'
         )
         -- all I/O errors are discarded.  Additionally, we close the handle.
-        (\e -> do (handle_,_) <- hClose_help handle_
-                  return (handle_, "")
+        (\_ -> do (handle_', _) <- hClose_help handle_
+                  return (handle_', "")
         )
 
-lazyReadHaveBuffer h handle_ fd ref buf = do
+lazyReadHaveBuffer :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer -> IO (Handle__, [Char])
+lazyReadHaveBuffer h handle_ _ ref buf = do
    more <- lazyRead h
    writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
    s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
@@ -386,14 +391,14 @@ lazyReadHaveBuffer h handle_ fd ref buf = do
 
 
 unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
-unpackAcc buf r 0 acc  = return acc
-unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s
+unpackAcc _   _      0        acc  = return acc
+unpackAcc buf (I# r) (I# len) acc0 = IO $ \s -> unpackRB acc0 (len -# 1#) s
    where
-    unpack acc i s
+    unpackRB acc i s
      | i <# r  = (# s, acc #)
      | otherwise = 
           case readCharArray# buf i s of
-            (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
+          (# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'
 
 -- ---------------------------------------------------------------------------
 -- hPutChar
@@ -421,6 +426,7 @@ hPutChar handle c = do
                   writeRawBufferPtr "hPutChar" fd (haIsStream handle_) buf 0 1
                   return ()
 
+hPutcBuffered :: Handle__ -> Bool -> Char -> IO ()
 hPutcBuffered handle_ is_line c = do
   let ref = haBuffer handle_
   buf <- readIORef ref
@@ -436,7 +442,7 @@ hPutcBuffered handle_ is_line c = do
 
 
 hPutChars :: Handle -> [Char] -> IO ()
-hPutChars handle [] = return ()
+hPutChars _      [] = return ()
 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
 
 -- ---------------------------------------------------------------------------
@@ -583,6 +589,8 @@ commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
 --
 -- This hack is a fairly big win for hPutStr performance.  --SDM 18/9/2001
 --
+commitBuffer' :: RawBuffer -> Int -> Int -> Bool -> Bool -> Handle__
+              -> IO Buffer
 commitBuffer' raw sz@(I# _) count@(I# _) flush release
   handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
 
@@ -591,7 +599,7 @@ commitBuffer' raw sz@(I# _) count@(I# _) flush release
             ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
 #endif
 
-      old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
+      old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }
           <- readIORef ref
 
       buf_ret <-
@@ -688,12 +696,13 @@ hPutBuf' handle ptr count can_block
   | count <  0 = illegalBufferSize handle "hPutBuf" count
   | otherwise = 
     wantWritableHandle "hPutBuf" handle $ 
-      \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> 
+      \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> 
           bufWrite fd ref is_stream ptr count can_block
 
+bufWrite :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Bool -> IO Int
 bufWrite fd ref is_stream ptr count can_block =
   seq count $ seq fd $ do  -- strictness hack
-  old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
+  old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }
      <- readIORef ref
 
   -- enough room in handle buffer?
@@ -717,7 +726,7 @@ bufWrite fd ref is_stream ptr count can_block =
                            else writeChunkNonBlocking fd is_stream ptr count
 
 writeChunk :: FD -> Bool -> Ptr CChar -> Int -> IO ()
-writeChunk fd is_stream ptr bytes = loop 0 bytes 
+writeChunk fd is_stream ptr bytes0 = loop 0 bytes0
  where
   loop :: Int -> Int -> IO ()
   loop _   bytes | bytes <= 0 = return ()
@@ -729,7 +738,13 @@ writeChunk fd is_stream ptr bytes = loop 0 bytes
     loop (off + r) (bytes - r)
 
 writeChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int
-writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes 
+writeChunkNonBlocking fd
+#ifndef mingw32_HOST_OS
+                         _
+#else
+                         is_stream
+#endif
+                                   ptr bytes0 = loop 0 bytes0
  where
   loop :: Int -> Int -> IO Int
   loop off bytes | bytes <= 0 = return off
@@ -775,12 +790,13 @@ hGetBuf h ptr count
   | count <  0 = illegalBufferSize h "hGetBuf" count
   | otherwise = 
       wantReadableHandle "hGetBuf" h $ 
-        \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
+        \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
             bufRead fd ref is_stream ptr 0 count
 
 -- small reads go through the buffer, large reads are satisfied by
 -- taking data first from the buffer and then direct from the file
 -- descriptor.
+bufRead :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Int -> IO Int
 bufRead fd ref is_stream ptr so_far count =
   seq fd $ seq so_far $ seq count $ do -- strictness hack
   buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
@@ -823,7 +839,7 @@ bufRead fd ref is_stream ptr so_far count =
         return (so_far' + rest)
 
 readChunk :: FD -> Bool -> Ptr a -> Int -> IO Int
-readChunk fd is_stream ptr bytes = loop 0 bytes 
+readChunk fd is_stream ptr bytes0 = loop 0 bytes0
  where
   loop :: Int -> Int -> IO Int
   loop off bytes | bytes <= 0 = return off
@@ -855,9 +871,11 @@ hGetBufNonBlocking h ptr count
   | count <  0 = illegalBufferSize h "hGetBufNonBlocking" count
   | otherwise = 
       wantReadableHandle "hGetBufNonBlocking" h $ 
-        \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
+        \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
             bufReadNonBlocking fd ref is_stream ptr 0 count
 
+bufReadNonBlocking :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Int
+                   -> IO Int
 bufReadNonBlocking fd ref is_stream ptr so_far count =
   seq fd $ seq so_far $ seq count $ do -- strictness hack
   buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
@@ -866,13 +884,13 @@ bufReadNonBlocking fd ref is_stream ptr so_far count =
                 then do rest <- readChunkNonBlocking fd is_stream ptr count
                         return (so_far + rest)
                 else do buf' <- fillReadBufferWithoutBlocking fd is_stream buf
-                        case buf' of { Buffer{ bufWPtr=w }  ->
-                        if (w == 0) 
+                        case buf' of { Buffer{ bufWPtr=w' }  ->
+                        if (w' == 0) 
                            then return so_far
                            else do writeIORef ref buf'
                                    bufReadNonBlocking fd ref is_stream ptr
-                                         so_far (min count w)
-                                  -- NOTE: new count is 'min count w'
+                                         so_far (min count w')
+                                  -- NOTE: new count is    min count w'
                                   -- so we will just copy the contents of the
                                   -- buffer in the recursive call, and not
                                   -- loop again.
index b890b46..f99e2df 100644 (file)
@@ -67,7 +67,7 @@ import {-# SOURCE #-} GHC.Unicode       ( isDigit )
 #endif
 import GHC.Num
 import GHC.Real
-import GHC.Float
+import GHC.Float ()
 import GHC.Show
 import GHC.Base
 import GHC.Arr
index 4af74fa..68afadf 100644 (file)
@@ -690,22 +690,22 @@ instance Enum Word64 where
     enumFromThenTo      = integralEnumFromThenTo
 
 instance Integral Word64 where
-    quot    x@(W64# x#) y@(W64# y#)
+    quot    (W64# x#) y@(W64# y#)
         | y /= 0                    = W64# (x# `quotWord64#` y#)
         | otherwise                 = divZeroError
-    rem     x@(W64# x#) y@(W64# y#)
+    rem     (W64# x#) y@(W64# y#)
         | y /= 0                    = W64# (x# `remWord64#` y#)
         | otherwise                 = divZeroError
-    div     x@(W64# x#) y@(W64# y#)
+    div     (W64# x#) y@(W64# y#)
         | y /= 0                    = W64# (x# `quotWord64#` y#)
         | otherwise                 = divZeroError
-    mod     x@(W64# x#) y@(W64# y#)
+    mod     (W64# x#) y@(W64# y#)
         | y /= 0                    = W64# (x# `remWord64#` y#)
         | otherwise                 = divZeroError
-    quotRem x@(W64# x#) y@(W64# y#)
+    quotRem (W64# x#) y@(W64# y#)
         | y /= 0                    = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))
         | otherwise                 = divZeroError
-    divMod  x@(W64# x#) y@(W64# y#)
+    divMod  (W64# x#) y@(W64# y#)
         | y /= 0                    = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))
         | otherwise                 = divZeroError
     toInteger (W64# x#)             = word64ToInteger x#
index 050da04..4f01b9f 100644 (file)
@@ -155,7 +155,6 @@ import Data.Tuple
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
 import GHC.IOBase
-import GHC.Exception ( throw )
 import Text.Read
 import GHC.Enum
 import GHC.Num
index 3d3893d..0142d10 100644 (file)
@@ -169,6 +169,7 @@ import Data.List
 import Data.Maybe
 import Foreign.C.Error
 import Foreign.C.String
+import Foreign.C.Types
 import System.Posix.Internals
 #endif
 
@@ -510,12 +511,10 @@ pathSeparator = '/'
 
 #ifndef __NHC__
 -- XXX Copied from GHC.Handle
+std_flags, output_flags, rw_flags :: CInt
 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 output_flags = std_flags    .|. o_CREAT
-read_flags   = std_flags    .|. o_RDONLY
-write_flags  = output_flags .|. o_WRONLY
 rw_flags     = output_flags .|. o_RDWR
-append_flags = write_flags  .|. o_APPEND
 #endif
 
 #ifdef __NHC__
index 5b9eb95..0b4f7d4 100644 (file)
@@ -112,6 +112,7 @@ fdStat fd =
 fdType :: FD -> IO FDType
 fdType fd = do (ty,_,_) <- fdStat fd; return ty
 
+statGetType :: Ptr CStat -> IO FDType
 statGetType p_stat = do
   c_mode <- st_mode p_stat :: IO CMode
   case () of
@@ -123,7 +124,7 @@ statGetType p_stat = do
         | s_isblk c_mode        -> return RawDevice
         | otherwise             -> ioError ioe_unknownfiletype
     
-
+ioe_unknownfiletype :: IOException
 ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
                         "unknown file type" Nothing
 
@@ -171,27 +172,27 @@ fdIsTTY fd = c_isatty fd >>= return.toBool
 setEcho :: FD -> Bool -> IO ()
 setEcho fd on = do
   tcSetAttr fd $ \ p_tios -> do
-    c_lflag <- c_lflag p_tios :: IO CTcflag
-    let new_c_lflag
-         | on        = c_lflag .|. fromIntegral const_echo
-         | otherwise = c_lflag .&. complement (fromIntegral const_echo)
-    poke_c_lflag p_tios (new_c_lflag :: CTcflag)
+    lflag <- c_lflag p_tios :: IO CTcflag
+    let new_lflag
+         | on        = lflag .|. fromIntegral const_echo
+         | otherwise = lflag .&. complement (fromIntegral const_echo)
+    poke_c_lflag p_tios (new_lflag :: CTcflag)
 
 getEcho :: FD -> IO Bool
 getEcho fd = do
   tcSetAttr fd $ \ p_tios -> do
-    c_lflag <- c_lflag p_tios :: IO CTcflag
-    return ((c_lflag .&. fromIntegral const_echo) /= 0)
+    lflag <- c_lflag p_tios :: IO CTcflag
+    return ((lflag .&. fromIntegral const_echo) /= 0)
 
 setCooked :: FD -> Bool -> IO ()
 setCooked fd cooked = 
   tcSetAttr fd $ \ p_tios -> do
 
     -- turn on/off ICANON
-    c_lflag <- c_lflag p_tios :: IO CTcflag
-    let new_c_lflag | cooked    = c_lflag .|. (fromIntegral const_icanon)
-                    | otherwise = c_lflag .&. complement (fromIntegral const_icanon)
-    poke_c_lflag p_tios (new_c_lflag :: CTcflag)
+    lflag <- c_lflag p_tios :: IO CTcflag
+    let new_lflag | cooked    = lflag .|. (fromIntegral const_icanon)
+                  | otherwise = lflag .&. complement (fromIntegral const_icanon)
+    poke_c_lflag p_tios (new_lflag :: CTcflag)
 
     -- set VMIN & VTIME to 1/0 respectively
     when (not cooked) $ do
@@ -293,7 +294,7 @@ foreign import ccall unsafe "consUtils.h get_console_echo__"
 -- Turning on non-blocking for a file descriptor
 
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
+setNonBlockingFD :: FD -> IO ()
 setNonBlockingFD fd = do
   flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
                  (c_fcntl_read fd const_f_getfl)
index 14fdcf8..1935179 100644 (file)
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Posix.Types
index b17a05e..7871047 100644 (file)
@@ -66,7 +66,7 @@ Library {
                     ForeignFunctionInterface, UnliftedFFITypes,
                     DeriveDataTypeable, GeneralizedNewtypeDeriving,
                     FlexibleInstances, PatternSignatures, StandaloneDeriving,
-                    PatternGuards
+                    PatternGuards, EmptyDataDecls
     }
     exposed-modules:
         Control.Applicative,
index f69e9cf..63b0d5c 100644 (file)
@@ -691,7 +691,6 @@ INLINE int __hscore_fstat(int fd, struct_stat *buf) {
 
 #if !defined(__MINGW32__)
 INLINE int  hsFD_SETSIZE(void) { return FD_SETSIZE; }
-INLINE void hsFD_CLR(int fd, fd_set *fds) { FD_CLR(fd, fds); }
 INLINE int  hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); }
 INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); }
 INLINE HsInt sizeof_fd_set(void) { return sizeof(fd_set); }