[project @ 2001-04-07 09:13:55 by qrczak]

[ghc-hetmet.git] / ghc / lib / std / PrelHandle.lhs

diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index 6d3e4c7..401870d 100644 (file)
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
 % ------------------------------------------------------------------------------

-% $Id: PrelHandle.lhs,v 1.64 2001/01/10 16:28:15 qrczak Exp $
+% $Id: PrelHandle.lhs,v 1.67 2001/02/22 13:17:58 simonpj Exp $

 %
 % (c) The AQUA Project, Glasgow University, 1994-2000
 %
 %
 % (c) The AQUA Project, Glasgow University, 1994-2000
 %

@@ -18,7 +18,7 @@ module PrelHandle where
 
 import PrelArr
 import PrelBase
 
 import PrelArr
 import PrelBase

-import PrelAddr                ( Addr, nullAddr )
+import PrelPtr

 import PrelByteArr     ( ByteArray(..) )
 import PrelRead                ( Read )
 import PrelList        ( break )
 import PrelByteArr     ( ByteArray(..) )
 import PrelRead                ( Read )
 import PrelList        ( break )

@@ -26,19 +26,15 @@ import PrelIOBase
 import PrelMaybe       ( Maybe(..) )
 import PrelException
 import PrelEnum
 import PrelMaybe       ( Maybe(..) )
 import PrelException
 import PrelEnum

-import PrelNum         ( toBig, Integer(..), Num(..) )
+import PrelNum         ( toBig, Integer(..), Num(..), int2Integer )

 import PrelShow
 import PrelShow

-import PrelAddr                ( Addr, nullAddr )

 import PrelReal                ( toInteger )
 import PrelPack         ( packString )
 import PrelReal                ( toInteger )
 import PrelPack         ( packString )

-#ifndef __PARALLEL_HASKELL__
-import PrelWeak                ( addForeignFinalizer )
-#endif

 
 import PrelConc
 
 #ifndef __PARALLEL_HASKELL__
 
 import PrelConc
 
 #ifndef __PARALLEL_HASKELL__

-import PrelForeign  ( makeForeignObj, mkForeignObj )
+import PrelForeign  ( newForeignPtr, mkForeignPtr, addForeignPtrFinalizer )

 #endif
 
 #endif /* ndef(__HUGS__) */
 #endif
 
 #endif /* ndef(__HUGS__) */

@@ -49,9 +45,9 @@ import PrelForeign  ( makeForeignObj, mkForeignObj )
 #endif
 
 #ifndef __PARALLEL_HASKELL__
 #endif
 
 #ifndef __PARALLEL_HASKELL__

-#define FILE_OBJECT        ForeignObj
+#define FILE_OBJECT        (ForeignPtr ())

 #else
 #else

-#define FILE_OBJECT        Addr
+#define FILE_OBJECT        (Ptr ())

 #endif
 \end{code}
 
 #endif
 \end{code}
 

@@ -60,11 +56,12 @@ mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
 mkBuffer__ fo sz_in_bytes = do
  chunk <- 
   case sz_in_bytes of
 mkBuffer__ fo sz_in_bytes = do
  chunk <- 
   case sz_in_bytes of

-    0 -> return nullAddr  -- this has the effect of overwriting the pointer to the old buffer.
+    0 -> return nullPtr  -- this has the effect of overwriting the pointer to the old buffer.

     _ -> do
      chunk <- malloc sz_in_bytes
     _ -> do
      chunk <- malloc sz_in_bytes

