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 cat2(x,y) x/**/y
46 #define CCALL(fun) cat2(prim_,fun)
47 #define __CONCURRENT_HASKELL__
49 #define sizeof_int64 8
51 #define CCALL(fun) _ccall_ fun
52 #define const_BUFSIZ ``BUFSIZ''
53 #define primPackString
56 #ifndef __PARALLEL_HASKELL__
57 #define FILE_OBJECT ForeignObj
59 #define FILE_OBJECT Addr
63 %*********************************************************
65 \subsection{Types @Handle@, @Handle__@}
67 %*********************************************************
69 The @Handle@ and @Handle__@ types are defined in @IOBase@.
72 {-# INLINE newHandle #-}
73 {-# INLINE withHandle #-}
74 newHandle :: Handle__ -> IO Handle
76 #if defined(__CONCURRENT_HASKELL__)
78 -- Use MVars for concurrent Haskell
79 newHandle hc = newMVar hc >>= \ h ->
83 -- Use ordinary MutableVars for non-concurrent Haskell
84 newHandle hc = stToIO (newVar 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 #ifdef __CONCURRENT_HASKELL__
117 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
118 withHandle (Handle h) act = do
120 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
124 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
125 withHandle_ (Handle h) act = do
127 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
131 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
132 withHandle__ (Handle h) act = do
134 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
139 -- of questionable value to install this exception
140 -- handler, but let's do it in the non-concurrent
141 -- case too, for now.
142 withHandle (Handle h) act = do
143 h_ <- stToIO (readVar h)
144 v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
150 nullFile__ is only used for closed handles, plugging it in as a null
151 file object reference.
154 nullFile__ :: FILE_OBJECT
156 #ifndef __PARALLEL_HASKELL__
157 unsafePerformIO (makeForeignObj nullAddr)
163 mkClosedHandle__ :: Handle__
171 mkErrorHandle__ :: IOError -> Handle__
172 mkErrorHandle__ ioe =
180 %*********************************************************
182 \subsection{Handle Finalizers}
184 %*********************************************************
188 freeStdFileObject :: ForeignObj -> IO ()
189 freeStdFileObject fo = CCALL(freeStdFileObject) fo
191 freeFileObject :: ForeignObj -> IO ()
192 freeFileObject fo = CCALL(freeFileObject) fo
194 foreign import stdcall "libHS_cbits.so" "freeStdFileObject" freeStdFileObject :: ForeignObj -> IO ()
195 foreign import stdcall "libHS_cbits.so" "freeFileObject" freeFileObject :: ForeignObj -> IO ()
199 %*********************************************************
201 \subsection[StdHandles]{Standard handles}
203 %*********************************************************
205 Three handles are allocated during program initialisation. The first
206 two manage input or output from the Haskell program's standard input
207 or output channel respectively. The third manages output to the
208 standard error channel. These handles are initially open.
212 stdin, stdout, stderr :: Handle
214 stdout = unsafePerformIO (do
215 rc <- CCALL(getLock) (1::Int) (1::Int) -- ConcHask: SAFE, won't block
217 0 -> newHandle (mkClosedHandle__)
219 #ifndef __CONCURRENT_HASKELL__
220 fo <- CCALL(openStdFile) (1::Int)
221 (1::Int){-flush on close-}
222 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
224 fo <- CCALL(openStdFile) (1::Int)
225 ((1{-flush on close-})::Int)
226 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
229 #ifndef __PARALLEL_HASKELL__
230 fo <- makeForeignObj fo
231 addForeignFinalizer fo (freeStdFileObject fo)
235 /* I dont care what the Haskell report says, in an interactive system,
236 * stdout should be unbuffered by default.
240 (bm, bf_size) <- getBMode__ fo
241 mkBuffer__ fo bf_size
243 newHandle (Handle__ fo WriteHandle bm "stdout")
244 _ -> do ioError <- constructError "stdout"
245 newHandle (mkErrorHandle__ ioError)
248 stdin = unsafePerformIO (do
249 rc <- CCALL(getLock) (0::Int) (0::Int) -- ConcHask: SAFE, won't block
251 0 -> newHandle (mkClosedHandle__)
253 #ifndef __CONCURRENT_HASKELL__
254 fo <- CCALL(openStdFile) (0::Int)
255 (0::Int){-don't flush on close -}
256 (1::Int){-readable-} -- ConcHask: SAFE, won't block
258 fo <- CCALL(openStdFile) (0::Int)
259 ((0{-flush on close-})::Int)
260 (1::Int){-readable-} -- ConcHask: SAFE, won't block
263 #ifndef __PARALLEL_HASKELL__
264 fo <- makeForeignObj fo
265 addForeignFinalizer fo (freeStdFileObject fo)
267 (bm, bf_size) <- getBMode__ fo
268 mkBuffer__ fo bf_size
269 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
270 -- when stdin and stdout are both connected to a terminal, ensure
271 -- that anything buffered on stdout is flushed prior to reading from stdin.
273 hConnectTerms stdout hdl
275 _ -> do ioError <- constructError "stdin"
276 newHandle (mkErrorHandle__ ioError)
280 stderr = unsafePerformIO (do
281 rc <- CCALL(getLock) (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
283 0 -> newHandle (mkClosedHandle__)
285 #ifndef __CONCURRENT_HASKELL__
286 fo <- CCALL(openStdFile) (2::Int)
287 (1::Int){-flush on close-}
288 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
290 fo <- CCALL(openStdFile) (2::Int)
291 ((1{-flush on close-})::Int)
292 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
295 #ifndef __PARALLEL_HASKELL__
296 fo <- makeForeignObj fo
297 addForeignFinalizer fo (freeStdFileObject fo)
299 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
300 -- when stderr and stdout are both connected to a terminal, ensure
301 -- that anything buffered on stdout is flushed prior to writing to
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 <- CCALL(openFile) (primPackString f) (file_mode::Int)
334 (file_flags::Int) -- ConcHask: SAFE, won't block
335 if fo /= nullAddr then do
336 #ifndef __PARALLEL_HASKELL__
337 fo <- makeForeignObj fo
338 addForeignFinalizer fo (freeFileObject fo)
340 (bm, bf_size) <- getBMode__ fo
341 mkBuffer__ fo bf_size
342 newHandle (Handle__ fo htype bm f)
344 constructErrorAndFailWithInfo "openFile" f
348 BinaryMode bmo -> (bmo, 1)
349 TextMode tmo -> (tmo, 0)
351 (file_flags, file_mode) =
356 ReadWriteMode -> (1, 3)
359 ReadMode -> ReadHandle
360 WriteMode -> WriteHandle
361 AppendMode -> AppendHandle
362 ReadWriteMode -> ReadWriteHandle
365 Computation $openFile file mode$ allocates and returns a new, open
366 handle to manage the file {\em file}. It manages input if {\em mode}
367 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
368 and both input and output if mode is $ReadWriteMode$.
370 If the file does not exist and it is opened for output, it should be
371 created as a new file. If {\em mode} is $WriteMode$ and the file
372 already exists, then it should be truncated to zero length. The
373 handle is positioned at the end of the file if {\em mode} is
374 $AppendMode$, and otherwise at the beginning (in which case its
375 internal position is 0).
377 Implementations should enforce, locally to the Haskell process,
378 multiple-reader single-writer locking on files, which is to say that
379 there may either be many handles on the same file which manage input,
380 or just one handle on the file which manages output. If any open or
381 semi-closed handle is managing a file for output, no new handle can be
382 allocated for that file. If any open or semi-closed handle is
383 managing a file for input, new handles can only be allocated if they
384 do not manage output.
386 Two files are the same if they have the same absolute name. An
387 implementation is free to impose stricter conditions.
390 hClose :: Handle -> IO ()
393 withHandle__ handle $ \ handle_ -> do
394 case haType__ handle_ of
395 ErrorHandle theError -> ioError theError
396 ClosedHandle -> return handle_
398 rc <- CCALL(closeFile) (haFO__ handle_) (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
399 {- We explicitly close a file object so that we can be told
400 if there were any errors. Note that after @hClose@
401 has been performed, the ForeignObj embedded in the Handle
402 is still lying around in the heap, so care is taken
403 to avoid closing the file object when the ForeignObj
404 is finalized. (we overwrite the file ptr in the underlying
405 FileObject with a NULL as part of closeFile())
408 then return (handle_{ haType__ = ClosedHandle,
409 haFO__ = nullFile__ })
410 else constructErrorAndFail "hClose"
414 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
415 computation finishes, any items buffered for output and not already
416 sent to the operating system are flushed as for $flush$.
418 %*********************************************************
420 \subsection[EOF]{Detecting the End of Input}
422 %*********************************************************
425 For a handle {\em hdl} which attached to a physical file, $hFileSize
426 hdl$ returns the size of {\em hdl} in terms of the number of items
427 which can be read from {\em hdl}.
430 hFileSize :: Handle -> IO Integer
432 withHandle_ handle $ \ handle_ -> do
433 case haType__ handle_ of
434 ErrorHandle theError -> ioError theError
435 ClosedHandle -> ioe_closedHandle "hFileSize" handle
436 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
439 mem <- primNewByteArray sizeof_int64
440 rc <- CCALL(fileSize_int64) (haFO__ handle_) mem -- ConcHask: SAFE, won't block
442 result <- primReadInt64Array mem 0
443 return (primInt64ToInteger result)
445 constructErrorAndFail "hFileSize"
448 -- HACK! We build a unique MP_INT of the right shape to hold
449 -- a single unsigned word, and we let the C routine
450 -- change the data bits
452 -- For some reason, this fails to typecheck if converted to a do
454 _casm_ ``%r = 1;'' >>= \(I# hack#) ->
455 case int2Integer# hack# of
457 rc <- CCALL(fileSize) (haFO__ handle_) d -- ConcHask: SAFE, won't block
458 if rc == (0::Int) then
461 constructErrorAndFail "hFileSize"
465 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
466 @True@ if no further input can be taken from @hdl@ or for a
467 physical file, if the current I/O position is equal to the length of
468 the file. Otherwise, it returns @False@.
471 hIsEOF :: Handle -> IO Bool
473 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
474 let fo = haFO__ handle_
475 rc <- mayBlock fo (CCALL(fileEOF) fo) -- ConcHask: UNSAFE, may block
479 _ -> constructErrorAndFail "hIsEOF"
485 %*********************************************************
487 \subsection[Buffering]{Buffering Operations}
489 %*********************************************************
491 Three kinds of buffering are supported: line-buffering,
492 block-buffering or no-buffering. See @IOBase@ for definition
493 and further explanation of what the type represent.
495 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
496 handle {\em hdl} on subsequent reads and writes.
500 If {\em mode} is @LineBuffering@, line-buffering should be
503 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
504 should be enabled if possible. The size of the buffer is {\em n} items
505 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
507 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
510 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
511 to @NoBuffering@, then any items in the output buffer are written to
512 the device, and any items in the input buffer are discarded. The
513 default buffering mode when a handle is opened is
514 implementation-dependent and may depend on the object which is
515 attached to that handle.
518 hSetBuffering :: Handle -> BufferMode -> IO ()
520 hSetBuffering handle mode =
522 BlockBuffering (Just n)
524 (IOError (Just handle)
527 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
529 withHandle__ handle $ \ handle_ -> do
530 case haType__ handle_ of
531 ErrorHandle theError -> ioError theError
532 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
535 - we flush the old buffer regardless of whether
536 the new buffer could fit the contents of the old buffer
538 - allow a handle's buffering to change even if IO has
539 occurred (ANSI C spec. does not allow this, nor did
540 the previous implementation of IO.hSetBuffering).
541 - a non-standard extension is to allow the buffering
542 of semi-closed handles to change [sof 6/98]
544 let fo = haFO__ handle_
545 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
548 return (handle_{ haBufferMode__ = mode })
550 -- Note: failure to change the buffer size will cause old buffer to be flushed.
551 constructErrorAndFail "hSetBuffering"
557 BlockBuffering Nothing -> -2
558 BlockBuffering (Just n) -> n
561 The action @hFlush hdl@ causes any items buffered for output
562 in handle {\em hdl} to be sent immediately to the operating
566 hFlush :: Handle -> IO ()
568 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
569 let fo = haFO__ handle_
570 rc <- mayBlock fo (CCALL(flushFile) fo) -- ConcHask: UNSAFE, may block
574 constructErrorAndFail "hFlush"
579 %*********************************************************
581 \subsection[Seeking]{Repositioning Handles}
583 %*********************************************************
588 Handle -- Q: should this be a weak or strong ref. to the handle?
591 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
592 deriving (Eq, Ord, Ix, Enum, Read, Show)
595 Computation @hGetPosn hdl@ returns the current I/O
596 position of {\em hdl} as an abstract position. Computation
597 $hSetPosn p$ sets the position of {\em hdl}
598 to a previously obtained position {\em p}.
601 hGetPosn :: Handle -> IO HandlePosn
603 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
604 posn <- CCALL(getFilePosn) (haFO__ handle_) -- ConcHask: SAFE, won't block
605 if posn /= -1 then do
606 return (HandlePosn handle posn)
608 constructErrorAndFail "hGetPosn"
610 hSetPosn :: HandlePosn -> IO ()
611 hSetPosn (HandlePosn handle posn) =
612 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
613 let fo = haFO__ handle_
614 rc <- mayBlock fo (CCALL(setFilePosn) fo posn) -- ConcHask: UNSAFE, may block
618 constructErrorAndFail "hSetPosn"
621 The action @hSeek hdl mode i@ sets the position of handle
622 @hdl@ depending on @mode@. If @mode@ is
624 \item[{\bf AbsoluteSeek}] The position of @hdl@ is set to @i@.
625 \item[{\bf RelativeSeek}] The position of @hdl@ is set to offset @i@ from
626 the current position.
627 \item[{\bf SeekFromEnd}] The position of @hdl@ is set to offset @i@ from
631 Some handles may not be seekable (see @hIsSeekable@), or only support a
632 subset of the possible positioning operations (e.g. it may only be
633 possible to seek to the end of a tape, or to a positive offset from
634 the beginning or current position).
636 It is not possible to set a negative I/O position, or for a physical
637 file, an I/O position beyond the current end-of-file.
640 - when seeking using @SeekFromEnd@, positive offsets (>=0) means seeking
642 - relative seeking on buffered handles can lead to non-obvious results.
645 hSeek :: Handle -> SeekMode -> Integer -> IO ()
647 hSeek handle mode offset =
648 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
649 let fo = haFO__ handle_
650 rc <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
652 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
653 hSeek handle mode (J# s# d#) =
654 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
655 let fo = haFO__ handle_
656 rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
661 constructErrorAndFail "hSeek"
664 whence = case mode of
670 %*********************************************************
672 \subsection[Query]{Handle Properties}
674 %*********************************************************
676 A number of operations return information about the properties of a
677 handle. Each of these operations returns $True$ if the
678 handle has the specified property, and $False$
681 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
682 {\em hdl} is not block-buffered. Otherwise it returns
683 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
684 $( Just n )$ for block-buffering of {\em n} bytes.
687 hIsOpen :: Handle -> IO Bool
689 withHandle_ handle $ \ handle_ -> do
690 case haType__ handle_ of
691 ErrorHandle theError -> ioError theError
692 ClosedHandle -> return False
693 SemiClosedHandle -> return False
696 hIsClosed :: Handle -> IO Bool
698 withHandle_ handle $ \ handle_ -> do
699 case haType__ handle_ of
700 ErrorHandle theError -> ioError theError
701 ClosedHandle -> return True
704 {- not defined, nor exported, but mentioned
705 here for documentation purposes:
707 hSemiClosed :: Handle -> IO Bool
711 return (not (ho || hc))
714 hIsReadable :: Handle -> IO Bool
716 withHandle_ handle $ \ handle_ -> do
717 case haType__ handle_ of
718 ErrorHandle theError -> ioError theError
719 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
720 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
721 htype -> return (isReadable htype)
723 isReadable ReadHandle = True
724 isReadable ReadWriteHandle = True
727 hIsWritable :: Handle -> IO Bool
729 withHandle_ handle $ \ handle_ -> do
730 case haType__ handle_ of
731 ErrorHandle theError -> ioError theError
732 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
733 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
734 htype -> return (isWritable htype)
736 isWritable AppendHandle = True
737 isWritable WriteHandle = True
738 isWritable ReadWriteHandle = True
742 #ifndef __PARALLEL_HASKELL__
743 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
745 getBMode__ :: Addr -> IO (BufferMode, Int)
748 rc <- CCALL(getBufferMode) fo -- ConcHask: SAFE, won't block
750 0 -> return (NoBuffering, 0)
751 -1 -> return (LineBuffering, default_buffer_size)
752 -2 -> return (BlockBuffering Nothing, default_buffer_size)
753 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
754 n -> return (BlockBuffering (Just n), n)
756 default_buffer_size :: Int
757 default_buffer_size = (const_BUFSIZ - 1)
760 Querying how a handle buffers its data:
763 hGetBuffering :: Handle -> IO BufferMode
764 hGetBuffering handle =
765 withHandle_ handle $ \ handle_ -> do
766 case haType__ handle_ of
767 ErrorHandle theError -> ioError theError
768 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
771 We're being non-standard here, and allow the buffering
772 of a semi-closed handle to be queried. -- sof 6/98
774 return (haBufferMode__ handle_) -- could be stricter..
778 hIsSeekable :: Handle -> IO Bool
780 withHandle_ handle $ \ handle_ -> do
781 case haType__ handle_ of
782 ErrorHandle theError -> ioError theError
783 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
784 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
785 AppendHandle -> return False
787 rc <- CCALL(seekFileP) (haFO__ handle_) -- ConcHask: SAFE, won't block
791 _ -> constructErrorAndFail "hIsSeekable"
795 %*********************************************************
797 \subsection{Changing echo status}
799 %*********************************************************
801 Non-standard GHC extension is to allow the echoing status
802 of a handles connected to terminals to be reconfigured:
805 hSetEcho :: Handle -> Bool -> IO ()
806 hSetEcho handle on = do
807 isT <- hIsTerminalDevice handle
811 withHandle_ handle $ \ handle_ -> do
812 case haType__ handle_ of
813 ErrorHandle theError -> ioError theError
814 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
816 rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int) -- ConcHask: SAFE, won't block
819 else constructErrorAndFail "hSetEcho"
821 hGetEcho :: Handle -> IO Bool
823 isT <- hIsTerminalDevice handle
827 withHandle_ handle $ \ handle_ -> do
828 case haType__ handle_ of
829 ErrorHandle theError -> ioError theError
830 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
832 rc <- CCALL(getTerminalEcho) (haFO__ handle_) -- ConcHask: SAFE, won't block
836 _ -> constructErrorAndFail "hSetEcho"
838 hIsTerminalDevice :: Handle -> IO Bool
839 hIsTerminalDevice handle = do
840 withHandle_ handle $ \ handle_ -> do
841 case haType__ handle_ of
842 ErrorHandle theError -> ioError theError
843 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
845 rc <- CCALL(isTerminalDevice) (haFO__ handle_) -- ConcHask: SAFE, won't block
849 _ -> constructErrorAndFail "hIsTerminalDevice"
853 hConnectTerms :: Handle -> Handle -> IO ()
854 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
856 hConnectTo :: Handle -> Handle -> IO ()
857 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
859 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
860 hConnectHdl_ hW hR is_tty =
861 wantRWHandle "hConnectTo" hW $ \ hW_ ->
862 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
863 CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
865 #ifndef __PARALLEL_HASKELL__
866 #define FILE_OBJECT ForeignObj
868 #define FILE_OBJECT Addr
871 flushConnectedBuf :: FILE_OBJECT -> IO ()
872 flushConnectedBuf fo = CCALL(flushConnectedBuf) fo
875 As an extension, we also allow characters to be pushed back.
876 Like ANSI C stdio, we guarantee no more than one character of
877 pushback. (For unbuffered channels, the (default) push-back limit is
881 hUngetChar :: Handle -> Char -> IO ()
882 hUngetChar handle c =
883 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
884 rc <- CCALL(ungetChar) (haFO__ handle_) c -- ConcHask: SAFE, won't block
886 then constructErrorAndFail "hUngetChar"
892 Hoisting files in in one go is sometimes useful, so we support
893 this as an extension:
896 -- in one go, read file into an externally allocated buffer.
897 slurpFile :: FilePath -> IO (Addr, Int)
899 handle <- openFile fname ReadMode
900 sz <- hFileSize handle
901 if sz > toInteger (maxBound::Int) then
902 ioError (userError "slurpFile: file too big")
904 let sz_i = fromInteger sz
905 chunk <- CCALL(allocMemory__) (sz_i::Int)
909 constructErrorAndFail "slurpFile"
911 rc <- withHandle_ handle ( \ handle_ -> do
912 let fo = haFO__ handle_
913 mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
917 then constructErrorAndFail "slurpFile"
918 else return (chunk, rc)
920 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
921 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
922 hFillBufBA handle buf sz
923 | sz <= 0 = ioError (IOError (Just handle)
926 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
928 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
929 let fo = haFO__ handle_
931 rc <- mayBlock fo (CCALL(readChunkBA) fo buf sz) -- ConcHask: UNSAFE, may block.
933 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
937 else constructErrorAndFail "hFillBufBA"
940 hFillBuf :: Handle -> Addr -> Int -> IO Int
941 hFillBuf handle buf sz
942 | sz <= 0 = ioError (IOError (Just handle)
945 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
947 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
948 let fo = haFO__ handle_
949 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
952 else constructErrorAndFail "hFillBuf"
956 The @hPutBuf hdl buf len@ action writes an already packed sequence of
957 bytes to the file/channel managed by @hdl@ - non-standard.
960 hPutBuf :: Handle -> Addr -> Int -> IO ()
961 hPutBuf handle buf len =
962 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
963 let fo = haFO__ handle_
964 rc <- mayBlock fo (CCALL(writeBuf) fo buf len) -- ConcHask: UNSAFE, may block.
967 else constructErrorAndFail "hPutBuf"
969 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
970 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
971 hPutBufBA handle buf len =
972 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
973 let fo = haFO__ handle_
974 rc <- mayBlock fo (CCALL(writeBufBA) fo buf len) -- ConcHask: UNSAFE, may block.
977 else constructErrorAndFail "hPutBuf"
981 Sometimes it's useful to get at the file descriptor that
982 the Handle contains..
985 getHandleFd :: Handle -> IO Int
987 withHandle_ handle $ \ handle_ -> do
988 case (haType__ handle_) of
989 ErrorHandle theError -> ioError theError
990 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
992 fd <- CCALL(getFileFd) (haFO__ handle_)
997 %*********************************************************
999 \subsection{Miscellaneous}
1001 %*********************************************************
1003 These three functions are meant to get things out of @IOErrors@.
1008 ioeGetFileName :: IOError -> Maybe FilePath
1009 ioeGetErrorString :: IOError -> String
1010 ioeGetHandle :: IOError -> Maybe Handle
1012 ioeGetHandle (IOError h _ _ _) = h
1013 ioeGetErrorString (IOError _ iot _ str) =
1015 EOF -> "end of file"
1018 ioeGetFileName (IOError _ _ _ str) =
1019 case span (/=':') str of
1025 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
1026 PrelMain.mainIO) and report them - topHandler is the exception
1027 handler they should use for this:
1030 -- make sure we handle errors while reporting the error!
1031 -- (e.g. evaluating the string passed to 'error' might generate
1032 -- another error, etc.)
1033 topHandler :: Bool -> Exception -> IO ()
1034 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1036 real_handler :: Bool -> Exception -> IO ()
1037 real_handler bombOut ex =
1039 AsyncException StackOverflow -> reportStackOverflow bombOut
1040 ErrorCall s -> reportError bombOut s
1041 other -> reportError bombOut (showsPrec 0 other "\n")
1043 reportStackOverflow :: Bool -> IO ()
1044 reportStackOverflow bombOut = do
1045 (hFlush stdout) `catchException` (\ _ -> return ())
1046 callStackOverflowHook
1052 reportError :: Bool -> String -> IO ()
1053 reportError bombOut str = do
1054 (hFlush stdout) `catchException` (\ _ -> return ())
1055 let bs@(ByteArray (_,len) _) = packString str
1056 writeErrString addrOf_ErrorHdrHook bs len
1062 foreign label "ErrorHdrHook"
1063 addrOf_ErrorHdrHook :: Addr
1065 foreign import ccall "writeErrString__"
1066 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1068 foreign import ccall "stackOverflow"
1069 callStackOverflowHook :: IO ()
1071 foreign import ccall "stg_exit"
1072 stg_exit :: Int -> IO ()
1076 A number of operations want to get at a readable or writeable handle, and fail
1080 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1081 wantReadableHandle fun handle act =
1082 withHandle_ handle $ \ handle_ -> do
1083 case haType__ handle_ of
1084 ErrorHandle theError -> ioError theError
1085 ClosedHandle -> ioe_closedHandle fun handle
1086 SemiClosedHandle -> ioe_closedHandle fun handle
1087 AppendHandle -> ioError not_readable_error
1088 WriteHandle -> ioError not_readable_error
1091 not_readable_error =
1092 IOError (Just handle) IllegalOperation fun
1093 ("handle is not open for reading")
1095 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1096 wantWriteableHandle fun handle act =
1097 withHandle_ handle $ \ handle_ -> do
1098 case haType__ handle_ of
1099 ErrorHandle theError -> ioError theError
1100 ClosedHandle -> ioe_closedHandle fun handle
1101 SemiClosedHandle -> ioe_closedHandle fun handle
1102 ReadHandle -> ioError not_writeable_error
1105 not_writeable_error =
1106 IOError (Just handle) IllegalOperation fun
1107 ("handle is not open for writing")
1109 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1110 wantRWHandle fun handle act =
1111 withHandle_ handle $ \ handle_ -> do
1112 case haType__ handle_ of
1113 ErrorHandle theError -> ioError theError
1114 ClosedHandle -> ioe_closedHandle fun handle
1115 SemiClosedHandle -> ioe_closedHandle fun handle
1118 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1119 wantSeekableHandle fun handle act =
1120 withHandle_ handle $ \ handle_ -> do
1121 case haType__ handle_ of
1122 ErrorHandle theError -> ioError theError
1123 ClosedHandle -> ioe_closedHandle fun handle
1124 SemiClosedHandle -> ioe_closedHandle fun handle
1125 AppendHandle -> ioError not_seekable_error
1128 not_seekable_error =
1129 IOError (Just handle)
1130 IllegalOperation fun
1131 ("handle is not seekable")
1135 Internal function for creating an @IOError@ representing the
1136 access to a closed file.
1139 ioe_closedHandle :: String -> Handle -> IO a
1140 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1143 Internal helper functions for Concurrent Haskell implementation
1147 #ifndef __PARALLEL_HASKELL__
1148 mayBlock :: ForeignObj -> IO Int -> IO Int
1150 mayBlock :: Addr -> IO Int -> IO Int
1153 mayBlock fo act = do
1156 -5 -> do -- (possibly blocking) read
1157 fd <- CCALL(getFileFd) fo
1159 mayBlock fo act -- input available, re-try
1160 -6 -> do -- (possibly blocking) write
1161 fd <- CCALL(getFileFd) fo
1163 mayBlock fo act -- output possible
1164 -7 -> do -- (possibly blocking) write on connected handle
1165 fd <- CCALL(getConnFileFd) fo
1167 mayBlock fo act -- output possible
1176 type Exclusive = Int -- really Bool
1179 type OpenStdFlags = Int
1180 type OpenFlags = Int
1181 type Readable = Int -- really Bool
1182 type Flush = Int -- really Bool
1183 type RC = Int -- standard return code
1185 type IOFileAddr = Addr -- as returned from functions
1186 type CString = PrimByteArray
1187 type Bytes = PrimMutableByteArray RealWorld
1189 #ifndef __PARALLEL_HASKELL__
1190 type FILE_OBJ = ForeignObj -- as passed into functions
1192 type FILE_OBJ = Addr
1195 foreign import ccall "libHS_cbits.so" "setBuf" unsafe prim_setBuf :: FILE_OBJ -> Addr -> Int -> IO ()
1196 foreign import ccall "libHS_cbits.so" "getBufSize" unsafe prim_getBufSize :: FILE_OBJ -> IO Int
1197 foreign import ccall "libHS_cbits.so" "inputReady" unsafe prim_inputReady :: FILE_OBJ -> Int -> IO RC
1198 foreign import ccall "libHS_cbits.so" "fileGetc" unsafe prim_fileGetc :: FILE_OBJ -> IO Int
1199 foreign import ccall "libHS_cbits.so" "fileLookAhead" unsafe prim_fileLookAhead :: FILE_OBJ -> IO Int
1200 foreign import ccall "libHS_cbits.so" "readBlock" unsafe prim_readBlock :: FILE_OBJ -> IO Int
1201 foreign import ccall "libHS_cbits.so" "readLine" unsafe prim_readLine :: FILE_OBJ -> IO Int
1202 foreign import ccall "libHS_cbits.so" "readChar" unsafe prim_readChar :: FILE_OBJ -> IO Int
1203 foreign import ccall "libHS_cbits.so" "writeFileObject" unsafe prim_writeFileObject :: FILE_OBJ -> Int -> IO RC
1204 foreign import ccall "libHS_cbits.so" "filePutc" unsafe prim_filePutc :: FILE_OBJ -> Char -> IO RC
1205 foreign import ccall "libHS_cbits.so" "getBufStart" unsafe prim_getBufStart :: FILE_OBJ -> Int -> IO Addr
1206 foreign import ccall "libHS_cbits.so" "getWriteableBuf" unsafe prim_getWriteableBuf :: FILE_OBJ -> IO Addr
1207 foreign import ccall "libHS_cbits.so" "getBufWPtr" unsafe prim_getBufWPtr :: FILE_OBJ -> IO Int
1208 foreign import ccall "libHS_cbits.so" "setBufWPtr" unsafe prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
1209 foreign import ccall "libHS_cbits.so" "closeFile" unsafe prim_closeFile :: FILE_OBJ -> Flush -> IO RC
1210 foreign import ccall "libHS_cbits.so" "fileEOF" unsafe prim_fileEOF :: FILE_OBJ -> IO RC
1211 foreign import ccall "libHS_cbits.so" "setBuffering" unsafe prim_setBuffering :: FILE_OBJ -> Int -> IO RC
1212 foreign import ccall "libHS_cbits.so" "flushFile" unsafe prim_flushFile :: FILE_OBJ -> IO RC
1213 foreign import ccall "libHS_cbits.so" "flushConnectedBuf" unsafe prim_flushConnectedBuf :: FILE_OBJ -> IO RC
1214 foreign import ccall "libHS_cbits.so" "getBufferMode" unsafe prim_getBufferMode :: FILE_OBJ -> IO RC
1215 foreign import ccall "libHS_cbits.so" "seekFile_int64" unsafe prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
1216 foreign import ccall "libHS_cbits.so" "seekFileP" unsafe prim_seekFileP :: FILE_OBJ -> IO RC
1217 foreign import ccall "libHS_cbits.so" "setTerminalEcho" unsafe prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
1218 foreign import ccall "libHS_cbits.so" "getTerminalEcho" unsafe prim_getTerminalEcho :: FILE_OBJ -> IO RC
1219 foreign import ccall "libHS_cbits.so" "isTerminalDevice" unsafe prim_isTerminalDevice :: FILE_OBJ -> IO RC
1220 foreign import ccall "libHS_cbits.so" "setConnectedTo" unsafe prim_setConnectedTo :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
1221 foreign import ccall "libHS_cbits.so" "ungetChar" unsafe prim_ungetChar :: FILE_OBJ -> Char -> IO RC
1222 foreign import ccall "libHS_cbits.so" "readChunk" unsafe prim_readChunk :: FILE_OBJ -> Addr -> Int -> IO RC
1223 foreign import ccall "libHS_cbits.so" "writeBuf" unsafe prim_writeBuf :: FILE_OBJ -> Addr -> Int -> IO RC
1224 foreign import ccall "libHS_cbits.so" "getFileFd" unsafe prim_getFileFd :: FILE_OBJ -> IO FD
1225 foreign import ccall "libHS_cbits.so" "fileSize_int64" unsafe prim_fileSize_int64 :: FILE_OBJ -> Bytes -> IO RC
1226 foreign import ccall "libHS_cbits.so" "getFilePosn" unsafe prim_getFilePosn :: FILE_OBJ -> IO Int
1227 foreign import ccall "libHS_cbits.so" "setFilePosn" unsafe prim_setFilePosn :: FILE_OBJ -> Int -> IO Int
1228 foreign import ccall "libHS_cbits.so" "getConnFileFd" unsafe prim_getConnFileFd :: FILE_OBJ -> IO FD
1229 foreign import ccall "libHS_cbits.so" "allocMemory__" unsafe prim_allocMemory__ :: Int -> IO Addr
1230 foreign import ccall "libHS_cbits.so" "getLock" unsafe prim_getLock :: FD -> Exclusive -> IO RC
1231 foreign import ccall "libHS_cbits.so" "openStdFile" unsafe prim_openStdFile :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
1232 foreign import ccall "libHS_cbits.so" "openFile" unsafe prim_openFile :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
1233 foreign import ccall "libHS_cbits.so" "freeFileObject" unsafe prim_freeFileObject :: FILE_OBJ -> IO ()
1234 foreign import ccall "libHS_cbits.so" "freeStdFileObject" unsafe prim_freeStdFileObject :: FILE_OBJ -> IO ()
1235 foreign import ccall "libHS_cbits.so" "const_BUFSIZ" unsafe const_BUFSIZ :: Int
1237 foreign import ccall "libHS_cbits.so" "getErrStr__" unsafe prim_getErrStr__ :: IO Addr
1238 foreign import ccall "libHS_cbits.so" "getErrNo__" unsafe prim_getErrNo__ :: IO Int
1239 foreign import ccall "libHS_cbits.so" "getErrType__" unsafe prim_getErrType__ :: IO Int