X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelHandle.lhs;h=401870d252aeaf12875f9fed7cd981114aab9772;hb=50027272414438955dbc41696541cbd25da55883;hp=01b7182b235ca1f617a0e58cb13bb6cd22c5449c;hpb=f5448f5c5efe0630cb865ee0d21691a23ea932d3;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs index 01b7182..401870d 100644 --- a/ghc/lib/std/PrelHandle.lhs +++ b/ghc/lib/std/PrelHandle.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelHandle.lhs,v 1.63 2000/11/07 10:42:56 simonmar Exp $ +% $Id: PrelHandle.lhs,v 1.67 2001/02/22 13:17:58 simonpj Exp $ % % (c) The AQUA Project, Glasgow University, 1994-2000 % @@ -18,27 +18,23 @@ module PrelHandle where import PrelArr import PrelBase -import PrelAddr ( Addr, nullAddr ) +import PrelPtr import PrelByteArr ( ByteArray(..) ) import PrelRead ( Read ) -import PrelList ( span ) +import PrelList ( break ) import PrelIOBase import PrelMaybe ( Maybe(..) ) import PrelException import PrelEnum -import PrelNum ( toBig, Integer(..), Num(..) ) +import PrelNum ( toBig, Integer(..), Num(..), int2Integer ) import PrelShow -import PrelAddr ( Addr, nullAddr ) import PrelReal ( toInteger ) import PrelPack ( packString ) -#ifndef __PARALLEL_HASKELL__ -import PrelWeak ( addForeignFinalizer ) -#endif import PrelConc #ifndef __PARALLEL_HASKELL__ -import PrelForeign ( makeForeignObj, mkForeignObj ) +import PrelForeign ( newForeignPtr, mkForeignPtr, addForeignPtrFinalizer ) #endif #endif /* ndef(__HUGS__) */ @@ -49,9 +45,9 @@ import PrelForeign ( makeForeignObj, mkForeignObj ) #endif #ifndef __PARALLEL_HASKELL__ -#define FILE_OBJECT ForeignObj +#define FILE_OBJECT (ForeignPtr ()) #else -#define FILE_OBJECT Addr +#define FILE_OBJECT (Ptr ()) #endif \end{code} @@ -60,11 +56,12 @@ mkBuffer__ :: FILE_OBJECT -> Int -> IO () 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 - 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} @@ -148,9 +145,9 @@ file object reference. nullFile__ :: FILE_OBJECT nullFile__ = #ifndef __PARALLEL_HASKELL__ - unsafePerformIO (makeForeignObj nullAddr (return ())) + unsafePerformIO (newForeignPtr nullPtr (return ())) #else - nullAddr + nullPtr #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 - free :: Addr -> IO () + free :: Ptr a -> IO () \end{code} %********************************************************* @@ -220,10 +217,10 @@ stdout = unsafePerformIO (do (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 - -- 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__ @@ -238,7 +235,7 @@ stdout = unsafePerformIO (do hdl <- newHandle (Handle__ fo WriteHandle bm "stdout" []) #ifndef __PARALLEL_HASKELL__ - addForeignFinalizer fo (stdHandleFinalizer hdl) + addForeignPtrFinalizer fo (stdHandleFinalizer hdl) #endif return hdl @@ -254,7 +251,7 @@ stdin = unsafePerformIO (do (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 @@ -263,7 +260,7 @@ stdin = unsafePerformIO (do -- 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 @@ -280,14 +277,14 @@ stderr = unsafePerformIO (do (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__ - addForeignFinalizer fo (stdHandleFinalizer hdl) + addForeignPtrFinalizer fo (stdHandleFinalizer 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 - if fo /= nullAddr then do + if fo /= nullPtr then do #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__ - addForeignFinalizer fo (handleFinalizer hdl) + addForeignPtrFinalizer fo (handleFinalizer hdl) #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@ - 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 - 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()) -} @@ -520,8 +517,9 @@ hSetBuffering handle mode = (IOError (Just handle) InvalidArgument "hSetBuffering" - ("illegal buffer size " ++ showsPrec 9 n [])) + ("illegal buffer size " ++ showsPrec 9 n []) -- 9 => should be parens'ified. + Nothing) _ -> 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 - return (mkHandlePosn handle (fromInt posn)) + return (mkHandlePosn handle (int2Integer posn)) else constructErrorAndFail "hGetPosn" @@ -882,7 +880,7 @@ this as an extension: \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 @@ -891,7 +889,7 @@ slurpFile fname = do else do let sz_i = fromInteger sz chunk <- malloc sz_i - if chunk == nullAddr + if chunk == nullPtr then do hClose handle constructErrorAndFail "slurpFile" @@ -937,20 +935,20 @@ ioeGetFileName :: IOError -> Maybe FilePath ioeGetErrorString :: IOError -> String ioeGetHandle :: IOError -> Maybe Handle -ioeGetHandle (IOException (IOError h _ _ _)) = h -ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error" +ioeGetHandle (IOException (IOError h _ _ _ _)) = h +ioeGetHandle (UserError _) = Nothing +ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error" -ioeGetErrorString (IOException (IOError _ iot _ str)) = - case iot of - EOF -> "end of file" - _ -> str -ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error" +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" -ioeGetFileName (IOException (IOError _ _ _ str)) = - case span (/=':') str of - (_,[]) -> Nothing - (fs,_) -> Just fs -ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error" +ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn +ioeGetFileName (UserError _) = Nothing +ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error" \end{code} 'Top-level' IO actions want to catch exceptions (e.g., forkIO and @@ -991,10 +989,10 @@ reportError bombOut str = do return () foreign import ccall "addrOf_ErrorHdrHook" unsafe - addrOf_ErrorHdrHook :: Addr + addrOf_ErrorHdrHook :: Ptr () 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 @@ -1020,8 +1018,8 @@ wantReadableHandle fun handle act = _ -> 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 = @@ -1037,12 +1035,12 @@ checkWriteableHandle fun handle handle_ act = 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 = - 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 = @@ -1066,8 +1064,8 @@ access to a closed file. \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 @@ -1214,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 - write_ :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-} + write_ :: FILE_OBJECT -> Ptr () -> Int -> IO Int{-ret code-} foreign import "libHS_cbits" "getBufStart" unsafe - getBufStart :: FILE_OBJECT -> Int -> IO Addr + getBufStart :: FILE_OBJECT -> Int -> IO (Ptr ()) foreign import "libHS_cbits" "getWriteableBuf" unsafe - getWriteableBuf :: FILE_OBJECT -> IO Addr + getWriteableBuf :: FILE_OBJECT -> IO (Ptr ()) 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 @@ -1258,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 - 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__ @@ -1278,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 - 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-} - -> 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} - -