1 % ------------------------------------------------------------------------------
2 % $Id: PrelHandle.lhs,v 1.61 2000/08/29 16:37:35 simonpj Exp $
4 % (c) The AQUA Project, Glasgow University, 1994-2000
7 \section[PrelHandle]{Module @PrelHandle@}
9 This module defines Haskell {\em handles} and the basic operations
10 which are supported for them.
13 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
14 #include "cbits/stgerror.h"
16 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
17 module PrelHandle where
21 import PrelAddr ( Addr, nullAddr )
22 import PrelByteArr ( ByteArray(..) )
23 import PrelRead ( Read )
24 import PrelList ( span )
26 import PrelMaybe ( Maybe(..) )
29 import PrelNum ( toBig, Integer(..), Num(..) )
31 import PrelAddr ( Addr, nullAddr )
32 import PrelReal ( toInteger )
33 import PrelPack ( packString )
34 #ifndef __PARALLEL_HASKELL__
35 import PrelWeak ( addForeignFinalizer )
40 #ifndef __PARALLEL_HASKELL__
41 import PrelForeign ( makeForeignObj, mkForeignObj )
44 #endif /* ndef(__HUGS__) */
47 #define __CONCURRENT_HASKELL__
51 #ifndef __PARALLEL_HASKELL__
52 #define FILE_OBJECT ForeignObj
54 #define FILE_OBJECT Addr
59 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
60 mkBuffer__ fo sz_in_bytes = do
63 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
65 chunk <- allocMemory__ sz_in_bytes
67 then ioException (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
69 setBuf fo chunk sz_in_bytes
72 %*********************************************************
74 \subsection{Types @Handle@, @Handle__@}
76 %*********************************************************
78 The @Handle@ and @Handle__@ types are defined in @IOBase@.
81 {-# INLINE newHandle #-}
82 newHandle :: Handle__ -> IO Handle
84 -- Use MVars for concurrent Haskell
85 newHandle hc = newMVar hc >>= \ h ->
89 %*********************************************************
91 \subsection{@withHandle@ operations}
93 %*********************************************************
95 In the concurrent world, handles are locked during use. This is done
96 by wrapping an MVar around the handle which acts as a mutex over
97 operations on the handle.
99 To avoid races, we use the following bracketing operations. The idea
100 is to obtain the lock, do some operation and replace the lock again,
101 whether the operation succeeded or failed. We also want to handle the
102 case where the thread receives an exception while processing the IO
103 operation: in these cases we also want to relinquish the lock.
105 There are three versions of @withHandle@: corresponding to the three
106 possible combinations of:
108 - the operation may side-effect the handle
109 - the operation may return a result
111 If the operation generates an error or an exception is raised, the
112 orignal handle is always replaced [ this is the case at the moment,
113 but we might want to revisit this in the future --SDM ].
116 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
117 {-# INLINE withHandle #-}
118 withHandle (Handle h) act =
119 blockAsyncExceptions $ do
121 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
125 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
126 {-# INLINE withHandle_ #-}
127 withHandle_ (Handle h) act =
128 blockAsyncExceptions $ do
130 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
134 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
135 {-# INLINE withHandle__ #-}
136 withHandle__ (Handle h) act =
137 blockAsyncExceptions $ do
139 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
144 nullFile__ is only used for closed handles, plugging it in as a null
145 file object reference.
148 nullFile__ :: FILE_OBJECT
150 #ifndef __PARALLEL_HASKELL__
151 unsafePerformIO (makeForeignObj nullAddr (return ()))
157 mkClosedHandle__ :: Handle__
159 Handle__ { haFO__ = nullFile__,
160 haType__ = ClosedHandle,
161 haBufferMode__ = NoBuffering,
162 haFilePath__ = "closed file",
166 mkErrorHandle__ :: IOException -> Handle__
167 mkErrorHandle__ ioe =
168 Handle__ { haFO__ = nullFile__,
169 haType__ = (ErrorHandle ioe),
170 haBufferMode__ = NoBuffering,
171 haFilePath__ = "error handle",
176 %*********************************************************
178 \subsection{Handle Finalizers}
180 %*********************************************************
183 stdHandleFinalizer :: Handle -> IO ()
184 stdHandleFinalizer (Handle hdl) = do
185 handle <- takeMVar hdl
186 let fo = haFO__ handle
188 freeBuffers (haBuffers__ handle)
190 handleFinalizer :: Handle -> IO ()
191 handleFinalizer (Handle hdl) = do
192 handle <- takeMVar hdl
193 let fo = haFO__ handle
195 freeBuffers (haBuffers__ handle)
197 freeBuffers [] = return ()
198 freeBuffers (b:bs) = do { free b; freeBuffers bs }
200 foreign import "libHS_cbits" "freeStdFileObject" unsafe
201 freeStdFileObject :: FILE_OBJECT -> IO ()
202 foreign import "libHS_cbits" "freeFileObject" unsafe
203 freeFileObject :: FILE_OBJECT -> IO ()
204 foreign import "free" unsafe
205 free :: Addr -> IO ()
208 %*********************************************************
210 \subsection[StdHandles]{Standard handles}
212 %*********************************************************
214 Three handles are allocated during program initialisation. The first
215 two manage input or output from the Haskell program's standard input
216 or output channel respectively. The third manages output to the
217 standard error channel. These handles are initially open.
221 stdin, stdout, stderr :: Handle
223 stdout = unsafePerformIO (do
224 rc <- getLock (1::Int) (1::Int) -- ConcHask: SAFE, won't block
226 0 -> newHandle (mkClosedHandle__)
228 fo <- openStdFile (1::Int)
229 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
231 #ifndef __PARALLEL_HASKELL__
232 fo <- mkForeignObj fo
233 -- I know this is deprecated, but I couldn't bring myself
234 -- to move fixIO into the prelude just so I could use makeForeignObj.
239 /* I dont care what the Haskell report says, in an interactive system,
240 * stdout should be unbuffered by default.
244 (bm, bf_size) <- getBMode__ fo
245 mkBuffer__ fo bf_size
247 hdl <- newHandle (Handle__ fo WriteHandle bm "stdout" [])
249 #ifndef __PARALLEL_HASKELL__
250 addForeignFinalizer fo (stdHandleFinalizer hdl)
254 _ -> do ioError <- constructError "stdout"
255 newHandle (mkErrorHandle__ ioError)
258 stdin = unsafePerformIO (do
259 rc <- getLock (0::Int) (0::Int) -- ConcHask: SAFE, won't block
261 0 -> newHandle (mkClosedHandle__)
263 fo <- openStdFile (0::Int)
264 (1::Int){-readable-} -- ConcHask: SAFE, won't block
266 #ifndef __PARALLEL_HASKELL__
267 fo <- mkForeignObj fo
269 (bm, bf_size) <- getBMode__ fo
270 mkBuffer__ fo bf_size
271 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin" [])
272 -- when stdin and stdout are both connected to a terminal, ensure
273 -- that anything buffered on stdout is flushed prior to reading from
275 #ifndef __PARALLEL_HASKELL__
276 addForeignFinalizer fo (stdHandleFinalizer hdl)
278 hConnectTerms stdout hdl
280 _ -> do ioError <- constructError "stdin"
281 newHandle (mkErrorHandle__ ioError)
285 stderr = unsafePerformIO (do
286 rc <- getLock (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
288 0 -> newHandle (mkClosedHandle__)
290 fo <- openStdFile (2::Int)
291 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
293 #ifndef __PARALLEL_HASKELL__
294 fo <- mkForeignObj fo
296 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr" [])
297 -- when stderr and stdout are both connected to a terminal, ensure
298 -- that anything buffered on stdout is flushed prior to writing to
300 #ifndef __PARALLEL_HASKELL__
301 addForeignFinalizer fo (stdHandleFinalizer hdl)
303 hConnectTo stdout hdl
306 _ -> do ioError <- constructError "stderr"
307 newHandle (mkErrorHandle__ ioError)
311 %*********************************************************
313 \subsection[OpeningClosing]{Opening and Closing Files}
315 %*********************************************************
318 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
319 deriving (Eq, Ord, Ix, Enum, Read, Show)
324 deriving (Eq, Read, Show)
326 openFile :: FilePath -> IOMode -> IO Handle
327 openFile fp im = openFileEx fp (TextMode im)
329 openFileEx :: FilePath -> IOModeEx -> IO Handle
332 fo <- primOpenFile (packString f)
334 (binary::Int) -- ConcHask: SAFE, won't block
335 if fo /= nullAddr then do
336 #ifndef __PARALLEL_HASKELL__
337 fo <- mkForeignObj fo
339 (bm, bf_size) <- getBMode__ fo
340 mkBuffer__ fo bf_size
341 hdl <- newHandle (Handle__ fo htype bm f [])
342 #ifndef __PARALLEL_HASKELL__
343 addForeignFinalizer fo (handleFinalizer hdl)
347 constructErrorAndFailWithInfo "openFile" f
351 BinaryMode bmo -> (bmo, 1)
352 TextMode tmo -> (tmo, 0)
362 ReadMode -> ReadHandle
363 WriteMode -> WriteHandle
364 AppendMode -> AppendHandle
365 ReadWriteMode -> ReadWriteHandle
368 Computation $openFile file mode$ allocates and returns a new, open
369 handle to manage the file {\em file}. It manages input if {\em mode}
370 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
371 and both input and output if mode is $ReadWriteMode$.
373 If the file does not exist and it is opened for output, it should be
374 created as a new file. If {\em mode} is $WriteMode$ and the file
375 already exists, then it should be truncated to zero length. The
376 handle is positioned at the end of the file if {\em mode} is
377 $AppendMode$, and otherwise at the beginning (in which case its
378 internal position is 0).
380 Implementations should enforce, locally to the Haskell process,
381 multiple-reader single-writer locking on files, which is to say that
382 there may either be many handles on the same file which manage input,
383 or just one handle on the file which manages output. If any open or
384 semi-closed handle is managing a file for output, no new handle can be
385 allocated for that file. If any open or semi-closed handle is
386 managing a file for input, new handles can only be allocated if they
387 do not manage output.
389 Two files are the same if they have the same absolute name. An
390 implementation is free to impose stricter conditions.
393 hClose :: Handle -> IO ()
396 withHandle__ handle $ \ handle_ -> do
397 case haType__ handle_ of
398 ErrorHandle theError -> ioException theError
399 ClosedHandle -> return handle_
401 rc <- closeFile (haFO__ handle_)
402 (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
403 {- We explicitly close a file object so that we can be told
404 if there were any errors. Note that after @hClose@
405 has been performed, the ForeignObj embedded in the Handle
406 is still lying around in the heap, so care is taken
407 to avoid closing the file object when the ForeignObj
408 is finalized. (we overwrite the file ptr in the underlying
409 FileObject with a NULL as part of closeFile())
413 then constructErrorAndFail "hClose"
415 -- free the spare buffers (except the handle buffer)
416 -- associated with this handle.
417 else do freeBuffers (haBuffers__ handle_)
418 return (handle_{ haType__ = ClosedHandle,
422 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
423 computation finishes, any items buffered for output and not already
424 sent to the operating system are flushed as for $flush$.
426 %*********************************************************
428 \subsection[FileSize]{Detecting the size of a file}
430 %*********************************************************
433 For a handle {\em hdl} which attached to a physical file, $hFileSize
434 hdl$ returns the size of {\em hdl} in terms of the number of items
435 which can be read from {\em hdl}.
438 hFileSize :: Handle -> IO Integer
440 withHandle_ handle $ \ handle_ -> do
441 case haType__ handle_ of
442 ErrorHandle theError -> ioException theError
443 ClosedHandle -> ioe_closedHandle "hFileSize" handle
444 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
447 mem <- primNewByteArray 8{-sizeof_int64-}
448 rc <- fileSize_int64 (haFO__ handle_) mem -- ConcHask: SAFE, won't block
450 result <- primReadInt64Array mem 0
451 return (primInt64ToInteger result)
453 constructErrorAndFail "hFileSize"
456 -- HACK! We build a unique MP_INT of the right shape to hold
457 -- a single unsigned word, and we let the C routine
458 -- change the data bits
460 case int2Integer# 1# of
462 rc <- fileSize (haFO__ handle_) d -- ConcHask: SAFE, won't block
463 if rc == (0::Int) then
466 constructErrorAndFail "hFileSize"
470 %*********************************************************
472 \subsection[EOF]{Detecting the End of Input}
474 %*********************************************************
477 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
478 @True@ if no further input can be taken from @hdl@ or for a
479 physical file, if the current I/O position is equal to the length of
480 the file. Otherwise, it returns @False@.
483 hIsEOF :: Handle -> IO Bool
485 rc <- mayBlockRead "hIsEOF" handle fileEOF
489 _ -> constructErrorAndFail "hIsEOF"
495 %*********************************************************
497 \subsection[Buffering]{Buffering Operations}
499 %*********************************************************
501 Three kinds of buffering are supported: line-buffering,
502 block-buffering or no-buffering. See @IOBase@ for definition
503 and further explanation of what the type represent.
505 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
506 handle {\em hdl} on subsequent reads and writes.
510 If {\em mode} is @LineBuffering@, line-buffering should be
513 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
514 should be enabled if possible. The size of the buffer is {\em n} items
515 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
517 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
520 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
521 to @NoBuffering@, then any items in the output buffer are written to
522 the device, and any items in the input buffer are discarded. The
523 default buffering mode when a handle is opened is
524 implementation-dependent and may depend on the object which is
525 attached to that handle.
528 hSetBuffering :: Handle -> BufferMode -> IO ()
530 hSetBuffering handle mode =
532 BlockBuffering (Just n)
533 | n <= 0 -> ioException
534 (IOError (Just handle)
537 ("illegal buffer size " ++ showsPrec 9 n []))
538 -- 9 => should be parens'ified.
540 withHandle__ handle $ \ handle_ -> do
541 case haType__ handle_ of
542 ErrorHandle theError -> ioException theError
543 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
546 - we flush the old buffer regardless of whether
547 the new buffer could fit the contents of the old buffer
549 - allow a handle's buffering to change even if IO has
550 occurred (ANSI C spec. does not allow this, nor did
551 the previous implementation of IO.hSetBuffering).
552 - a non-standard extension is to allow the buffering
553 of semi-closed handles to change [sof 6/98]
555 let fo = haFO__ handle_
556 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
559 return (handle_{ haBufferMode__ = mode })
561 -- Note: failure to change the buffer size will cause old buffer to be flushed.
562 constructErrorAndFail "hSetBuffering"
568 BlockBuffering Nothing -> -2
569 BlockBuffering (Just n) -> n
572 The action @hFlush hdl@ causes any items buffered for output
573 in handle {\em hdl} to be sent immediately to the operating
577 hFlush :: Handle -> IO ()
579 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
580 let fo = haFO__ handle_
581 rc <- mayBlock fo (flushFile fo) -- ConcHask: UNSAFE, may block
585 constructErrorAndFail "hFlush"
590 %*********************************************************
592 \subsection[Seeking]{Repositioning Handles}
594 %*********************************************************
599 Handle -- Q: should this be a weak or strong ref. to the handle?
600 -- [what's the winning argument for it not being strong? --sof]
603 instance Eq HandlePosn where
604 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
606 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
607 -- We represent it as an Integer on the Haskell side, but
608 -- cheat slightly in that hGetPosn calls upon a C helper
609 -- that reports the position back via (merely) an Int.
610 type HandlePosition = Integer
612 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
613 mkHandlePosn h p = HandlePosn h p
615 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
616 deriving (Eq, Ord, Ix, Enum, Read, Show)
619 Computation @hGetPosn hdl@ returns the current I/O
620 position of {\em hdl} as an abstract position. Computation
621 $hSetPosn p$ sets the position of {\em hdl}
622 to a previously obtained position {\em p}.
625 hGetPosn :: Handle -> IO HandlePosn
627 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
628 posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block
629 if posn /= -1 then do
630 return (mkHandlePosn handle (fromInt posn))
632 constructErrorAndFail "hGetPosn"
634 hSetPosn :: HandlePosn -> IO ()
635 hSetPosn (HandlePosn handle i@(S# _)) = hSetPosn (HandlePosn handle (toBig i))
636 hSetPosn (HandlePosn handle (J# s# d#)) =
637 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
638 -- not as silly as it looks: the handle may have been closed in the meantime.
639 let fo = haFO__ handle_
640 rc <- mayBlock fo (setFilePosn fo (I# s#) d#) -- ConcHask: UNSAFE, may block
644 constructErrorAndFail "hSetPosn"
647 The action @hSeek hdl mode i@ sets the position of handle
648 @hdl@ depending on @mode@. If @mode@ is
650 * AbsoluteSeek - The position of @hdl@ is set to @i@.
651 * RelativeSeek - The position of @hdl@ is set to offset @i@ from
652 the current position.
653 * SeekFromEnd - The position of @hdl@ is set to offset @i@ from
656 Some handles may not be seekable (see @hIsSeekable@), or only
657 support a subset of the possible positioning operations (e.g. it may
658 only be possible to seek to the end of a tape, or to a positive
659 offset from the beginning or current position).
661 It is not possible to set a negative I/O position, or for a physical
662 file, an I/O position beyond the current end-of-file.
665 - when seeking using @SeekFromEnd@, positive offsets (>=0) means
666 seeking at or past EOF.
667 - relative seeking on buffered handles can lead to non-obvious results.
670 hSeek :: Handle -> SeekMode -> Integer -> IO ()
672 hSeek handle mode offset =
673 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
674 let fo = haFO__ handle_
675 rc <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
677 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
678 hSeek handle mode (J# s# d#) =
679 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
680 let fo = haFO__ handle_
681 rc <- mayBlock fo (seekFile fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
686 constructErrorAndFail "hSeek"
689 whence = case mode of
695 %*********************************************************
697 \subsection[Query]{Handle Properties}
699 %*********************************************************
701 A number of operations return information about the properties of a
702 handle. Each of these operations returns $True$ if the
703 handle has the specified property, and $False$
706 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
707 {\em hdl} is not block-buffered. Otherwise it returns
708 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
709 $( Just n )$ for block-buffering of {\em n} bytes.
712 hIsOpen :: Handle -> IO Bool
714 withHandle_ handle $ \ handle_ -> do
715 case haType__ handle_ of
716 ErrorHandle theError -> ioException theError
717 ClosedHandle -> return False
718 SemiClosedHandle -> return False
721 hIsClosed :: Handle -> IO Bool
723 withHandle_ handle $ \ handle_ -> do
724 case haType__ handle_ of
725 ErrorHandle theError -> ioException theError
726 ClosedHandle -> return True
729 {- not defined, nor exported, but mentioned
730 here for documentation purposes:
732 hSemiClosed :: Handle -> IO Bool
736 return (not (ho || hc))
739 hIsReadable :: Handle -> IO Bool
741 withHandle_ handle $ \ handle_ -> do
742 case haType__ handle_ of
743 ErrorHandle theError -> ioException theError
744 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
745 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
746 htype -> return (isReadable htype)
748 isReadable ReadHandle = True
749 isReadable ReadWriteHandle = True
752 hIsWritable :: Handle -> IO Bool
754 withHandle_ handle $ \ handle_ -> do
755 case haType__ handle_ of
756 ErrorHandle theError -> ioException theError
757 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
758 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
759 htype -> return (isWritable htype)
761 isWritable AppendHandle = True
762 isWritable WriteHandle = True
763 isWritable ReadWriteHandle = True
767 getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
769 rc <- getBufferMode fo -- ConcHask: SAFE, won't block
771 0 -> return (NoBuffering, 0)
772 -1 -> return (LineBuffering, default_buffer_size)
773 -2 -> return (BlockBuffering Nothing, default_buffer_size)
774 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
775 n -> return (BlockBuffering (Just n), n)
777 default_buffer_size :: Int
778 default_buffer_size = const_BUFSIZ
781 Querying how a handle buffers its data:
784 hGetBuffering :: Handle -> IO BufferMode
785 hGetBuffering handle =
786 withHandle_ handle $ \ handle_ -> do
787 case haType__ handle_ of
788 ErrorHandle theError -> ioException theError
789 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
792 We're being non-standard here, and allow the buffering
793 of a semi-closed handle to be queried. -- sof 6/98
795 return (haBufferMode__ handle_) -- could be stricter..
799 hIsSeekable :: Handle -> IO Bool
801 withHandle_ handle $ \ handle_ -> do
802 case haType__ handle_ of
803 ErrorHandle theError -> ioException theError
804 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
805 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
806 AppendHandle -> return False
808 rc <- seekFileP (haFO__ handle_) -- ConcHask: SAFE, won't block
812 _ -> constructErrorAndFail "hIsSeekable"
816 %*********************************************************
818 \subsection{Changing echo status}
820 %*********************************************************
822 Non-standard GHC extension is to allow the echoing status
823 of a handles connected to terminals to be reconfigured:
826 hSetEcho :: Handle -> Bool -> IO ()
827 hSetEcho handle on = do
828 isT <- hIsTerminalDevice handle
832 withHandle_ handle $ \ handle_ -> do
833 case haType__ handle_ of
834 ErrorHandle theError -> ioException theError
835 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
837 rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
840 else constructErrorAndFail "hSetEcho"
842 hGetEcho :: Handle -> IO Bool
844 isT <- hIsTerminalDevice handle
848 withHandle_ handle $ \ handle_ -> do
849 case haType__ handle_ of
850 ErrorHandle theError -> ioException theError
851 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
853 rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
857 _ -> constructErrorAndFail "hSetEcho"
859 hIsTerminalDevice :: Handle -> IO Bool
860 hIsTerminalDevice handle = do
861 withHandle_ handle $ \ handle_ -> do
862 case haType__ handle_ of
863 ErrorHandle theError -> ioException theError
864 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
866 rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
870 _ -> constructErrorAndFail "hIsTerminalDevice"
874 hConnectTerms :: Handle -> Handle -> IO ()
875 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
877 hConnectTo :: Handle -> Handle -> IO ()
878 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
880 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
881 hConnectHdl_ hW hR is_tty =
882 wantRWHandle "hConnectTo" hW $ \ hW_ ->
883 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
884 setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
887 As an extension, we also allow characters to be pushed back.
888 Like ANSI C stdio, we guarantee no more than one character of
889 pushback. (For unbuffered channels, the (default) push-back limit is
893 hUngetChar :: Handle -> Char -> IO ()
894 hUngetChar handle c =
895 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
896 rc <- ungetChar (haFO__ handle_) c -- ConcHask: SAFE, won't block
898 then constructErrorAndFail "hUngetChar"
904 Hoisting files in in one go is sometimes useful, so we support
905 this as an extension:
908 -- in one go, read file into an externally allocated buffer.
909 slurpFile :: FilePath -> IO (Addr, Int)
911 handle <- openFile fname ReadMode
912 sz <- hFileSize handle
913 if sz > toInteger (maxBound::Int) then
914 ioError (userError "slurpFile: file too big")
916 let sz_i = fromInteger sz
917 chunk <- allocMemory__ sz_i
921 constructErrorAndFail "slurpFile"
923 rc <- withHandle_ handle ( \ handle_ -> do
924 let fo = haFO__ handle_
925 mayBlock fo (readChunk fo chunk 0 sz_i) -- ConcHask: UNSAFE, may block.
929 then constructErrorAndFail "slurpFile"
930 else return (chunk, rc)
934 Sometimes it's useful to get at the file descriptor that
935 the Handle contains..
938 getHandleFd :: Handle -> IO Int
940 withHandle_ handle $ \ handle_ -> do
941 case (haType__ handle_) of
942 ErrorHandle theError -> ioException theError
943 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
945 fd <- getFileFd (haFO__ handle_)
950 %*********************************************************
952 \subsection{Miscellaneous}
954 %*********************************************************
956 These three functions are meant to get things out of @IOErrors@.
961 ioeGetFileName :: IOError -> Maybe FilePath
962 ioeGetErrorString :: IOError -> String
963 ioeGetHandle :: IOError -> Maybe Handle
965 ioeGetHandle (IOException (IOError h _ _ _)) = h
966 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
968 ioeGetErrorString (IOException (IOError _ iot _ str)) =
972 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
974 ioeGetFileName (IOException (IOError _ _ _ str)) =
975 case span (/=':') str of
978 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
981 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
982 PrelMain.mainIO) and report them - topHandler is the exception
983 handler they should use for this:
986 -- make sure we handle errors while reporting the error!
987 -- (e.g. evaluating the string passed to 'error' might generate
988 -- another error, etc.)
989 topHandler :: Bool -> Exception -> IO ()
990 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
992 real_handler :: Bool -> Exception -> IO ()
993 real_handler bombOut ex =
995 AsyncException StackOverflow -> reportStackOverflow bombOut
996 ErrorCall s -> reportError bombOut s
997 other -> reportError bombOut (showsPrec 0 other "\n")
999 reportStackOverflow :: Bool -> IO ()
1000 reportStackOverflow bombOut = do
1001 (hFlush stdout) `catchException` (\ _ -> return ())
1002 callStackOverflowHook
1008 reportError :: Bool -> String -> IO ()
1009 reportError bombOut str = do
1010 (hFlush stdout) `catchException` (\ _ -> return ())
1011 let bs@(ByteArray _ len _) = packString str
1012 writeErrString addrOf_ErrorHdrHook bs len
1018 foreign import ccall "addrOf_ErrorHdrHook" unsafe
1019 addrOf_ErrorHdrHook :: Addr
1021 foreign import ccall "writeErrString__" unsafe
1022 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1024 -- SUP: Are the hooks allowed to re-enter Haskell land? If yes, remove the unsafe below.
1025 foreign import ccall "stackOverflow" unsafe
1026 callStackOverflowHook :: IO ()
1028 foreign import ccall "stg_exit" unsafe
1029 stg_exit :: Int -> IO ()
1033 A number of operations want to get at a readable or writeable handle, and fail
1037 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1038 wantReadableHandle fun handle act =
1039 withHandle_ handle $ \ handle_ -> do
1040 case haType__ handle_ of
1041 ErrorHandle theError -> ioException theError
1042 ClosedHandle -> ioe_closedHandle fun handle
1043 SemiClosedHandle -> ioe_closedHandle fun handle
1044 AppendHandle -> ioException not_readable_error
1045 WriteHandle -> ioException not_readable_error
1048 not_readable_error =
1049 IOError (Just handle) IllegalOperation fun
1050 ("handle is not open for reading")
1052 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1053 wantWriteableHandle fun handle act =
1054 withHandle_ handle $ \ handle_ ->
1055 checkWriteableHandle fun handle handle_ (act handle_)
1057 wantWriteableHandle_ :: String -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
1058 wantWriteableHandle_ fun handle act =
1059 withHandle handle $ \ handle_ ->
1060 checkWriteableHandle fun handle handle_ (act handle_)
1062 checkWriteableHandle fun handle handle_ act
1063 = case haType__ handle_ of
1064 ErrorHandle theError -> ioError (IOException theError)
1065 ClosedHandle -> ioe_closedHandle fun handle
1066 SemiClosedHandle -> ioe_closedHandle fun handle
1067 ReadHandle -> ioError not_writeable_error
1070 not_writeable_error =
1071 IOException (IOError (Just handle) IllegalOperation fun
1072 ("handle is not open for writing"))
1074 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1075 wantRWHandle fun handle act =
1076 withHandle_ handle $ \ handle_ -> do
1077 case haType__ handle_ of
1078 ErrorHandle theError -> ioException theError
1079 ClosedHandle -> ioe_closedHandle fun handle
1080 SemiClosedHandle -> ioe_closedHandle fun handle
1083 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1084 wantSeekableHandle fun handle act =
1085 withHandle_ handle $ \ handle_ -> do
1086 case haType__ handle_ of
1087 ErrorHandle theError -> ioException theError
1088 ClosedHandle -> ioe_closedHandle fun handle
1089 SemiClosedHandle -> ioe_closedHandle fun handle
1093 Internal function for creating an @IOError@ representing the
1094 access to a closed file.
1097 ioe_closedHandle :: String -> Handle -> IO a
1098 ioe_closedHandle fun h = ioError (IOException (IOError (Just h) IllegalOperation fun
1099 "handle is closed"))
1102 Internal helper functions for Concurrent Haskell implementation
1106 mayBlock :: FILE_OBJECT -> IO Int -> IO Int
1107 mayBlock fo act = do
1110 -5 -> do -- (possibly blocking) read
1113 mayBlock fo act -- input available, re-try
1114 -6 -> do -- (possibly blocking) write
1117 mayBlock fo act -- output possible
1118 -7 -> do -- (possibly blocking) write on connected handle
1119 fd <- getConnFileFd fo
1121 mayBlock fo act -- output possible
1130 mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1131 mayBlockRead fname handle fn = do
1132 r <- wantReadableHandle fname handle $ \ handle_ -> do
1133 let fo = haFO__ handle_
1136 -5 -> do -- (possibly blocking) read
1138 return (BlockRead fd)
1139 -6 -> do -- (possibly blocking) write
1141 return (BlockWrite fd)
1142 -7 -> do -- (possibly blocking) write on connected handle
1143 fd <- getConnFileFd fo
1144 return (BlockWrite fd)
1147 then return (NoBlock rc)
1148 else constructErrorAndFail fname
1152 mayBlockRead fname handle fn
1155 mayBlockRead fname handle fn
1156 NoBlock c -> return c
1158 mayBlockRead' :: String -> Handle
1159 -> (FILE_OBJECT -> IO Int)
1160 -> (FILE_OBJECT -> Int -> IO a)
1162 mayBlockRead' fname handle fn io = do
1163 r <- wantReadableHandle fname handle $ \ handle_ -> do
1164 let fo = haFO__ handle_
1167 -5 -> do -- (possibly blocking) read
1169 return (BlockRead fd)
1170 -6 -> do -- (possibly blocking) write
1172 return (BlockWrite fd)
1173 -7 -> do -- (possibly blocking) write on connected handle
1174 fd <- getConnFileFd fo
1175 return (BlockWrite fd)
1178 then do a <- io fo rc
1180 else constructErrorAndFail fname
1184 mayBlockRead' fname handle fn io
1187 mayBlockRead' fname handle fn io
1188 NoBlock c -> return c
1190 mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1191 mayBlockWrite fname handle fn = do
1192 r <- wantWriteableHandle fname handle $ \ handle_ -> do
1193 let fo = haFO__ handle_
1196 -5 -> do -- (possibly blocking) read
1198 return (BlockRead fd)
1199 -6 -> do -- (possibly blocking) write
1201 return (BlockWrite fd)
1202 -7 -> do -- (possibly blocking) write on connected handle
1203 fd <- getConnFileFd fo
1204 return (BlockWrite fd)
1207 then return (NoBlock rc)
1208 else constructErrorAndFail fname
1212 mayBlockWrite fname handle fn
1215 mayBlockWrite fname handle fn
1216 NoBlock c -> return c
1219 Foreign import declarations of helper functions:
1224 type Bytes = PrimByteArray RealWorld
1226 type Bytes = ByteArray#
1229 foreign import "libHS_cbits" "inputReady" unsafe
1230 inputReady :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1231 foreign import "libHS_cbits" "fileGetc" unsafe
1232 fileGetc :: FILE_OBJECT -> IO Int
1233 foreign import "libHS_cbits" "fileLookAhead" unsafe
1234 fileLookAhead :: FILE_OBJECT -> IO Int
1235 foreign import "libHS_cbits" "readBlock" unsafe
1236 readBlock :: FILE_OBJECT -> IO Int
1237 foreign import "libHS_cbits" "readLine" unsafe
1238 readLine :: FILE_OBJECT -> IO Int
1239 foreign import "libHS_cbits" "readChar" unsafe
1240 readChar :: FILE_OBJECT -> IO Int
1241 foreign import "libHS_cbits" "writeFileObject" unsafe
1242 writeFileObject :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1243 foreign import "libHS_cbits" "filePutc" unsafe
1244 filePutc :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1245 foreign import "libHS_cbits" "write_" unsafe
1246 write_ :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1247 foreign import "libHS_cbits" "getBufStart" unsafe
1248 getBufStart :: FILE_OBJECT -> Int -> IO Addr
1249 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1250 getWriteableBuf :: FILE_OBJECT -> IO Addr
1251 foreign import "libHS_cbits" "getBuf" unsafe
1252 getBuf :: FILE_OBJECT -> IO Addr
1253 foreign import "libHS_cbits" "getBufWPtr" unsafe
1254 getBufWPtr :: FILE_OBJECT -> IO Int
1255 foreign import "libHS_cbits" "setBufWPtr" unsafe
1256 setBufWPtr :: FILE_OBJECT -> Int -> IO ()
1257 foreign import "libHS_cbits" "closeFile" unsafe
1258 closeFile :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1259 foreign import "libHS_cbits" "fileEOF" unsafe
1260 fileEOF :: FILE_OBJECT -> IO Int{-ret code-}
1261 foreign import "libHS_cbits" "setBuffering" unsafe
1262 setBuffering :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1263 foreign import "libHS_cbits" "flushFile" unsafe
1264 flushFile :: FILE_OBJECT -> IO Int{-ret code-}
1265 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1266 flushConnectedBuf :: FILE_OBJECT -> IO ()
1267 foreign import "libHS_cbits" "getBufferMode" unsafe
1268 getBufferMode :: FILE_OBJECT -> IO Int{-ret code-}
1270 foreign import "libHS_cbits" "seekFile_int64" unsafe
1271 seekFile :: FILE_OBJECT -> Int -> Int64 -> IO Int
1273 foreign import "libHS_cbits" "seekFile" unsafe
1274 seekFile :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1277 foreign import "libHS_cbits" "seekFileP" unsafe
1278 seekFileP :: FILE_OBJECT -> IO Int{-ret code-}
1279 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1280 setTerminalEcho :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1281 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1282 getTerminalEcho :: FILE_OBJECT -> IO Int{-ret code-}
1283 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1284 isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1285 foreign import "libHS_cbits" "setConnectedTo" unsafe
1286 setConnectedTo :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1287 foreign import "libHS_cbits" "ungetChar" unsafe
1288 ungetChar :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1289 foreign import "libHS_cbits" "readChunk" unsafe
1290 readChunk :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1291 foreign import "libHS_cbits" "getFileFd" unsafe
1292 getFileFd :: FILE_OBJECT -> IO Int{-fd-}
1294 foreign import "libHS_cbits" "fileSize_int64" unsafe
1295 fileSize_int64 :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1297 foreign import "libHS_cbits" "fileSize" unsafe
1298 fileSize :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1301 foreign import "libHS_cbits" "getFilePosn" unsafe
1302 getFilePosn :: FILE_OBJECT -> IO Int
1303 foreign import "libHS_cbits" "setFilePosn" unsafe
1304 setFilePosn :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1305 foreign import "libHS_cbits" "getConnFileFd" unsafe
1306 getConnFileFd :: FILE_OBJECT -> IO Int{-fd-}
1307 foreign import "libHS_cbits" "getLock" unsafe
1308 getLock :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1309 foreign import "libHS_cbits" "openStdFile" unsafe
1310 openStdFile :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1311 foreign import "libHS_cbits" "openFile" unsafe
1312 primOpenFile :: ByteArray Int{-CString-}
1315 -> IO Addr {-file obj-}
1316 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1319 foreign import "libHS_cbits" "setBinaryMode__" unsafe
1320 setBinaryMode :: FILE_OBJECT -> Int -> IO Int