2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelHandle]{Module @PrelHandle@}
7 This module defines Haskell {\em handles} and the basic operations
8 which are supported for them.
11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
12 #include "cbits/stgerror.h"
14 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
15 module PrelHandle where
19 import PrelAddr ( Addr, nullAddr )
20 import PrelByteArr ( ByteArray(..), MutableByteArray(..) )
21 import PrelRead ( Read )
22 import PrelList ( span )
25 import PrelMaybe ( Maybe(..) )
27 import PrelNum ( toBig, Integer(..), Num(..) )
29 import PrelAddr ( Addr, nullAddr )
30 import PrelReal ( toInteger )
31 import PrelPack ( packString )
32 #ifndef __PARALLEL_HASKELL__
33 import PrelWeak ( addForeignFinalizer )
38 #ifndef __PARALLEL_HASKELL__
39 import PrelForeign ( makeForeignObj, mkForeignObj )
42 #endif /* ndef(__HUGS__) */
45 #define __CONCURRENT_HASKELL__
49 #ifndef __PARALLEL_HASKELL__
50 #define FILE_OBJECT ForeignObj
52 #define FILE_OBJECT Addr
56 %*********************************************************
58 \subsection{Types @Handle@, @Handle__@}
60 %*********************************************************
62 The @Handle@ and @Handle__@ types are defined in @IOBase@.
65 {-# INLINE newHandle #-}
66 newHandle :: Handle__ -> IO Handle
68 -- Use MVars for concurrent Haskell
69 newHandle hc = newMVar hc >>= \ h ->
73 %*********************************************************
75 \subsection{@withHandle@ operations}
77 %*********************************************************
79 In the concurrent world, handles are locked during use. This is done
80 by wrapping an MVar around the handle which acts as a mutex over
81 operations on the handle.
83 To avoid races, we use the following bracketing operations. The idea
84 is to obtain the lock, do some operation and replace the lock again,
85 whether the operation succeeded or failed. We also want to handle the
86 case where the thread receives an exception while processing the IO
87 operation: in these cases we also want to relinquish the lock.
89 There are three versions of @withHandle@: corresponding to the three
90 possible combinations of:
92 - the operation may side-effect the handle
93 - the operation may return a result
95 If the operation generates an error or an exception is raised, the
96 orignal handle is always replaced [ this is the case at the moment,
97 but we might want to revisit this in the future --SDM ].
100 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
101 {-# INLINE withHandle #-}
102 withHandle (Handle h) act =
103 blockAsyncExceptions $ do
105 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
109 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
110 {-# INLINE withHandle_ #-}
111 withHandle_ (Handle h) act =
112 blockAsyncExceptions $ do
114 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
118 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
119 {-# INLINE withHandle__ #-}
120 withHandle__ (Handle h) act =
121 blockAsyncExceptions $ do
123 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
128 nullFile__ is only used for closed handles, plugging it in as a null
129 file object reference.
132 nullFile__ :: FILE_OBJECT
134 #ifndef __PARALLEL_HASKELL__
135 unsafePerformIO (makeForeignObj nullAddr (return ()))
141 mkClosedHandle__ :: Handle__
143 Handle__ { haFO__ = nullFile__,
144 haType__ = ClosedHandle,
145 haBufferMode__ = NoBuffering,
146 haFilePath__ = "closed file",
150 mkErrorHandle__ :: IOError -> Handle__
151 mkErrorHandle__ ioe =
152 Handle__ { haFO__ = nullFile__,
153 haType__ = (ErrorHandle ioe),
154 haBufferMode__ = NoBuffering,
155 haFilePath__ = "error handle",
160 %*********************************************************
162 \subsection{Handle Finalizers}
164 %*********************************************************
167 stdHandleFinalizer :: Handle -> IO ()
168 stdHandleFinalizer (Handle hdl) = do
169 handle <- takeMVar hdl
170 let fo = haFO__ handle
172 freeBuffers (haBuffers__ handle)
174 handleFinalizer :: Handle -> IO ()
175 handleFinalizer (Handle hdl) = do
176 handle <- takeMVar hdl
177 let fo = haFO__ handle
179 freeBuffers (haBuffers__ handle)
181 freeBuffers [] = return ()
182 freeBuffers (b:bs) = do { free b; freeBuffers bs }
184 foreign import "libHS_cbits" "freeStdFileObject" unsafe
185 freeStdFileObject :: FILE_OBJECT -> IO ()
186 foreign import "libHS_cbits" "freeFileObject" unsafe
187 freeFileObject :: FILE_OBJECT -> IO ()
188 foreign import "free" unsafe
189 free :: Addr -> IO ()
192 %*********************************************************
194 \subsection[StdHandles]{Standard handles}
196 %*********************************************************
198 Three handles are allocated during program initialisation. The first
199 two manage input or output from the Haskell program's standard input
200 or output channel respectively. The third manages output to the
201 standard error channel. These handles are initially open.
205 stdin, stdout, stderr :: Handle
207 stdout = unsafePerformIO (do
208 rc <- getLock (1::Int) (1::Int) -- ConcHask: SAFE, won't block
210 0 -> newHandle (mkClosedHandle__)
212 fo <- openStdFile (1::Int)
213 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
215 #ifndef __PARALLEL_HASKELL__
216 fo <- mkForeignObj fo
217 -- I know this is deprecated, but I couldn't bring myself
218 -- to move fixIO into the prelude just so I could use makeForeignObj.
223 /* I dont care what the Haskell report says, in an interactive system,
224 * stdout should be unbuffered by default.
228 (bm, bf_size) <- getBMode__ fo
229 mkBuffer__ fo bf_size
231 hdl <- newHandle (Handle__ fo WriteHandle bm "stdout" [])
233 #ifndef __PARALLEL_HASKELL__
234 addForeignFinalizer fo (stdHandleFinalizer hdl)
238 _ -> do ioError <- constructError "stdout"
239 newHandle (mkErrorHandle__ ioError)
242 stdin = unsafePerformIO (do
243 rc <- getLock (0::Int) (0::Int) -- ConcHask: SAFE, won't block
245 0 -> newHandle (mkClosedHandle__)
247 fo <- openStdFile (0::Int)
248 (1::Int){-readable-} -- ConcHask: SAFE, won't block
250 #ifndef __PARALLEL_HASKELL__
251 fo <- mkForeignObj fo
253 (bm, bf_size) <- getBMode__ fo
254 mkBuffer__ fo bf_size
255 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin" [])
256 -- when stdin and stdout are both connected to a terminal, ensure
257 -- that anything buffered on stdout is flushed prior to reading from
259 #ifndef __PARALLEL_HASKELL__
260 addForeignFinalizer fo (stdHandleFinalizer hdl)
262 hConnectTerms stdout hdl
264 _ -> do ioError <- constructError "stdin"
265 newHandle (mkErrorHandle__ ioError)
269 stderr = unsafePerformIO (do
270 rc <- getLock (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
272 0 -> newHandle (mkClosedHandle__)
274 fo <- openStdFile (2::Int)
275 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
277 #ifndef __PARALLEL_HASKELL__
278 fo <- mkForeignObj fo
280 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr" [])
281 -- when stderr and stdout are both connected to a terminal, ensure
282 -- that anything buffered on stdout is flushed prior to writing to
284 #ifndef __PARALLEL_HASKELL__
285 addForeignFinalizer fo (stdHandleFinalizer hdl)
287 hConnectTo stdout hdl
290 _ -> do ioError <- constructError "stderr"
291 newHandle (mkErrorHandle__ ioError)
295 %*********************************************************
297 \subsection[OpeningClosing]{Opening and Closing Files}
299 %*********************************************************
302 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
303 deriving (Eq, Ord, Ix, Enum, Read, Show)
308 deriving (Eq, Read, Show)
310 openFile :: FilePath -> IOMode -> IO Handle
311 openFile fp im = openFileEx fp (TextMode im)
313 openFileEx :: FilePath -> IOModeEx -> IO Handle
316 fo <- primOpenFile (packString f)
318 (binary::Int) -- ConcHask: SAFE, won't block
319 if fo /= nullAddr then do
320 #ifndef __PARALLEL_HASKELL__
321 fo <- mkForeignObj fo
323 (bm, bf_size) <- getBMode__ fo
324 mkBuffer__ fo bf_size
325 hdl <- newHandle (Handle__ fo htype bm f [])
326 #ifndef __PARALLEL_HASKELL__
327 addForeignFinalizer fo (handleFinalizer hdl)
331 constructErrorAndFailWithInfo "openFile" f
335 BinaryMode bmo -> (bmo, 1)
336 TextMode tmo -> (tmo, 0)
346 ReadMode -> ReadHandle
347 WriteMode -> WriteHandle
348 AppendMode -> AppendHandle
349 ReadWriteMode -> ReadWriteHandle
352 Computation $openFile file mode$ allocates and returns a new, open
353 handle to manage the file {\em file}. It manages input if {\em mode}
354 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
355 and both input and output if mode is $ReadWriteMode$.
357 If the file does not exist and it is opened for output, it should be
358 created as a new file. If {\em mode} is $WriteMode$ and the file
359 already exists, then it should be truncated to zero length. The
360 handle is positioned at the end of the file if {\em mode} is
361 $AppendMode$, and otherwise at the beginning (in which case its
362 internal position is 0).
364 Implementations should enforce, locally to the Haskell process,
365 multiple-reader single-writer locking on files, which is to say that
366 there may either be many handles on the same file which manage input,
367 or just one handle on the file which manages output. If any open or
368 semi-closed handle is managing a file for output, no new handle can be
369 allocated for that file. If any open or semi-closed handle is
370 managing a file for input, new handles can only be allocated if they
371 do not manage output.
373 Two files are the same if they have the same absolute name. An
374 implementation is free to impose stricter conditions.
377 hClose :: Handle -> IO ()
380 withHandle__ handle $ \ handle_ -> do
381 case haType__ handle_ of
382 ErrorHandle theError -> ioError theError
383 ClosedHandle -> return handle_
385 rc <- closeFile (haFO__ handle_)
386 (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
387 {- We explicitly close a file object so that we can be told
388 if there were any errors. Note that after @hClose@
389 has been performed, the ForeignObj embedded in the Handle
390 is still lying around in the heap, so care is taken
391 to avoid closing the file object when the ForeignObj
392 is finalized. (we overwrite the file ptr in the underlying
393 FileObject with a NULL as part of closeFile())
397 then constructErrorAndFail "hClose"
399 -- free the spare buffers (except the handle buffer)
400 -- associated with this handle.
401 else do freeBuffers (haBuffers__ handle_)
402 return (handle_{ haType__ = ClosedHandle,
407 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
408 computation finishes, any items buffered for output and not already
409 sent to the operating system are flushed as for $flush$.
411 %*********************************************************
413 \subsection[FileSize]{Detecting the size of a file}
415 %*********************************************************
418 For a handle {\em hdl} which attached to a physical file, $hFileSize
419 hdl$ returns the size of {\em hdl} in terms of the number of items
420 which can be read from {\em hdl}.
423 hFileSize :: Handle -> IO Integer
425 withHandle_ handle $ \ handle_ -> do
426 case haType__ handle_ of
427 ErrorHandle theError -> ioError theError
428 ClosedHandle -> ioe_closedHandle "hFileSize" handle
429 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
432 mem <- primNewByteArray 8{-sizeof_int64-}
433 rc <- fileSize_int64 (haFO__ handle_) mem -- ConcHask: SAFE, won't block
435 result <- primReadInt64Array mem 0
436 return (primInt64ToInteger result)
438 constructErrorAndFail "hFileSize"
441 -- HACK! We build a unique MP_INT of the right shape to hold
442 -- a single unsigned word, and we let the C routine
443 -- change the data bits
445 case int2Integer# 1# of
447 rc <- fileSize (haFO__ handle_) d -- ConcHask: SAFE, won't block
448 if rc == (0::Int) then
451 constructErrorAndFail "hFileSize"
455 %*********************************************************
457 \subsection[EOF]{Detecting the End of Input}
459 %*********************************************************
462 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
463 @True@ if no further input can be taken from @hdl@ or for a
464 physical file, if the current I/O position is equal to the length of
465 the file. Otherwise, it returns @False@.
468 hIsEOF :: Handle -> IO Bool
470 rc <- mayBlockRead "hIsEOF" handle fileEOF
474 _ -> constructErrorAndFail "hIsEOF"
480 %*********************************************************
482 \subsection[Buffering]{Buffering Operations}
484 %*********************************************************
486 Three kinds of buffering are supported: line-buffering,
487 block-buffering or no-buffering. See @IOBase@ for definition
488 and further explanation of what the type represent.
490 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
491 handle {\em hdl} on subsequent reads and writes.
495 If {\em mode} is @LineBuffering@, line-buffering should be
498 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
499 should be enabled if possible. The size of the buffer is {\em n} items
500 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
502 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
505 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
506 to @NoBuffering@, then any items in the output buffer are written to
507 the device, and any items in the input buffer are discarded. The
508 default buffering mode when a handle is opened is
509 implementation-dependent and may depend on the object which is
510 attached to that handle.
513 hSetBuffering :: Handle -> BufferMode -> IO ()
515 hSetBuffering handle mode =
517 BlockBuffering (Just n)
519 (IOError (Just handle)
522 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
524 withHandle__ handle $ \ handle_ -> do
525 case haType__ handle_ of
526 ErrorHandle theError -> ioError theError
527 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
530 - we flush the old buffer regardless of whether
531 the new buffer could fit the contents of the old buffer
533 - allow a handle's buffering to change even if IO has
534 occurred (ANSI C spec. does not allow this, nor did
535 the previous implementation of IO.hSetBuffering).
536 - a non-standard extension is to allow the buffering
537 of semi-closed handles to change [sof 6/98]
539 let fo = haFO__ handle_
540 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
543 return (handle_{ haBufferMode__ = mode })
545 -- Note: failure to change the buffer size will cause old buffer to be flushed.
546 constructErrorAndFail "hSetBuffering"
552 BlockBuffering Nothing -> -2
553 BlockBuffering (Just n) -> n
556 The action @hFlush hdl@ causes any items buffered for output
557 in handle {\em hdl} to be sent immediately to the operating
561 hFlush :: Handle -> IO ()
563 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
564 let fo = haFO__ handle_
565 rc <- mayBlock fo (flushFile fo) -- ConcHask: UNSAFE, may block
569 constructErrorAndFail "hFlush"
574 %*********************************************************
576 \subsection[Seeking]{Repositioning Handles}
578 %*********************************************************
583 Handle -- Q: should this be a weak or strong ref. to the handle?
584 -- [what's the winning argument for it not being strong? --sof]
587 instance Eq HandlePosn where
588 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
590 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
591 -- We represent it as an Integer on the Haskell side, but
592 -- cheat slightly in that hGetPosn calls upon a C helper
593 -- that reports the position back via (merely) an Int.
594 type HandlePosition = Integer
596 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
597 mkHandlePosn h p = HandlePosn h p
599 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
600 deriving (Eq, Ord, Ix, Enum, Read, Show)
603 Computation @hGetPosn hdl@ returns the current I/O
604 position of {\em hdl} as an abstract position. Computation
605 $hSetPosn p$ sets the position of {\em hdl}
606 to a previously obtained position {\em p}.
609 hGetPosn :: Handle -> IO HandlePosn
611 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
612 posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block
613 if posn /= -1 then do
614 return (mkHandlePosn handle (fromInt posn))
616 constructErrorAndFail "hGetPosn"
618 hSetPosn :: HandlePosn -> IO ()
619 hSetPosn (HandlePosn handle i@(S# _)) = hSetPosn (HandlePosn handle (toBig i))
620 hSetPosn (HandlePosn handle (J# s# d#)) =
621 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
622 -- not as silly as it looks: the handle may have been closed in the meantime.
623 let fo = haFO__ handle_
624 rc <- mayBlock fo (setFilePosn fo (I# s#) d#) -- ConcHask: UNSAFE, may block
628 constructErrorAndFail "hSetPosn"
631 The action @hSeek hdl mode i@ sets the position of handle
632 @hdl@ depending on @mode@. If @mode@ is
634 * AbsoluteSeek - The position of @hdl@ is set to @i@.
635 * RelativeSeek - The position of @hdl@ is set to offset @i@ from
636 the current position.
637 * SeekFromEnd - The position of @hdl@ is set to offset @i@ from
640 Some handles may not be seekable (see @hIsSeekable@), or only
641 support a subset of the possible positioning operations (e.g. it may
642 only be possible to seek to the end of a tape, or to a positive
643 offset from the beginning or current position).
645 It is not possible to set a negative I/O position, or for a physical
646 file, an I/O position beyond the current end-of-file.
649 - when seeking using @SeekFromEnd@, positive offsets (>=0) means
650 seeking at or past EOF.
651 - relative seeking on buffered handles can lead to non-obvious results.
654 hSeek :: Handle -> SeekMode -> Integer -> IO ()
656 hSeek handle mode offset =
657 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
658 let fo = haFO__ handle_
659 rc <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
661 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
662 hSeek handle mode (J# s# d#) =
663 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
664 let fo = haFO__ handle_
665 rc <- mayBlock fo (seekFile fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
670 constructErrorAndFail "hSeek"
673 whence = case mode of
679 %*********************************************************
681 \subsection[Query]{Handle Properties}
683 %*********************************************************
685 A number of operations return information about the properties of a
686 handle. Each of these operations returns $True$ if the
687 handle has the specified property, and $False$
690 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
691 {\em hdl} is not block-buffered. Otherwise it returns
692 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
693 $( Just n )$ for block-buffering of {\em n} bytes.
696 hIsOpen :: Handle -> IO Bool
698 withHandle_ handle $ \ handle_ -> do
699 case haType__ handle_ of
700 ErrorHandle theError -> ioError theError
701 ClosedHandle -> return False
702 SemiClosedHandle -> return False
705 hIsClosed :: Handle -> IO Bool
707 withHandle_ handle $ \ handle_ -> do
708 case haType__ handle_ of
709 ErrorHandle theError -> ioError theError
710 ClosedHandle -> return True
713 {- not defined, nor exported, but mentioned
714 here for documentation purposes:
716 hSemiClosed :: Handle -> IO Bool
720 return (not (ho || hc))
723 hIsReadable :: Handle -> IO Bool
725 withHandle_ handle $ \ handle_ -> do
726 case haType__ handle_ of
727 ErrorHandle theError -> ioError theError
728 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
729 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
730 htype -> return (isReadable htype)
732 isReadable ReadHandle = True
733 isReadable ReadWriteHandle = True
736 hIsWritable :: Handle -> IO Bool
738 withHandle_ handle $ \ handle_ -> do
739 case haType__ handle_ of
740 ErrorHandle theError -> ioError theError
741 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
742 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
743 htype -> return (isWritable htype)
745 isWritable AppendHandle = True
746 isWritable WriteHandle = True
747 isWritable ReadWriteHandle = True
751 getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
753 rc <- getBufferMode fo -- ConcHask: SAFE, won't block
755 0 -> return (NoBuffering, 0)
756 -1 -> return (LineBuffering, default_buffer_size)
757 -2 -> return (BlockBuffering Nothing, default_buffer_size)
758 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
759 n -> return (BlockBuffering (Just n), n)
761 default_buffer_size :: Int
762 default_buffer_size = const_BUFSIZ
765 Querying how a handle buffers its data:
768 hGetBuffering :: Handle -> IO BufferMode
769 hGetBuffering handle =
770 withHandle_ handle $ \ handle_ -> do
771 case haType__ handle_ of
772 ErrorHandle theError -> ioError theError
773 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
776 We're being non-standard here, and allow the buffering
777 of a semi-closed handle to be queried. -- sof 6/98
779 return (haBufferMode__ handle_) -- could be stricter..
783 hIsSeekable :: Handle -> IO Bool
785 withHandle_ handle $ \ handle_ -> do
786 case haType__ handle_ of
787 ErrorHandle theError -> ioError theError
788 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
789 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
790 AppendHandle -> return False
792 rc <- seekFileP (haFO__ handle_) -- ConcHask: SAFE, won't block
796 _ -> constructErrorAndFail "hIsSeekable"
800 %*********************************************************
802 \subsection{Changing echo status}
804 %*********************************************************
806 Non-standard GHC extension is to allow the echoing status
807 of a handles connected to terminals to be reconfigured:
810 hSetEcho :: Handle -> Bool -> IO ()
811 hSetEcho handle on = do
812 isT <- hIsTerminalDevice handle
816 withHandle_ handle $ \ handle_ -> do
817 case haType__ handle_ of
818 ErrorHandle theError -> ioError theError
819 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
821 rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
824 else constructErrorAndFail "hSetEcho"
826 hGetEcho :: Handle -> IO Bool
828 isT <- hIsTerminalDevice handle
832 withHandle_ handle $ \ handle_ -> do
833 case haType__ handle_ of
834 ErrorHandle theError -> ioError theError
835 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
837 rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
841 _ -> constructErrorAndFail "hSetEcho"
843 hIsTerminalDevice :: Handle -> IO Bool
844 hIsTerminalDevice handle = do
845 withHandle_ handle $ \ handle_ -> do
846 case haType__ handle_ of
847 ErrorHandle theError -> ioError theError
848 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
850 rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
854 _ -> constructErrorAndFail "hIsTerminalDevice"
858 hConnectTerms :: Handle -> Handle -> IO ()
859 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
861 hConnectTo :: Handle -> Handle -> IO ()
862 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
864 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
865 hConnectHdl_ hW hR is_tty =
866 wantRWHandle "hConnectTo" hW $ \ hW_ ->
867 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
868 setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
871 As an extension, we also allow characters to be pushed back.
872 Like ANSI C stdio, we guarantee no more than one character of
873 pushback. (For unbuffered channels, the (default) push-back limit is
877 hUngetChar :: Handle -> Char -> IO ()
878 hUngetChar handle c =
879 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
880 rc <- ungetChar (haFO__ handle_) c -- ConcHask: SAFE, won't block
882 then constructErrorAndFail "hUngetChar"
888 Hoisting files in in one go is sometimes useful, so we support
889 this as an extension:
892 -- in one go, read file into an externally allocated buffer.
893 slurpFile :: FilePath -> IO (Addr, Int)
895 handle <- openFile fname ReadMode
896 sz <- hFileSize handle
897 if sz > toInteger (maxBound::Int) then
898 ioError (userError "slurpFile: file too big")
900 let sz_i = fromInteger sz
901 chunk <- allocMemory__ sz_i
905 constructErrorAndFail "slurpFile"
907 rc <- withHandle_ handle ( \ handle_ -> do
908 let fo = haFO__ handle_
909 mayBlock fo (readChunk fo chunk 0 sz_i) -- ConcHask: UNSAFE, may block.
913 then constructErrorAndFail "slurpFile"
914 else return (chunk, rc)
918 Sometimes it's useful to get at the file descriptor that
919 the Handle contains..
922 getHandleFd :: Handle -> IO Int
924 withHandle_ handle $ \ handle_ -> do
925 case (haType__ handle_) of
926 ErrorHandle theError -> ioError theError
927 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
929 fd <- getFileFd (haFO__ handle_)
934 %*********************************************************
936 \subsection{Miscellaneous}
938 %*********************************************************
940 These three functions are meant to get things out of @IOErrors@.
945 ioeGetFileName :: IOError -> Maybe FilePath
946 ioeGetErrorString :: IOError -> String
947 ioeGetHandle :: IOError -> Maybe Handle
949 ioeGetHandle (IOError h _ _ _) = h
950 ioeGetErrorString (IOError _ iot _ str) =
955 ioeGetFileName (IOError _ _ _ str) =
956 case span (/=':') str of
962 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
963 PrelMain.mainIO) and report them - topHandler is the exception
964 handler they should use for this:
967 -- make sure we handle errors while reporting the error!
968 -- (e.g. evaluating the string passed to 'error' might generate
969 -- another error, etc.)
970 topHandler :: Bool -> Exception -> IO ()
971 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
973 real_handler :: Bool -> Exception -> IO ()
974 real_handler bombOut ex =
976 AsyncException StackOverflow -> reportStackOverflow bombOut
977 ErrorCall s -> reportError bombOut s
978 other -> reportError bombOut (showsPrec 0 other "\n")
980 reportStackOverflow :: Bool -> IO ()
981 reportStackOverflow bombOut = do
982 (hFlush stdout) `catchException` (\ _ -> return ())
983 callStackOverflowHook
989 reportError :: Bool -> String -> IO ()
990 reportError bombOut str = do
991 (hFlush stdout) `catchException` (\ _ -> return ())
992 let bs@(ByteArray _ len _) = packString str
993 writeErrString addrOf_ErrorHdrHook bs len
999 foreign import ccall "addrOf_ErrorHdrHook" unsafe
1000 addrOf_ErrorHdrHook :: Addr
1002 foreign import ccall "writeErrString__" unsafe
1003 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1005 -- SUP: Are the hooks allowed to re-enter Haskell land? If yes, remove the unsafe below.
1006 foreign import ccall "stackOverflow" unsafe
1007 callStackOverflowHook :: IO ()
1009 foreign import ccall "stg_exit" unsafe
1010 stg_exit :: Int -> IO ()
1014 A number of operations want to get at a readable or writeable handle, and fail
1018 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1019 wantReadableHandle fun handle act =
1020 withHandle_ handle $ \ handle_ -> do
1021 case haType__ handle_ of
1022 ErrorHandle theError -> ioError theError
1023 ClosedHandle -> ioe_closedHandle fun handle
1024 SemiClosedHandle -> ioe_closedHandle fun handle
1025 AppendHandle -> ioError not_readable_error
1026 WriteHandle -> ioError not_readable_error
1029 not_readable_error =
1030 IOError (Just handle) IllegalOperation fun
1031 ("handle is not open for reading")
1033 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1034 wantWriteableHandle fun handle act =
1035 withHandle_ handle $ \ handle_ ->
1036 checkWriteableHandle fun handle handle_ (act handle_)
1038 wantWriteableHandle_ :: String -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
1039 wantWriteableHandle_ fun handle act =
1040 withHandle handle $ \ handle_ ->
1041 checkWriteableHandle fun handle handle_ (act handle_)
1043 checkWriteableHandle fun handle handle_ act
1044 = case haType__ handle_ of
1045 ErrorHandle theError -> ioError theError
1046 ClosedHandle -> ioe_closedHandle fun handle
1047 SemiClosedHandle -> ioe_closedHandle fun handle
1048 ReadHandle -> ioError not_writeable_error
1051 not_writeable_error =
1052 IOError (Just handle) IllegalOperation fun
1053 ("handle is not open for writing")
1055 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1056 wantRWHandle fun handle act =
1057 withHandle_ handle $ \ handle_ -> do
1058 case haType__ handle_ of
1059 ErrorHandle theError -> ioError theError
1060 ClosedHandle -> ioe_closedHandle fun handle
1061 SemiClosedHandle -> ioe_closedHandle fun handle
1064 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1065 wantSeekableHandle fun handle act =
1066 withHandle_ handle $ \ handle_ -> do
1067 case haType__ handle_ of
1068 ErrorHandle theError -> ioError theError
1069 ClosedHandle -> ioe_closedHandle fun handle
1070 SemiClosedHandle -> ioe_closedHandle fun handle
1073 not_seekable_error =
1074 IOError (Just handle)
1075 IllegalOperation fun
1076 ("handle is not seekable")
1080 Internal function for creating an @IOError@ representing the
1081 access to a closed file.
1084 ioe_closedHandle :: String -> Handle -> IO a
1085 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1088 Internal helper functions for Concurrent Haskell implementation
1092 mayBlock :: FILE_OBJECT -> IO Int -> IO Int
1093 mayBlock fo act = do
1096 -5 -> do -- (possibly blocking) read
1099 mayBlock fo act -- input available, re-try
1100 -6 -> do -- (possibly blocking) write
1103 mayBlock fo act -- output possible
1104 -7 -> do -- (possibly blocking) write on connected handle
1105 fd <- getConnFileFd fo
1107 mayBlock fo act -- output possible
1116 mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1117 mayBlockRead fname handle fn = do
1118 r <- wantReadableHandle fname handle $ \ handle_ -> do
1119 let fo = haFO__ handle_
1122 -5 -> do -- (possibly blocking) read
1124 return (BlockRead fd)
1125 -6 -> do -- (possibly blocking) write
1127 return (BlockWrite fd)
1128 -7 -> do -- (possibly blocking) write on connected handle
1129 fd <- getConnFileFd fo
1130 return (BlockWrite fd)
1133 then return (NoBlock rc)
1134 else constructErrorAndFail fname
1138 mayBlockRead fname handle fn
1141 mayBlockRead fname handle fn
1142 NoBlock c -> return c
1144 mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1145 mayBlockWrite fname handle fn = do
1146 r <- wantWriteableHandle fname handle $ \ handle_ -> do
1147 let fo = haFO__ handle_
1150 -5 -> do -- (possibly blocking) read
1152 return (BlockRead fd)
1153 -6 -> do -- (possibly blocking) write
1155 return (BlockWrite fd)
1156 -7 -> do -- (possibly blocking) write on connected handle
1157 fd <- getConnFileFd fo
1158 return (BlockWrite fd)
1161 then return (NoBlock rc)
1162 else constructErrorAndFail fname
1166 mayBlockWrite fname handle fn
1169 mayBlockWrite fname handle fn
1170 NoBlock c -> return c
1173 Foreign import declarations of helper functions:
1178 type Bytes = PrimByteArray RealWorld
1180 type Bytes = ByteArray#
1183 foreign import "libHS_cbits" "inputReady" unsafe
1184 inputReady :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1185 foreign import "libHS_cbits" "fileGetc" unsafe
1186 fileGetc :: FILE_OBJECT -> IO Int
1187 foreign import "libHS_cbits" "fileLookAhead" unsafe
1188 fileLookAhead :: FILE_OBJECT -> IO Int
1189 foreign import "libHS_cbits" "readBlock" unsafe
1190 readBlock :: FILE_OBJECT -> IO Int
1191 foreign import "libHS_cbits" "readLine" unsafe
1192 readLine :: FILE_OBJECT -> IO Int
1193 foreign import "libHS_cbits" "readChar" unsafe
1194 readChar :: FILE_OBJECT -> IO Int
1195 foreign import "libHS_cbits" "writeFileObject" unsafe
1196 writeFileObject :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1197 foreign import "libHS_cbits" "filePutc" unsafe
1198 filePutc :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1199 foreign import "libHS_cbits" "write_" unsafe
1200 write_ :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1201 foreign import "libHS_cbits" "getBufStart" unsafe
1202 getBufStart :: FILE_OBJECT -> Int -> IO Addr
1203 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1204 getWriteableBuf :: FILE_OBJECT -> IO Addr
1205 foreign import "libHS_cbits" "getBuf" unsafe
1206 getBuf :: FILE_OBJECT -> IO Addr
1207 foreign import "libHS_cbits" "getBufWPtr" unsafe
1208 getBufWPtr :: FILE_OBJECT -> IO Int
1209 foreign import "libHS_cbits" "setBufWPtr" unsafe
1210 setBufWPtr :: FILE_OBJECT -> Int -> IO ()
1211 foreign import "libHS_cbits" "closeFile" unsafe
1212 closeFile :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1213 foreign import "libHS_cbits" "fileEOF" unsafe
1214 fileEOF :: FILE_OBJECT -> IO Int{-ret code-}
1215 foreign import "libHS_cbits" "setBuffering" unsafe
1216 setBuffering :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1217 foreign import "libHS_cbits" "flushFile" unsafe
1218 flushFile :: FILE_OBJECT -> IO Int{-ret code-}
1219 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1220 flushConnectedBuf :: FILE_OBJECT -> IO ()
1221 foreign import "libHS_cbits" "getBufferMode" unsafe
1222 getBufferMode :: FILE_OBJECT -> IO Int{-ret code-}
1224 foreign import "libHS_cbits" "seekFile_int64" unsafe
1225 seekFile :: FILE_OBJECT -> Int -> Int64 -> IO Int
1227 foreign import "libHS_cbits" "seekFile" unsafe
1228 seekFile :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1231 foreign import "libHS_cbits" "seekFileP" unsafe
1232 seekFileP :: FILE_OBJECT -> IO Int{-ret code-}
1233 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1234 setTerminalEcho :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1235 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1236 getTerminalEcho :: FILE_OBJECT -> IO Int{-ret code-}
1237 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1238 isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1239 foreign import "libHS_cbits" "setConnectedTo" unsafe
1240 setConnectedTo :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1241 foreign import "libHS_cbits" "ungetChar" unsafe
1242 ungetChar :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1243 foreign import "libHS_cbits" "readChunk" unsafe
1244 readChunk :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1245 foreign import "libHS_cbits" "getFileFd" unsafe
1246 getFileFd :: FILE_OBJECT -> IO Int{-fd-}
1248 foreign import "libHS_cbits" "fileSize_int64" unsafe
1249 fileSize_int64 :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1251 foreign import "libHS_cbits" "fileSize" unsafe
1252 fileSize :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1255 foreign import "libHS_cbits" "getFilePosn" unsafe
1256 getFilePosn :: FILE_OBJECT -> IO Int
1257 foreign import "libHS_cbits" "setFilePosn" unsafe
1258 setFilePosn :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1259 foreign import "libHS_cbits" "getConnFileFd" unsafe
1260 getConnFileFd :: FILE_OBJECT -> IO Int{-fd-}
1261 foreign import "libHS_cbits" "getLock" unsafe
1262 getLock :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1263 foreign import "libHS_cbits" "openStdFile" unsafe
1264 openStdFile :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1265 foreign import "libHS_cbits" "openFile" unsafe
1266 primOpenFile :: ByteArray Int{-CString-}
1269 -> IO Addr {-file obj-}
1270 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1273 foreign import "libHS_cbits" "setBinaryMode__" unsafe
1274 setBinaryMode :: FILE_OBJECT -> Int -> IO Int