From: simonmar <unknown>
Date: Thu, 29 Aug 2002 11:49:11 +0000 (+0000)
Subject: [project @ 2002-08-29 11:49:10 by simonmar]
X-Git-Tag: nhc98-1-18-release~896
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=bb4edcf0f0e7144f34cb36d1b71d113d80c96b64;p=haskell-directory.git

[project @ 2002-08-29 11:49:10 by simonmar]
Make the readline binding into a hierarchical library and put it in
its own package (for licensing reasons).

As part of this, I moved fdToHandle from PosixIO into GHC.Handle (and
updated the code to avoid using _casm_) since Readline requires it.

I've also updated Readline to use the latest FFI syntax.
---

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 7c252c5..43ef3d4 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -29,7 +29,7 @@ module GHC.Handle (
   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
 
   stdin, stdout, stderr,
-  IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
+  IOMode(..), IOModeEx(..), openFile, openFileEx, openFd, fdToHandle,
   hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
   hFlush, 
 
@@ -555,9 +555,6 @@ Two files are the same if they have the same absolute name.  An
 implementation is free to impose stricter conditions.
 -}
 
-data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
-                    deriving (Eq, Ord, Ix, Enum, Read, Show)
-
 data IOModeEx 
  = BinaryMode IOMode
  | TextMode   IOMode
@@ -674,6 +671,12 @@ openFd fd mb_fd_type filepath mode binary truncate = do
 	   mkFileHandle fd is_stream filepath ha_type binary
 
 
+fdToHandle :: FD -> IO Handle
+fdToHandle fd = do
+   mode <- fdGetMode fd
+   let fd_str = "<file descriptor: " ++ show fd ++ ">"
+   openFd fd Nothing fd_str mode True{-bin mode-} False{-no truncate-}
+
 foreign import ccall unsafe "lockFile"
   lockFile :: CInt -> CInt -> CInt -> IO CInt
 
diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index 32beb1b..5f84206 100644
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -17,6 +17,8 @@
 module GHC.IOBase where
 
 import GHC.ST
+import GHC.Arr	-- to derive Ix class
+import GHC.Enum -- to derive Enum class
 import GHC.STRef
 import GHC.Base
 import GHC.Num	-- To get fromInteger etc, needed because of -fno-implicit-prelude
@@ -772,4 +774,10 @@ instance Show IOException where
       (case fn of
 	 Nothing -> id
 	 Just name -> showString "\nFile: " . showString name)
+
+-- -----------------------------------------------------------------------------
+-- IOMode type
+
+data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
+                    deriving (Eq, Ord, Ix, Enum, Read, Show)
 \end{code}
diff --git a/GHC/Posix.hs b/GHC/Posix.hs
index 5ae6c0c..d492e29 100644
--- a/GHC/Posix.hs
+++ b/GHC/Posix.hs
@@ -140,6 +140,24 @@ foreign import stdcall unsafe "closesocket"
    c_closesocket :: CInt -> IO CInt
 #endif
 
+fdGetMode :: Int -> IO IOMode
+fdGetMode fd = do
+    flags <- throwErrnoIfMinus1Retry "fdGetMode" 
+		(c_fcntl_read (fromIntegral fd) const_f_getfl)
+    
+    let
+       wH  = (flags .&. o_WRONLY) /= 0
+       aH  = (flags .&. o_APPEND) /= 0
+       rwH = (flags .&. o_RDWR) /= 0
+
+       mode
+	 | wH && aH  = AppendMode
+	 | wH        = WriteMode
+	 | rwH       = ReadWriteMode
+	 | otherwise = ReadMode
+	  
+    return mode
+
 -- ---------------------------------------------------------------------------
 -- Terminal-related stuff
 
diff --git a/include/HsBase.h b/include/HsBase.h
index 0d9aab3..f409a96 100644
--- a/include/HsBase.h
+++ b/include/HsBase.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HsBase.h,v 1.10 2002/07/17 09:22:20 simonmar Exp $
+ * $Id: HsBase.h,v 1.11 2002/08/29 11:49:11 simonmar Exp $
  *
  * (c) The University of Glasgow 2001-2002
  *
@@ -111,6 +111,9 @@ int *ghcErrno(void);
 /* in system.c */
 HsInt systemCmd(HsAddr cmd);
 
+/* in rawSystem.c */
+HsInt rawSystemCmd(HsAddr cmd);
+
 /* in inputReady.c */
 int inputReady(int fd, int msecs, int isSock);
 
@@ -584,3 +587,4 @@ __hscore_f_setfl( void )
 
 #endif
 
+INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); }