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/error.h"
14 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
15 module PrelHandle where
18 import PrelAddr ( Addr, nullAddr )
19 import PrelArr ( newVar, readVar, writeVar, ByteArray(..) )
20 import PrelRead ( Read )
21 import PrelList ( span )
24 import PrelMaybe ( Maybe(..) )
28 import PrelAddr ( Addr, nullAddr )
29 import PrelNum ( toInteger, toBig )
30 import PrelPack ( packString )
31 import PrelWeak ( addForeignFinalizer )
34 #ifdef __CONCURRENT_HASKELL__
38 #ifndef __PARALLEL_HASKELL__
39 import PrelForeign ( makeForeignObj )
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 {-# INLINE withHandle #-}
67 newHandle :: Handle__ -> IO Handle
69 #if defined(__CONCURRENT_HASKELL__)
71 -- Use MVars for concurrent Haskell
72 newHandle hc = newMVar hc >>= \ h ->
76 -- Use ordinary MutableVars for non-concurrent Haskell
77 newHandle hc = stToIO (newVar hc >>= \ h ->
82 %*********************************************************
84 \subsection{@withHandle@ operations}
86 %*********************************************************
88 In the concurrent world, handles are locked during use. This is done
89 by wrapping an MVar around the handle which acts as a mutex over
90 operations on the handle.
92 To avoid races, we use the following bracketing operations. The idea
93 is to obtain the lock, do some operation and replace the lock again,
94 whether the operation succeeded or failed. We also want to handle the
95 case where the thread receives an exception while processing the IO
96 operation: in these cases we also want to relinquish the lock.
98 There are three versions of @withHandle@: corresponding to the three
99 possible combinations of:
101 - the operation may side-effect the handle
102 - the operation may return a result
104 If the operation generates an error or an exception is raised, the
105 orignal handle is always replaced [ this is the case at the moment,
106 but we might want to revisit this in the future --SDM ].
109 #ifdef __CONCURRENT_HASKELL__
110 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
111 withHandle (Handle h) act = do
113 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
117 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
118 withHandle_ (Handle h) act = do
120 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
124 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
125 withHandle__ (Handle h) act = do
127 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
132 -- of questionable value to install this exception
133 -- handler, but let's do it in the non-concurrent
134 -- case too, for now.
135 withHandle (Handle h) act = do
136 h_ <- stToIO (readVar h)
137 v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
143 nullFile__ is only used for closed handles, plugging it in as a null
144 file object reference.
147 nullFile__ :: FILE_OBJECT
149 #ifndef __PARALLEL_HASKELL__
150 unsafePerformIO (makeForeignObj nullAddr)
156 mkClosedHandle__ :: Handle__
164 mkErrorHandle__ :: IOError -> Handle__
165 mkErrorHandle__ ioe =
173 %*********************************************************
175 \subsection{Handle Finalizers}
177 %*********************************************************
180 foreign import "libHS_cbits" "freeStdFileObject" unsafe
181 freeStdFileObject :: FILE_OBJECT -> IO ()
182 foreign import "libHS_cbits" "freeFileObject" unsafe
183 freeFileObject :: FILE_OBJECT -> IO ()
187 %*********************************************************
189 \subsection[StdHandles]{Standard handles}
191 %*********************************************************
193 Three handles are allocated during program initialisation. The first
194 two manage input or output from the Haskell program's standard input
195 or output channel respectively. The third manages output to the
196 standard error channel. These handles are initially open.
200 stdin, stdout, stderr :: Handle
202 stdout = unsafePerformIO (do
203 rc <- getLock (1::Int) (1::Int) -- ConcHask: SAFE, won't block
205 0 -> newHandle (mkClosedHandle__)
207 fo <- openStdFile (1::Int)
208 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
210 #ifndef __PARALLEL_HASKELL__
211 fo <- makeForeignObj fo
212 addForeignFinalizer fo (freeStdFileObject fo)
216 /* I dont care what the Haskell report says, in an interactive system,
217 * stdout should be unbuffered by default.
221 (bm, bf_size) <- getBMode__ fo
222 mkBuffer__ fo bf_size
224 newHandle (Handle__ fo WriteHandle bm "stdout")
225 _ -> do ioError <- constructError "stdout"
226 newHandle (mkErrorHandle__ ioError)
229 stdin = unsafePerformIO (do
230 rc <- getLock (0::Int) (0::Int) -- ConcHask: SAFE, won't block
232 0 -> newHandle (mkClosedHandle__)
234 fo <- openStdFile (0::Int)
235 (1::Int){-readable-} -- ConcHask: SAFE, won't block
237 #ifndef __PARALLEL_HASKELL__
238 fo <- makeForeignObj fo
239 addForeignFinalizer fo (freeStdFileObject fo)
241 (bm, bf_size) <- getBMode__ fo
242 mkBuffer__ fo bf_size
243 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
244 -- when stdin and stdout are both connected to a terminal, ensure
245 -- that anything buffered on stdout is flushed prior to reading from stdin.
247 hConnectTerms stdout hdl
249 _ -> do ioError <- constructError "stdin"
250 newHandle (mkErrorHandle__ ioError)
254 stderr = unsafePerformIO (do
255 rc <- getLock (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
257 0 -> newHandle (mkClosedHandle__)
259 fo <- openStdFile (2::Int)
260 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
262 #ifndef __PARALLEL_HASKELL__
263 fo <- makeForeignObj fo
264 addForeignFinalizer fo (freeStdFileObject fo)
266 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
267 -- when stderr and stdout are both connected to a terminal, ensure
268 -- that anything buffered on stdout is flushed prior to writing to
270 hConnectTo stdout hdl
273 _ -> do ioError <- constructError "stderr"
274 newHandle (mkErrorHandle__ ioError)
278 %*********************************************************
280 \subsection[OpeningClosing]{Opening and Closing Files}
282 %*********************************************************
285 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
286 deriving (Eq, Ord, Ix, Enum, Read, Show)
291 deriving (Eq, Read, Show)
293 openFile :: FilePath -> IOMode -> IO Handle
294 openFile fp im = openFileEx fp (TextMode im)
296 openFileEx :: FilePath -> IOModeEx -> IO Handle
299 fo <- primOpenFile (packString f)
301 (binary::Int) -- ConcHask: SAFE, won't block
302 if fo /= nullAddr then do
303 #ifndef __PARALLEL_HASKELL__
304 fo <- makeForeignObj fo
305 addForeignFinalizer fo (freeFileObject fo)
307 (bm, bf_size) <- getBMode__ fo
308 mkBuffer__ fo bf_size
309 newHandle (Handle__ fo htype bm f)
311 constructErrorAndFailWithInfo "openFile" f
315 BinaryMode bmo -> (bmo, 1)
316 TextMode tmo -> (tmo, 0)
326 ReadMode -> ReadHandle
327 WriteMode -> WriteHandle
328 AppendMode -> AppendHandle
329 ReadWriteMode -> ReadWriteHandle
332 Computation $openFile file mode$ allocates and returns a new, open
333 handle to manage the file {\em file}. It manages input if {\em mode}
334 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
335 and both input and output if mode is $ReadWriteMode$.
337 If the file does not exist and it is opened for output, it should be
338 created as a new file. If {\em mode} is $WriteMode$ and the file
339 already exists, then it should be truncated to zero length. The
340 handle is positioned at the end of the file if {\em mode} is
341 $AppendMode$, and otherwise at the beginning (in which case its
342 internal position is 0).
344 Implementations should enforce, locally to the Haskell process,
345 multiple-reader single-writer locking on files, which is to say that
346 there may either be many handles on the same file which manage input,
347 or just one handle on the file which manages output. If any open or
348 semi-closed handle is managing a file for output, no new handle can be
349 allocated for that file. If any open or semi-closed handle is
350 managing a file for input, new handles can only be allocated if they
351 do not manage output.
353 Two files are the same if they have the same absolute name. An
354 implementation is free to impose stricter conditions.
357 hClose :: Handle -> IO ()
360 withHandle__ handle $ \ handle_ -> do
361 case haType__ handle_ of
362 ErrorHandle theError -> ioError theError
363 ClosedHandle -> return handle_
365 rc <- closeFile (haFO__ handle_)
366 (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
367 {- We explicitly close a file object so that we can be told
368 if there were any errors. Note that after @hClose@
369 has been performed, the ForeignObj embedded in the Handle
370 is still lying around in the heap, so care is taken
371 to avoid closing the file object when the ForeignObj
372 is finalized. (we overwrite the file ptr in the underlying
373 FileObject with a NULL as part of closeFile())
376 then return (handle_{ haType__ = ClosedHandle,
377 haFO__ = nullFile__ })
378 else constructErrorAndFail "hClose"
382 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
383 computation finishes, any items buffered for output and not already
384 sent to the operating system are flushed as for $flush$.
386 %*********************************************************
388 \subsection[EOF]{Detecting the End of Input}
390 %*********************************************************
393 For a handle {\em hdl} which attached to a physical file, $hFileSize
394 hdl$ returns the size of {\em hdl} in terms of the number of items
395 which can be read from {\em hdl}.
398 hFileSize :: Handle -> IO Integer
400 withHandle_ handle $ \ handle_ -> do
401 case haType__ handle_ of
402 ErrorHandle theError -> ioError theError
403 ClosedHandle -> ioe_closedHandle "hFileSize" handle
404 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
407 mem <- primNewByteArray 8{-sizeof_int64-}
408 rc <- fileSize_int64 (haFO__ handle_) mem -- ConcHask: SAFE, won't block
410 result <- primReadInt64Array mem 0
411 return (primInt64ToInteger result)
413 constructErrorAndFail "hFileSize"
416 -- HACK! We build a unique MP_INT of the right shape to hold
417 -- a single unsigned word, and we let the C routine
418 -- change the data bits
420 case int2Integer# 1# of
422 rc <- fileSize (haFO__ handle_) d -- ConcHask: SAFE, won't block
423 if rc == (0::Int) then
426 constructErrorAndFail "hFileSize"
430 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
431 @True@ if no further input can be taken from @hdl@ or for a
432 physical file, if the current I/O position is equal to the length of
433 the file. Otherwise, it returns @False@.
436 hIsEOF :: Handle -> IO Bool
438 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
439 let fo = haFO__ handle_
440 rc <- mayBlock fo (fileEOF fo) -- ConcHask: UNSAFE, may block
444 _ -> constructErrorAndFail "hIsEOF"
450 %*********************************************************
452 \subsection[Buffering]{Buffering Operations}
454 %*********************************************************
456 Three kinds of buffering are supported: line-buffering,
457 block-buffering or no-buffering. See @IOBase@ for definition
458 and further explanation of what the type represent.
460 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
461 handle {\em hdl} on subsequent reads and writes.
465 If {\em mode} is @LineBuffering@, line-buffering should be
468 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
469 should be enabled if possible. The size of the buffer is {\em n} items
470 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
472 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
475 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
476 to @NoBuffering@, then any items in the output buffer are written to
477 the device, and any items in the input buffer are discarded. The
478 default buffering mode when a handle is opened is
479 implementation-dependent and may depend on the object which is
480 attached to that handle.
483 hSetBuffering :: Handle -> BufferMode -> IO ()
485 hSetBuffering handle mode =
487 BlockBuffering (Just n)
489 (IOError (Just handle)
492 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
494 withHandle__ handle $ \ handle_ -> do
495 case haType__ handle_ of
496 ErrorHandle theError -> ioError theError
497 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
500 - we flush the old buffer regardless of whether
501 the new buffer could fit the contents of the old buffer
503 - allow a handle's buffering to change even if IO has
504 occurred (ANSI C spec. does not allow this, nor did
505 the previous implementation of IO.hSetBuffering).
506 - a non-standard extension is to allow the buffering
507 of semi-closed handles to change [sof 6/98]
509 let fo = haFO__ handle_
510 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
513 return (handle_{ haBufferMode__ = mode })
515 -- Note: failure to change the buffer size will cause old buffer to be flushed.
516 constructErrorAndFail "hSetBuffering"
522 BlockBuffering Nothing -> -2
523 BlockBuffering (Just n) -> n
526 The action @hFlush hdl@ causes any items buffered for output
527 in handle {\em hdl} to be sent immediately to the operating
531 hFlush :: Handle -> IO ()
533 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
534 let fo = haFO__ handle_
535 rc <- mayBlock fo (flushFile fo) -- ConcHask: UNSAFE, may block
539 constructErrorAndFail "hFlush"
544 %*********************************************************
546 \subsection[Seeking]{Repositioning Handles}
548 %*********************************************************
553 Handle -- Q: should this be a weak or strong ref. to the handle?
554 -- [what's the winning argument for it not being strong? --sof]
557 instance Eq HandlePosn where
558 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
560 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
561 -- We represent it as an Integer on the Haskell side, but
562 -- cheat slightly in that hGetPosn calls upon a C helper
563 -- that reports the position back via (merely) an Int.
564 type HandlePosition = Integer
566 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
567 mkHandlePosn h p = HandlePosn h p
569 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
570 deriving (Eq, Ord, Ix, Enum, Read, Show)
573 Computation @hGetPosn hdl@ returns the current I/O
574 position of {\em hdl} as an abstract position. Computation
575 $hSetPosn p$ sets the position of {\em hdl}
576 to a previously obtained position {\em p}.
579 hGetPosn :: Handle -> IO HandlePosn
581 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
582 posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block
583 if posn /= -1 then do
584 return (mkHandlePosn handle (fromInt posn))
586 constructErrorAndFail "hGetPosn"
588 hSetPosn :: HandlePosn -> IO ()
589 hSetPosn (HandlePosn handle i@(S# _)) = hSetPosn (HandlePosn handle (toBig i))
590 hSetPosn (HandlePosn handle (J# s# d#)) =
591 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
592 -- not as silly as it looks: the handle may have been closed in the meantime.
593 let fo = haFO__ handle_
594 rc <- mayBlock fo (setFilePosn fo (I# s#) d#) -- ConcHask: UNSAFE, may block
598 constructErrorAndFail "hSetPosn"
601 The action @hSeek hdl mode i@ sets the position of handle
602 @hdl@ depending on @mode@. If @mode@ is
604 * AbsoluteSeek - The position of @hdl@ is set to @i@.
605 * RelativeSeek - The position of @hdl@ is set to offset @i@ from
606 the current position.
607 * SeekFromEnd - The position of @hdl@ is set to offset @i@ from
610 Some handles may not be seekable (see @hIsSeekable@), or only
611 support a subset of the possible positioning operations (e.g. it may
612 only be possible to seek to the end of a tape, or to a positive
613 offset from the beginning or current position).
615 It is not possible to set a negative I/O position, or for a physical
616 file, an I/O position beyond the current end-of-file.
619 - when seeking using @SeekFromEnd@, positive offsets (>=0) means
620 seeking at or past EOF.
621 - relative seeking on buffered handles can lead to non-obvious results.
624 hSeek :: Handle -> SeekMode -> Integer -> IO ()
626 hSeek handle mode offset =
627 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
628 let fo = haFO__ handle_
629 rc <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
631 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
632 hSeek handle mode (J# s# d#) =
633 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
634 let fo = haFO__ handle_
635 rc <- mayBlock fo (seekFile fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
640 constructErrorAndFail "hSeek"
643 whence = case mode of
649 %*********************************************************
651 \subsection[Query]{Handle Properties}
653 %*********************************************************
655 A number of operations return information about the properties of a
656 handle. Each of these operations returns $True$ if the
657 handle has the specified property, and $False$
660 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
661 {\em hdl} is not block-buffered. Otherwise it returns
662 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
663 $( Just n )$ for block-buffering of {\em n} bytes.
666 hIsOpen :: Handle -> IO Bool
668 withHandle_ handle $ \ handle_ -> do
669 case haType__ handle_ of
670 ErrorHandle theError -> ioError theError
671 ClosedHandle -> return False
672 SemiClosedHandle -> return False
675 hIsClosed :: Handle -> IO Bool
677 withHandle_ handle $ \ handle_ -> do
678 case haType__ handle_ of
679 ErrorHandle theError -> ioError theError
680 ClosedHandle -> return True
683 {- not defined, nor exported, but mentioned
684 here for documentation purposes:
686 hSemiClosed :: Handle -> IO Bool
690 return (not (ho || hc))
693 hIsReadable :: Handle -> IO Bool
695 withHandle_ handle $ \ handle_ -> do
696 case haType__ handle_ of
697 ErrorHandle theError -> ioError theError
698 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
699 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
700 htype -> return (isReadable htype)
702 isReadable ReadHandle = True
703 isReadable ReadWriteHandle = True
706 hIsWritable :: Handle -> IO Bool
708 withHandle_ handle $ \ handle_ -> do
709 case haType__ handle_ of
710 ErrorHandle theError -> ioError theError
711 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
712 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
713 htype -> return (isWritable htype)
715 isWritable AppendHandle = True
716 isWritable WriteHandle = True
717 isWritable ReadWriteHandle = True
721 #ifndef __PARALLEL_HASKELL__
722 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
724 getBMode__ :: Addr -> IO (BufferMode, Int)
727 rc <- getBufferMode fo -- ConcHask: SAFE, won't block
729 0 -> return (NoBuffering, 0)
730 -1 -> return (LineBuffering, default_buffer_size)
731 -2 -> return (BlockBuffering Nothing, default_buffer_size)
732 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
733 n -> return (BlockBuffering (Just n), n)
735 default_buffer_size :: Int
736 default_buffer_size = (const_BUFSIZ - 1)
739 Querying how a handle buffers its data:
742 hGetBuffering :: Handle -> IO BufferMode
743 hGetBuffering handle =
744 withHandle_ handle $ \ handle_ -> do
745 case haType__ handle_ of
746 ErrorHandle theError -> ioError theError
747 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
750 We're being non-standard here, and allow the buffering
751 of a semi-closed handle to be queried. -- sof 6/98
753 return (haBufferMode__ handle_) -- could be stricter..
757 hIsSeekable :: Handle -> IO Bool
759 withHandle_ handle $ \ handle_ -> do
760 case haType__ handle_ of
761 ErrorHandle theError -> ioError theError
762 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
763 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
764 AppendHandle -> return False
766 rc <- seekFileP (haFO__ handle_) -- ConcHask: SAFE, won't block
770 _ -> constructErrorAndFail "hIsSeekable"
774 %*********************************************************
776 \subsection{Changing echo status}
778 %*********************************************************
780 Non-standard GHC extension is to allow the echoing status
781 of a handles connected to terminals to be reconfigured:
784 hSetEcho :: Handle -> Bool -> IO ()
785 hSetEcho handle on = do
786 isT <- hIsTerminalDevice handle
790 withHandle_ handle $ \ handle_ -> do
791 case haType__ handle_ of
792 ErrorHandle theError -> ioError theError
793 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
795 rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
798 else constructErrorAndFail "hSetEcho"
800 hGetEcho :: Handle -> IO Bool
802 isT <- hIsTerminalDevice handle
806 withHandle_ handle $ \ handle_ -> do
807 case haType__ handle_ of
808 ErrorHandle theError -> ioError theError
809 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
811 rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
815 _ -> constructErrorAndFail "hSetEcho"
817 hIsTerminalDevice :: Handle -> IO Bool
818 hIsTerminalDevice handle = do
819 withHandle_ handle $ \ handle_ -> do
820 case haType__ handle_ of
821 ErrorHandle theError -> ioError theError
822 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
824 rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
828 _ -> constructErrorAndFail "hIsTerminalDevice"
832 hConnectTerms :: Handle -> Handle -> IO ()
833 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
835 hConnectTo :: Handle -> Handle -> IO ()
836 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
838 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
839 hConnectHdl_ hW hR is_tty =
840 wantRWHandle "hConnectTo" hW $ \ hW_ ->
841 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
842 setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
844 #ifndef __PARALLEL_HASKELL__
845 #define FILE_OBJECT ForeignObj
847 #define FILE_OBJECT Addr
852 As an extension, we also allow characters to be pushed back.
853 Like ANSI C stdio, we guarantee no more than one character of
854 pushback. (For unbuffered channels, the (default) push-back limit is
858 hUngetChar :: Handle -> Char -> IO ()
859 hUngetChar handle c =
860 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
861 rc <- ungetChar (haFO__ handle_) c -- ConcHask: SAFE, won't block
863 then constructErrorAndFail "hUngetChar"
869 Hoisting files in in one go is sometimes useful, so we support
870 this as an extension:
873 -- in one go, read file into an externally allocated buffer.
874 slurpFile :: FilePath -> IO (Addr, Int)
876 handle <- openFile fname ReadMode
877 sz <- hFileSize handle
878 if sz > toInteger (maxBound::Int) then
879 ioError (userError "slurpFile: file too big")
881 let sz_i = fromInteger sz
882 chunk <- allocMemory__ sz_i
886 constructErrorAndFail "slurpFile"
888 rc <- withHandle_ handle ( \ handle_ -> do
889 let fo = haFO__ handle_
890 mayBlock fo (readChunk fo chunk sz_i) -- ConcHask: UNSAFE, may block.
894 then constructErrorAndFail "slurpFile"
895 else return (chunk, rc)
897 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
898 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
899 hFillBufBA handle buf sz
900 | sz <= 0 = ioError (IOError (Just handle)
903 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
905 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
906 let fo = haFO__ handle_
907 rc <- mayBlock fo (readChunkBA fo buf sz) -- ConcHask: UNSAFE, may block.
910 else constructErrorAndFail "hFillBufBA"
913 hFillBuf :: Handle -> Addr -> Int -> IO Int
914 hFillBuf handle buf sz
915 | sz <= 0 = ioError (IOError (Just handle)
918 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
920 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
921 let fo = haFO__ handle_
922 rc <- mayBlock fo (readChunk fo buf sz) -- ConcHask: UNSAFE, may block.
925 else constructErrorAndFail "hFillBuf"
929 The @hPutBuf hdl buf len@ action writes an already packed sequence of
930 bytes to the file/channel managed by @hdl@ - non-standard.
933 hPutBuf :: Handle -> Addr -> Int -> IO ()
934 hPutBuf handle buf len =
935 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
936 let fo = haFO__ handle_
937 rc <- mayBlock fo (writeBuf fo buf len) -- ConcHask: UNSAFE, may block.
940 else constructErrorAndFail "hPutBuf"
942 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
943 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
944 hPutBufBA handle buf len =
945 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
946 let fo = haFO__ handle_
947 rc <- mayBlock fo (writeBufBA fo buf len) -- ConcHask: UNSAFE, may block.
950 else constructErrorAndFail "hPutBuf"
954 Sometimes it's useful to get at the file descriptor that
955 the Handle contains..
958 getHandleFd :: Handle -> IO Int
960 withHandle_ handle $ \ handle_ -> do
961 case (haType__ handle_) of
962 ErrorHandle theError -> ioError theError
963 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
965 fd <- getFileFd (haFO__ handle_)
970 %*********************************************************
972 \subsection{Miscellaneous}
974 %*********************************************************
976 These three functions are meant to get things out of @IOErrors@.
981 ioeGetFileName :: IOError -> Maybe FilePath
982 ioeGetErrorString :: IOError -> String
983 ioeGetHandle :: IOError -> Maybe Handle
985 ioeGetHandle (IOError h _ _ _) = h
986 ioeGetErrorString (IOError _ iot _ str) =
991 ioeGetFileName (IOError _ _ _ str) =
992 case span (/=':') str of
998 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
999 PrelMain.mainIO) and report them - topHandler is the exception
1000 handler they should use for this:
1003 -- make sure we handle errors while reporting the error!
1004 -- (e.g. evaluating the string passed to 'error' might generate
1005 -- another error, etc.)
1006 topHandler :: Bool -> Exception -> IO ()
1007 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1009 real_handler :: Bool -> Exception -> IO ()
1010 real_handler bombOut ex =
1012 AsyncException StackOverflow -> reportStackOverflow bombOut
1013 ErrorCall s -> reportError bombOut s
1014 other -> reportError bombOut (showsPrec 0 other "\n")
1016 reportStackOverflow :: Bool -> IO ()
1017 reportStackOverflow bombOut = do
1018 (hFlush stdout) `catchException` (\ _ -> return ())
1019 callStackOverflowHook
1025 reportError :: Bool -> String -> IO ()
1026 reportError bombOut str = do
1027 (hFlush stdout) `catchException` (\ _ -> return ())
1028 let bs@(ByteArray _ len _) = packString str
1029 writeErrString addrOf_ErrorHdrHook bs len
1035 foreign label "ErrorHdrHook"
1036 addrOf_ErrorHdrHook :: Addr
1038 foreign import ccall "writeErrString__" unsafe
1039 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1041 foreign import ccall "stackOverflow"
1042 callStackOverflowHook :: IO ()
1044 foreign import ccall "stg_exit"
1045 stg_exit :: Int -> IO ()
1049 A number of operations want to get at a readable or writeable handle, and fail
1053 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1054 wantReadableHandle fun handle act =
1055 withHandle_ handle $ \ handle_ -> do
1056 case haType__ handle_ of
1057 ErrorHandle theError -> ioError theError
1058 ClosedHandle -> ioe_closedHandle fun handle
1059 SemiClosedHandle -> ioe_closedHandle fun handle
1060 AppendHandle -> ioError not_readable_error
1061 WriteHandle -> ioError not_readable_error
1064 not_readable_error =
1065 IOError (Just handle) IllegalOperation fun
1066 ("handle is not open for reading")
1068 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1069 wantWriteableHandle fun handle act =
1070 withHandle_ handle $ \ handle_ -> do
1071 case haType__ handle_ of
1072 ErrorHandle theError -> ioError theError
1073 ClosedHandle -> ioe_closedHandle fun handle
1074 SemiClosedHandle -> ioe_closedHandle fun handle
1075 ReadHandle -> ioError not_writeable_error
1078 not_writeable_error =
1079 IOError (Just handle) IllegalOperation fun
1080 ("handle is not open for writing")
1082 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1083 wantRWHandle fun handle act =
1084 withHandle_ handle $ \ handle_ -> do
1085 case haType__ handle_ of
1086 ErrorHandle theError -> ioError theError
1087 ClosedHandle -> ioe_closedHandle fun handle
1088 SemiClosedHandle -> ioe_closedHandle fun handle
1091 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1092 wantSeekableHandle fun handle act =
1093 withHandle_ handle $ \ handle_ -> do
1094 case haType__ handle_ of
1095 ErrorHandle theError -> ioError theError
1096 ClosedHandle -> ioe_closedHandle fun handle
1097 SemiClosedHandle -> ioe_closedHandle fun handle
1100 not_seekable_error =
1101 IOError (Just handle)
1102 IllegalOperation fun
1103 ("handle is not seekable")
1107 Internal function for creating an @IOError@ representing the
1108 access to a closed file.
1111 ioe_closedHandle :: String -> Handle -> IO a
1112 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1115 Internal helper functions for Concurrent Haskell implementation
1119 #ifndef __PARALLEL_HASKELL__
1120 mayBlock :: ForeignObj -> IO Int -> IO Int
1122 mayBlock :: Addr -> IO Int -> IO Int
1125 mayBlock fo act = do
1128 -5 -> do -- (possibly blocking) read
1131 mayBlock fo act -- input available, re-try
1132 -6 -> do -- (possibly blocking) write
1135 mayBlock fo act -- output possible
1136 -7 -> do -- (possibly blocking) write on connected handle
1137 fd <- getConnFileFd fo
1139 mayBlock fo act -- output possible
1144 Foreign import declarations of helper functions:
1149 type Bytes = PrimByteArray RealWorld
1151 type Bytes = ByteArray#
1154 foreign import "libHS_cbits" "inputReady" unsafe
1155 inputReady :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1156 foreign import "libHS_cbits" "fileGetc" unsafe
1157 fileGetc :: FILE_OBJECT -> IO Int
1158 foreign import "libHS_cbits" "fileLookAhead" unsafe
1159 fileLookAhead :: FILE_OBJECT -> IO Int
1160 foreign import "libHS_cbits" "readBlock" unsafe
1161 readBlock :: FILE_OBJECT -> IO Int
1162 foreign import "libHS_cbits" "readLine" unsafe
1163 readLine :: FILE_OBJECT -> IO Int
1164 foreign import "libHS_cbits" "readChar" unsafe
1165 readChar :: FILE_OBJECT -> IO Int
1166 foreign import "libHS_cbits" "writeFileObject" unsafe
1167 writeFileObject :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1168 foreign import "libHS_cbits" "filePutc" unsafe
1169 filePutc :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1170 foreign import "libHS_cbits" "getBufStart" unsafe
1171 getBufStart :: FILE_OBJECT -> Int -> IO Addr
1172 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1173 getWriteableBuf :: FILE_OBJECT -> IO Addr
1174 foreign import "libHS_cbits" "getBufWPtr" unsafe
1175 getBufWPtr :: FILE_OBJECT -> IO Int
1176 foreign import "libHS_cbits" "setBufWPtr" unsafe
1177 setBufWPtr :: FILE_OBJECT -> Int -> IO ()
1178 foreign import "libHS_cbits" "closeFile" unsafe
1179 closeFile :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1180 foreign import "libHS_cbits" "fileEOF" unsafe
1181 fileEOF :: FILE_OBJECT -> IO Int{-ret code-}
1182 foreign import "libHS_cbits" "setBuffering" unsafe
1183 setBuffering :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1184 foreign import "libHS_cbits" "flushFile" unsafe
1185 flushFile :: FILE_OBJECT -> IO Int{-ret code-}
1186 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1187 flushConnectedBuf :: FILE_OBJECT -> IO ()
1188 foreign import "libHS_cbits" "getBufferMode" unsafe
1189 getBufferMode :: FILE_OBJECT -> IO Int{-ret code-}
1191 foreign import "libHS_cbits" "seekFile_int64" unsafe
1192 seekFile :: FILE_OBJECT -> Int -> Int64 -> IO Int
1194 foreign import "libHS_cbits" "seekFile" unsafe
1195 seekFile :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1198 foreign import "libHS_cbits" "seekFileP" unsafe
1199 seekFileP :: FILE_OBJECT -> IO Int{-ret code-}
1200 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1201 setTerminalEcho :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1202 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1203 getTerminalEcho :: FILE_OBJECT -> IO Int{-ret code-}
1204 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1205 isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1206 foreign import "libHS_cbits" "setConnectedTo" unsafe
1207 setConnectedTo :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1208 foreign import "libHS_cbits" "ungetChar" unsafe
1209 ungetChar :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1210 foreign import "libHS_cbits" "readChunk" unsafe
1211 readChunk :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1212 foreign import "libHS_cbits" "readChunk" unsafe
1213 readChunkBA :: FILE_OBJECT -> ByteArray Int -> Int -> IO Int{-ret code-}
1214 foreign import "libHS_cbits" "writeBuf" unsafe
1215 writeBuf :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1217 foreign import "libHS_cbits" "writeBufBA" unsafe
1218 writeBufBA :: FILE_OBJECT -> ByteArray Int -> Int -> IO Int{-ret code-}
1220 foreign import "libHS_cbits" "getFileFd" unsafe
1221 getFileFd :: FILE_OBJECT -> IO Int{-fd-}
1223 foreign import "libHS_cbits" "fileSize_int64" unsafe
1224 fileSize_int64 :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1226 foreign import "libHS_cbits" "fileSize" unsafe
1227 fileSize :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1230 foreign import "libHS_cbits" "getFilePosn" unsafe
1231 getFilePosn :: FILE_OBJECT -> IO Int
1232 foreign import "libHS_cbits" "setFilePosn" unsafe
1233 setFilePosn :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1234 foreign import "libHS_cbits" "getConnFileFd" unsafe
1235 getConnFileFd :: FILE_OBJECT -> IO Int{-fd-}
1236 foreign import "libHS_cbits" "getLock" unsafe
1237 getLock :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1238 foreign import "libHS_cbits" "openStdFile" unsafe
1239 openStdFile :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1240 foreign import "libHS_cbits" "openFile" unsafe
1241 primOpenFile :: ByteArray Int{-CString-}
1244 -> IO Addr {-file obj-}
1245 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1248 foreign import "libHS_cbits" "setBinaryMode__"
1249 setBinaryMode :: FILE_OBJECT -> Int -> IO Int