-     if chunk == nullAddr
-      then ioException (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
+     if chunk == nullPtr
+      then ioException (IOError Nothing ResourceExhausted
+         "mkBuffer__" "not enough virtual memory" Nothing)

       else return chunk
  setBuf fo chunk sz_in_bytes
 \end{code}
       else return chunk
  setBuf fo chunk sz_in_bytes
 \end{code}

@@ -148,9 +145,9 @@ file object reference.
 nullFile__ :: FILE_OBJECT
 nullFile__ = 
 #ifndef __PARALLEL_HASKELL__
 nullFile__ :: FILE_OBJECT
 nullFile__ = 
 #ifndef __PARALLEL_HASKELL__

-    unsafePerformIO (makeForeignObj nullAddr (return ()))
+    unsafePerformIO (newForeignPtr nullPtr (return ()))

 #else
 #else

-    nullAddr
+    nullPtr

 #endif
 
 
 #endif
 
 

@@ -193,7 +190,7 @@ foreign import "libHS_cbits" "freeStdFileObject" unsafe
 foreign import "libHS_cbits" "freeFileObject" unsafe
         freeFileObject :: FILE_OBJECT -> IO ()
 foreign import "free" unsafe 
 foreign import "libHS_cbits" "freeFileObject" unsafe
         freeFileObject :: FILE_OBJECT -> IO ()
 foreign import "free" unsafe 

-       free :: Addr -> IO ()
+       free :: Ptr a -> IO ()

 \end{code}
 
 %*********************************************************
 \end{code}
 
 %*********************************************************

@@ -220,10 +217,10 @@ stdout = unsafePerformIO (do
                              (0::Int){-writeable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
                              (0::Int){-writeable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__

-           fo <- mkForeignObj fo
+           fo <- mkForeignPtr fo

                -- I know this is deprecated, but I couldn't bring myself
                -- I know this is deprecated, but I couldn't bring myself

-               -- to move fixIO into the prelude just so I could use makeForeignObj.
-               --      --SDM
+               -- to move fixIO into the prelude just so I could use   
+               -- newForeignPtr.  --SDM

 #endif
 
 #ifdef __HUGS__
 #endif
 
 #ifdef __HUGS__

@@ -238,7 +235,7 @@ stdout = unsafePerformIO (do
            hdl <- newHandle (Handle__ fo WriteHandle bm "stdout" [])
 
 #ifndef __PARALLEL_HASKELL__
            hdl <- newHandle (Handle__ fo WriteHandle bm "stdout" [])
 
 #ifndef __PARALLEL_HASKELL__

-           addForeignFinalizer fo (stdHandleFinalizer hdl)
+           addForeignPtrFinalizer fo (stdHandleFinalizer hdl)

 #endif
            return hdl
 
 #endif
            return hdl
 

@@ -254,7 +251,7 @@ stdin = unsafePerformIO (do
                              (1::Int){-readable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
                              (1::Int){-readable-}  -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__

-            fo <- mkForeignObj fo
+            fo <- mkForeignPtr fo

 #endif
            (bm, bf_size) <- getBMode__ fo
            mkBuffer__ fo bf_size
 #endif
            (bm, bf_size) <- getBMode__ fo
            mkBuffer__ fo bf_size

@@ -263,7 +260,7 @@ stdin = unsafePerformIO (do
             -- that anything buffered on stdout is flushed prior to reading from 
             -- stdin.
 #ifndef __PARALLEL_HASKELL__
             -- that anything buffered on stdout is flushed prior to reading from 
             -- stdin.
 #ifndef __PARALLEL_HASKELL__

-           addForeignFinalizer fo (stdHandleFinalizer hdl)
+           addForeignPtrFinalizer fo (stdHandleFinalizer hdl)

 #endif
            hConnectTerms stdout hdl
            return hdl
 #endif
            hConnectTerms stdout hdl
            return hdl

@@ -280,14 +277,14 @@ stderr = unsafePerformIO (do
                              (0::Int){-writeable-} -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__
                              (0::Int){-writeable-} -- ConcHask: SAFE, won't block
 
 #ifndef __PARALLEL_HASKELL__

-            fo <- mkForeignObj fo
+            fo <- mkForeignPtr fo

 #endif
             hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr" [])
            -- when stderr and stdout are both connected to a terminal, ensure
            -- that anything buffered on stdout is flushed prior to writing to
            -- stderr.
 #ifndef __PARALLEL_HASKELL__
 #endif
             hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr" [])
            -- when stderr and stdout are both connected to a terminal, ensure
            -- that anything buffered on stdout is flushed prior to writing to
            -- stderr.
 #ifndef __PARALLEL_HASKELL__

-           addForeignFinalizer fo (stdHandleFinalizer hdl)
+           addForeignPtrFinalizer fo (stdHandleFinalizer hdl)

 #endif
            hConnectTo stdout hdl
            return hdl
 #endif
            hConnectTo stdout hdl
            return hdl

@@ -320,15 +317,15 @@ openFileEx f m = do
     fo <- primOpenFile (packString f)
                        (file_mode::Int) 
                       (binary::Int)     -- ConcHask: SAFE, won't block
     fo <- primOpenFile (packString f)
                        (file_mode::Int) 
                       (binary::Int)     -- ConcHask: SAFE, won't block

-    if fo /= nullAddr then do
+    if fo /= nullPtr then do

 #ifndef __PARALLEL_HASKELL__
 #ifndef __PARALLEL_HASKELL__

-       fo  <- mkForeignObj fo
+       fo  <- mkForeignPtr fo

 #endif
        (bm, bf_size)  <- getBMode__ fo
         mkBuffer__ fo bf_size
        hdl <- newHandle (Handle__ fo htype bm f [])
 #ifndef __PARALLEL_HASKELL__
 #endif
        (bm, bf_size)  <- getBMode__ fo
         mkBuffer__ fo bf_size
        hdl <- newHandle (Handle__ fo htype bm f [])
 #ifndef __PARALLEL_HASKELL__

-       addForeignFinalizer fo (handleFinalizer hdl)
+       addForeignPtrFinalizer fo (handleFinalizer hdl)

 #endif
        return hdl
       else do
 #endif
        return hdl
       else do

@@ -389,9 +386,9 @@ hClose handle =
                               (1::Int){-flush if you can-}  -- ConcHask: SAFE, won't block
           {- We explicitly close a file object so that we can be told
              if there were any errors. Note that after @hClose@
                               (1::Int){-flush if you can-}  -- ConcHask: SAFE, won't block
           {- We explicitly close a file object so that we can be told
              if there were any errors. Note that after @hClose@

-             has been performed, the ForeignObj embedded in the Handle
+             has been performed, the ForeignPtr embedded in the Handle

              is still lying around in the heap, so care is taken
              is still lying around in the heap, so care is taken

-             to avoid closing the file object when the ForeignObj
+             to avoid closing the file object when the ForeignPtr

              is finalized. (we overwrite the file ptr in the underlying
             FileObject with a NULL as part of closeFile())
          -}
              is finalized. (we overwrite the file ptr in the underlying
             FileObject with a NULL as part of closeFile())
          -}

@@ -520,8 +517,9 @@ hSetBuffering handle mode =
                         (IOError (Just handle)
                                  InvalidArgument
                                  "hSetBuffering"
                         (IOError (Just handle)
                                  InvalidArgument
                                  "hSetBuffering"

-                                 ("illegal buffer size " ++ showsPrec 9 n []))  
+                                 ("illegal buffer size " ++ showsPrec 9 n [])

                                        -- 9 => should be parens'ified.
                                        -- 9 => should be parens'ified.

+                                 Nothing)

       _ ->
           withHandle__ handle $ \ handle_ -> do
           case haType__ handle_ of
       _ ->
           withHandle__ handle $ \ handle_ -> do
           case haType__ handle_ of

@@ -612,7 +610,7 @@ hGetPosn handle =
     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
     posn    <- getFilePosn (haFO__ handle_)   -- ConcHask: SAFE, won't block
     if posn /= -1 then do
     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
     posn    <- getFilePosn (haFO__ handle_)   -- ConcHask: SAFE, won't block
     if posn /= -1 then do

-      return (mkHandlePosn handle (fromInt posn))
+      return (mkHandlePosn handle (int2Integer posn))

      else
       constructErrorAndFail "hGetPosn"
 
      else
       constructErrorAndFail "hGetPosn"
 

@@ -882,7 +880,7 @@ this as an extension:
 
 \begin{code}
 -- in one go, read file into an externally allocated buffer.
 
 \begin{code}
 -- in one go, read file into an externally allocated buffer.

-slurpFile :: FilePath -> IO (Addr, Int)
+slurpFile :: FilePath -> IO (Ptr (), Int)

 slurpFile fname = do
   handle <- openFile fname ReadMode
   sz     <- hFileSize handle
 slurpFile fname = do
   handle <- openFile fname ReadMode
   sz     <- hFileSize handle

@@ -891,7 +889,7 @@ slurpFile fname = do
    else do
      let sz_i = fromInteger sz
      chunk <- malloc sz_i
    else do
      let sz_i = fromInteger sz
      chunk <- malloc sz_i

-     if chunk == nullAddr 
+     if chunk == nullPtr 

       then do
         hClose handle
         constructErrorAndFail "slurpFile"
       then do
         hClose handle
         constructErrorAndFail "slurpFile"

@@ -937,21 +935,18 @@ ioeGetFileName        :: IOError -> Maybe FilePath
 ioeGetErrorString     :: IOError -> String
 ioeGetHandle          :: IOError -> Maybe Handle
 
 ioeGetErrorString     :: IOError -> String
 ioeGetHandle          :: IOError -> Maybe Handle
 

-ioeGetHandle (IOException (IOError h _ _ _))   = h
+ioeGetHandle (IOException (IOError h _ _ _ _)) = h

 ioeGetHandle (UserError _) = Nothing
 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
 
 ioeGetHandle (UserError _) = Nothing
 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
 

-ioeGetErrorString (IOException (IOError _ iot _ str)) =
+ioeGetErrorString (IOException (IOError _ iot _ str _)) =

   case iot of
     EOF -> "end of file"
     _   -> str
 ioeGetErrorString (UserError str) = str
 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
 
   case iot of
     EOF -> "end of file"
     _   -> str
 ioeGetErrorString (UserError str) = str
 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
 

-ioeGetFileName (IOException (IOError _ _  _ str)) = 
-  case break (== ':') str of
-    (_, [])      -> Nothing
-    (_, _:' ':fs)-> Just fs
+ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn

 ioeGetFileName (UserError _) = Nothing
 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
 \end{code}
 ioeGetFileName (UserError _) = Nothing
 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
 \end{code}

@@ -994,10 +989,10 @@ reportError bombOut str = do
      return ()
 
 foreign import ccall "addrOf_ErrorHdrHook" unsafe
      return ()
 
 foreign import ccall "addrOf_ErrorHdrHook" unsafe

-        addrOf_ErrorHdrHook :: Addr
+        addrOf_ErrorHdrHook :: Ptr ()

 
 foreign import ccall "writeErrString__" unsafe
 
 foreign import ccall "writeErrString__" unsafe

-       writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
+       writeErrString :: Ptr () -> ByteArray Int -> Int -> IO ()

 
 -- SUP: Are the hooks allowed to re-enter Haskell land? If yes, remove the unsafe below.
 foreign import ccall "stackOverflow" unsafe
 
 -- SUP: Are the hooks allowed to re-enter Haskell land? If yes, remove the unsafe below.
 foreign import ccall "stackOverflow" unsafe

@@ -1023,8 +1018,8 @@ wantReadableHandle fun handle act =
       _                   -> act handle_
   where
    not_readable_error = 
       _                   -> act handle_
   where
    not_readable_error = 

-          IOError (Just handle) IllegalOperation fun   
-                  ("handle is not open for reading")
+       IOError (Just handle) IllegalOperation fun      
+               "handle is not open for reading" Nothing

 
 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantWriteableHandle fun handle act = 
 
 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantWriteableHandle fun handle act = 

@@ -1040,12 +1035,12 @@ checkWriteableHandle fun handle handle_ act
   = case haType__ handle_ of 
       ClosedHandle        -> ioe_closedHandle fun handle
       SemiClosedHandle            -> ioe_closedHandle fun handle
   = case haType__ handle_ of 
       ClosedHandle        -> ioe_closedHandle fun handle
       SemiClosedHandle            -> ioe_closedHandle fun handle

-      ReadHandle          -> ioError not_writeable_error
+      ReadHandle          -> ioException not_writeable_error

       _                   -> act
   where
    not_writeable_error = 
       _                   -> act
   where
    not_writeable_error = 

-          IOException (IOError (Just handle) IllegalOperation fun
-                                       ("handle is not open for writing"))
+       IOError (Just handle) IllegalOperation fun
+               "handle is not open for writing" Nothing

 
 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantRWHandle fun handle act = 
 
 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantRWHandle fun handle act = 

@@ -1069,8 +1064,8 @@ access to a closed file.
 
 \begin{code}
 ioe_closedHandle :: String -> Handle -> IO a
 
 \begin{code}
 ioe_closedHandle :: String -> Handle -> IO a

-ioe_closedHandle fun h = ioError (IOException (IOError (Just h) IllegalOperation fun 
-                                       "handle is closed"))
+ioe_closedHandle fun h = ioException (IOError (Just h) IllegalOperation fun
+                            "handle is closed" Nothing)

 \end{code}
 
 Internal helper functions for Concurrent Haskell implementation
 \end{code}
 
 Internal helper functions for Concurrent Haskell implementation

@@ -1217,13 +1212,13 @@ foreign import "libHS_cbits" "writeFileObject" unsafe
 foreign import "libHS_cbits" "filePutc" unsafe
            filePutc         :: FILE_OBJECT -> Char -> IO Int{-ret code-}
 foreign import "libHS_cbits" "write_" unsafe
 foreign import "libHS_cbits" "filePutc" unsafe
            filePutc         :: FILE_OBJECT -> Char -> IO Int{-ret code-}
 foreign import "libHS_cbits" "write_" unsafe

-           write_           :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
+           write_           :: FILE_OBJECT -> Ptr () -> Int -> IO Int{-ret code-}

 foreign import "libHS_cbits" "getBufStart" unsafe
 foreign import "libHS_cbits" "getBufStart" unsafe

-           getBufStart      :: FILE_OBJECT -> Int -> IO Addr
+           getBufStart      :: FILE_OBJECT -> Int -> IO (Ptr ())

 foreign import "libHS_cbits" "getWriteableBuf" unsafe
 foreign import "libHS_cbits" "getWriteableBuf" unsafe

-           getWriteableBuf  :: FILE_OBJECT -> IO Addr
+           getWriteableBuf  :: FILE_OBJECT -> IO (Ptr ())

 foreign import "libHS_cbits" "getBuf" unsafe
 foreign import "libHS_cbits" "getBuf" unsafe

-           getBuf           :: FILE_OBJECT -> IO Addr
+           getBuf           :: FILE_OBJECT -> IO (Ptr ())

 foreign import "libHS_cbits" "getBufWPtr" unsafe
            getBufWPtr       :: FILE_OBJECT -> IO Int
 foreign import "libHS_cbits" "setBufWPtr" unsafe
 foreign import "libHS_cbits" "getBufWPtr" unsafe
            getBufWPtr       :: FILE_OBJECT -> IO Int
 foreign import "libHS_cbits" "setBufWPtr" unsafe

@@ -1261,7 +1256,7 @@ foreign import "libHS_cbits" "setConnectedTo" unsafe
 foreign import "libHS_cbits" "ungetChar" unsafe
            ungetChar        :: FILE_OBJECT -> Char -> IO Int{-ret code-}
 foreign import "libHS_cbits" "readChunk" unsafe
 foreign import "libHS_cbits" "ungetChar" unsafe
            ungetChar        :: FILE_OBJECT -> Char -> IO Int{-ret code-}
 foreign import "libHS_cbits" "readChunk" unsafe

-           readChunk        :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
+           readChunk        :: FILE_OBJECT -> Ptr a -> Int -> Int -> IO Int{-ret code-}

 foreign import "libHS_cbits" "getFileFd" unsafe
            getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
 #ifdef __HUGS__
 foreign import "libHS_cbits" "getFileFd" unsafe
            getFileFd        :: FILE_OBJECT -> IO Int{-fd-}
 #ifdef __HUGS__

@@ -1281,17 +1276,17 @@ foreign import "libHS_cbits" "getConnFileFd" unsafe
 foreign import "libHS_cbits" "getLock" unsafe
            getLock  :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
 foreign import "libHS_cbits" "openStdFile" unsafe
 foreign import "libHS_cbits" "getLock" unsafe
            getLock  :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
 foreign import "libHS_cbits" "openStdFile" unsafe

-           openStdFile      :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
+           openStdFile         :: Int{-fd-}
+                               -> Int{-Readable?-}
+                               -> IO (Ptr ()){-file object-}

 foreign import "libHS_cbits" "openFile" unsafe
            primOpenFile         :: ByteArray Int{-CString-}
                                -> Int{-How-}
                                -> Int{-Binary-}
 foreign import "libHS_cbits" "openFile" unsafe
            primOpenFile         :: ByteArray Int{-CString-}
                                -> Int{-How-}
                                -> Int{-Binary-}

-                               -> IO Addr {-file obj-}
+                               -> IO (Ptr ()){-file object-}

 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
            const_BUFSIZ          :: Int
 
 foreign import "libHS_cbits" "setBinaryMode__" unsafe
           setBinaryMode :: FILE_OBJECT -> Int -> IO Int
 \end{code}
 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
            const_BUFSIZ          :: Int
 
 foreign import "libHS_cbits" "setBinaryMode__" unsafe
           setBinaryMode :: FILE_OBJECT -> Int -> IO Int
 \end{code}

-
-