Fix bitrot in IO debugging code

Also switched to using Haskell Bools (rather than CPP) to en/disable it,
so it shouldn't break again in the future.

diff --git a/GHC/IO/Encoding/Iconv.hs b/GHC/IO/Encoding/Iconv.hs
index 8ef87c9..4de9cfe 100644 (file)
--- a/GHC/IO/Encoding/Iconv.hs
+++ b/GHC/IO/Encoding/Iconv.hs
@@ -30,8 +30,6 @@ module GHC.IO.Encoding.Iconv (
 
 #if !defined(mingw32_HOST_OS)
 
-#undef DEBUG_DUMP
-
 import Foreign
 import Foreign.C
 import Data.Maybe
@@ -41,27 +39,21 @@ import GHC.IO.Encoding.Types
 import GHC.Num
 import GHC.Show
 import GHC.Real
-#ifdef DEBUG_DUMP
 import System.Posix.Internals
-#endif
 
-iconv_trace :: String -> IO ()
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
 
-#ifdef DEBUG_DUMP
-
-iconv_trace s = puts s
+iconv_trace :: String -> IO ()
+iconv_trace s
+ | c_DEBUG_DUMP = puts s
+ | otherwise    = return ()
 
 puts :: String -> IO ()
-puts s = do withCStringLen (s++"\n") $ \(p, len) -> 
-                c_write 1 (castPtr p) (fromIntegral len)
+puts s = do _ <- withCStringLen (s ++ "\n") $ \(p, len) ->
+                     c_write 1 (castPtr p) (fromIntegral len)
             return ()
 
-#else
-
-iconv_trace _ = return ()
-
-#endif
-
 -- -----------------------------------------------------------------------------
 -- iconv encoders/decoders
 

diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs
index 98eeeab..4425a3a 100644 (file)
--- a/GHC/IO/FD.hs
+++ b/GHC/IO/FD.hs
@@ -22,17 +22,13 @@ module GHC.IO.FD (
   stdin, stdout, stderr
   ) where
 
-#undef DEBUG_DUMP
-
 import GHC.Base
 import GHC.Num
 import GHC.Real
 import GHC.Show
 import GHC.Enum
 import Data.Maybe
-#ifndef mingw32_HOST_OS
 import Control.Monad
-#endif
 import Data.Typeable
 
 import GHC.IO
@@ -51,6 +47,9 @@ import System.Posix.Internals hiding (FD, setEcho, getEcho)
 import System.Posix.Types
 -- import GHC.Ptr
 
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
+
 -- -----------------------------------------------------------------------------
 -- The file-descriptor IO device
 
@@ -108,20 +107,17 @@ instance BufferedIO FD where
 
 readBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)
 readBuf' fd buf = do
-#ifdef DEBUG_DUMP
-  puts ("readBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
-#endif
+  when c_DEBUG_DUMP $
+      puts ("readBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
   (r,buf') <- readBuf fd buf
-#ifdef DEBUG_DUMP
-  puts ("after: " ++ summaryBuffer buf' ++ "\n")
-#endif
+  when c_DEBUG_DUMP $
+      puts ("after: " ++ summaryBuffer buf' ++ "\n")
   return (r,buf')
 
 writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8)
 writeBuf' fd buf = do
-#ifdef DEBUG_DUMP
-  puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
-#endif
+  when c_DEBUG_DUMP $
+      puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
   writeBuf fd buf
 
 -- -----------------------------------------------------------------------------
@@ -626,8 +622,7 @@ foreign import ccall unsafe "unlockFile"
   unlockFile :: CInt -> IO CInt
 #endif
 
-#if defined(DEBUG_DUMP)
 puts :: String -> IO ()
-puts s = do withCStringLen s $ \(p,len) -> c_write 1 p (fromIntegral len)
+puts s = do _ <- withCStringLen s $ \(p,len) ->
+                     c_write 1 (castPtr p) (fromIntegral len)
             return ()
-#endif

diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index cc9e3d3..afac030 100644 (file)
--- a/GHC/IO/Handle/Internals.hs
+++ b/GHC/IO/Handle/Internals.hs
@@ -4,8 +4,6 @@
 {-# OPTIONS_GHC -XRecordWildCards #-}
 {-# OPTIONS_HADDOCK hide #-}
 
-#undef DEBUG_DUMP
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IO.Handle.Internals
@@ -74,9 +72,10 @@ import Foreign
 -- import System.IO.Error
 import System.Posix.Internals hiding (FD)
 
-#ifdef DEBUG_DUMP
 import Foreign.C
-#endif
+
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
 
 -- ---------------------------------------------------------------------------
 -- Creating a new handle
@@ -673,13 +672,12 @@ hLookAhead_ handle_@Handle__{..} = do
 -- debugging
 
 debugIO :: String -> IO ()
-#if defined(DEBUG_DUMP)
-debugIO s = do 
-  withCStringLen (s++"\n") $ \(p,len) -> c_write 1 (castPtr p) (fromIntegral len)
-  return ()
-#else
-debugIO s = return ()
-#endif
+debugIO s
+ | c_DEBUG_DUMP
+    = do _ <- withCStringLen (s ++ "\n") $
+                  \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
+         return ()
+ | otherwise = return ()
 
 -- ----------------------------------------------------------------------------
 -- Text input/output