From 06a069adc1c7ab7a4267bb7ed3cdc35732d29dc1 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 27 Feb 2002 14:32:23 +0000
Subject: [PATCH] [project @ 2002-02-27 14:32:23 by simonmar] Define hTell in
 GHC.Handle, and export it from System.IO

---
 GHC/Handle.hs |   61 +++++++++++++++++++++++++++++++--------------------------
 System/IO.hs  |    3 ++-
 2 files changed, 35 insertions(+), 29 deletions(-)

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 0984ab0..8ad83d5 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -4,7 +4,7 @@
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: Handle.hs,v 1.4 2002/02/07 11:13:30 simonmar Exp $
+-- $Id: Handle.hs,v 1.5 2002/02/27 14:32:23 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
@@ -29,7 +29,7 @@ module GHC.Handle (
   hClose, hClose_help,
 
   HandlePosn(..), hGetPosn, hSetPosn,
-  SeekMode(..), hSeek,
+  SeekMode(..), hSeek, hTell,
 
   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
   hSetEcho, hGetEcho, hIsTerminalDevice,
@@ -962,32 +962,9 @@ type HandlePosition = Integer
 -- position of `hdl' to a previously obtained position `p'.
 
 hGetPosn :: Handle -> IO HandlePosn
-hGetPosn handle =
-    wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
-
-#if defined(mingw32_TARGET_OS)
-	-- urgh, on Windows we have to worry about \n -> \r\n translation, 
-	-- so we can't easily calculate the file position using the
-	-- current buffer size.  Just flush instead.
-      flushBuffer handle_
-#endif
-      let fd = fromIntegral (haFD handle_)
-      posn <- fromIntegral `liftM`
-	        throwErrnoIfMinus1Retry "hGetPosn"
-		   (c_lseek fd 0 sEEK_CUR)
-
-      let ref = haBuffer handle_
-      buf <- readIORef ref
-
-      let real_posn 
-	   | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
-	   | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
-#     ifdef DEBUG_DUMP
-      puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
-      puts ("   (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
-#     endif
-      return (HandlePosn handle real_posn)
-
+hGetPosn handle = do
+    posn <- hTell handle
+    return (HandlePosn handle posn)
 
 hSetPosn :: HandlePosn -> IO () 
 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
@@ -1061,6 +1038,34 @@ hSeek handle mode offset =
     writeIORef ref new_buf
     do_seek
 
+
+hTell :: Handle -> IO Integer
+hTell handle = 
+    wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
+
+#if defined(mingw32_TARGET_OS)
+	-- urgh, on Windows we have to worry about \n -> \r\n translation, 
+	-- so we can't easily calculate the file position using the
+	-- current buffer size.  Just flush instead.
+      flushBuffer handle_
+#endif
+      let fd = fromIntegral (haFD handle_)
+      posn <- fromIntegral `liftM`
+	        throwErrnoIfMinus1Retry "hGetPosn"
+		   (c_lseek fd 0 sEEK_CUR)
+
+      let ref = haBuffer handle_
+      buf <- readIORef ref
+
+      let real_posn 
+	   | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
+	   | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
+#     ifdef DEBUG_DUMP
+      puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
+      puts ("   (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
+#     endif
+      return real_posn
+
 -- -----------------------------------------------------------------------------
 -- Handle Properties
 
diff --git a/System/IO.hs b/System/IO.hs
index cb1caab..66e7b4e 100644
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: IO.hs,v 1.4 2002/02/12 10:51:06 simonmar Exp $
+-- $Id: IO.hs,v 1.5 2002/02/27 14:32:23 simonmar Exp $
 --
 -- The standard IO library.
 --
@@ -37,6 +37,7 @@ module System.IO (
     hGetPosn,		       -- :: Handle -> IO HandlePosn
     hSetPosn,		       -- :: HandlePosn -> IO ()
     hSeek,		       -- :: Handle -> SeekMode -> Integer -> IO ()
+    hTell,		       -- :: Handle -> IO Integer
     hWaitForInput,	       -- :: Handle -> Int -> IO Bool
     hReady,		       -- :: Handle -> IO Bool
     hGetChar,		       -- :: Handle -> IO Char
-- 
1.7.10.4