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
18 import PrelAddr ( Addr, nullAddr )
19 import PrelArr ( newVar, readVar, writeVar )
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 )
37 #ifdef __CONCURRENT_HASKELL__
41 #ifndef __PARALLEL_HASKELL__
42 import PrelForeign ( makeForeignObj )
45 #endif /* ndef(__HUGS__) */
48 #define __CONCURRENT_HASKELL__
52 #ifndef __PARALLEL_HASKELL__
53 #define FILE_OBJECT ForeignObj
55 #define FILE_OBJECT Addr
59 %*********************************************************
61 \subsection{Types @Handle@, @Handle__@}
63 %*********************************************************
65 The @Handle@ and @Handle__@ types are defined in @IOBase@.
68 {-# INLINE newHandle #-}
69 {-# INLINE withHandle #-}
70 newHandle :: Handle__ -> IO Handle
72 #if defined(__CONCURRENT_HASKELL__)
74 -- Use MVars for concurrent Haskell
75 newHandle hc = newMVar hc >>= \ h ->
79 -- Use ordinary MutableVars for non-concurrent Haskell
80 newHandle hc = stToIO (newVar hc >>= \ h ->
85 %*********************************************************
87 \subsection{@withHandle@ operations}
89 %*********************************************************
91 In the concurrent world, handles are locked during use. This is done
92 by wrapping an MVar around the handle which acts as a mutex over
93 operations on the handle.
95 To avoid races, we use the following bracketing operations. The idea
96 is to obtain the lock, do some operation and replace the lock again,
97 whether the operation succeeded or failed. We also want to handle the
98 case where the thread receives an exception while processing the IO
99 operation: in these cases we also want to relinquish the lock.
101 There are three versions of @withHandle@: corresponding to the three
102 possible combinations of:
104 - the operation may side-effect the handle
105 - the operation may return a result
107 If the operation generates an error or an exception is raised, the
108 orignal handle is always replaced [ this is the case at the moment,
109 but we might want to revisit this in the future --SDM ].
112 #ifdef __CONCURRENT_HASKELL__
113 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
114 withHandle (Handle h) act = do
116 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
120 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
121 withHandle_ (Handle h) act = do
123 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
127 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
128 withHandle__ (Handle h) act = do
130 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
135 -- of questionable value to install this exception
136 -- handler, but let's do it in the non-concurrent
137 -- case too, for now.
138 withHandle (Handle h) act = do
139 h_ <- stToIO (readVar h)
140 v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
146 nullFile__ is only used for closed handles, plugging it in as a null
147 file object reference.
150 nullFile__ :: FILE_OBJECT
152 #ifndef __PARALLEL_HASKELL__
153 unsafePerformIO (makeForeignObj nullAddr)
159 mkClosedHandle__ :: Handle__
167 mkErrorHandle__ :: IOError -> Handle__
168 mkErrorHandle__ ioe =
176 %*********************************************************
178 \subsection{Handle Finalizers}
180 %*********************************************************
183 foreign import "libHS_cbits" "freeStdFileObject" unsafe
184 freeStdFileObject :: FILE_OBJECT -> IO ()
185 foreign import "libHS_cbits" "freeFileObject" unsafe
186 freeFileObject :: FILE_OBJECT -> IO ()
190 %*********************************************************
192 \subsection[StdHandles]{Standard handles}
194 %*********************************************************
196 Three handles are allocated during program initialisation. The first
197 two manage input or output from the Haskell program's standard input
198 or output channel respectively. The third manages output to the
199 standard error channel. These handles are initially open.
203 stdin, stdout, stderr :: Handle
205 stdout = unsafePerformIO (do
206 rc <- getLock (1::Int) (1::Int) -- ConcHask: SAFE, won't block
208 0 -> newHandle (mkClosedHandle__)
210 fo <- openStdFile (1::Int)
211 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
213 #ifndef __PARALLEL_HASKELL__
214 fo <- makeForeignObj fo
215 addForeignFinalizer fo (freeStdFileObject fo)
219 /* I dont care what the Haskell report says, in an interactive system,
220 * stdout should be unbuffered by default.
224 (bm, bf_size) <- getBMode__ fo
225 mkBuffer__ fo bf_size
227 newHandle (Handle__ fo WriteHandle bm "stdout")
228 _ -> do ioError <- constructError "stdout"
229 newHandle (mkErrorHandle__ ioError)
232 stdin = unsafePerformIO (do
233 rc <- getLock (0::Int) (0::Int) -- ConcHask: SAFE, won't block
235 0 -> newHandle (mkClosedHandle__)
237 fo <- openStdFile (0::Int)
238 (1::Int){-readable-} -- ConcHask: SAFE, won't block
240 #ifndef __PARALLEL_HASKELL__
241 fo <- makeForeignObj fo
242 addForeignFinalizer fo (freeStdFileObject fo)
244 (bm, bf_size) <- getBMode__ fo
245 mkBuffer__ fo bf_size
246 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
247 -- when stdin and stdout are both connected to a terminal, ensure
248 -- that anything buffered on stdout is flushed prior to reading from stdin.
250 hConnectTerms stdout hdl
252 _ -> do ioError <- constructError "stdin"
253 newHandle (mkErrorHandle__ ioError)
257 stderr = unsafePerformIO (do
258 rc <- getLock (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
260 0 -> newHandle (mkClosedHandle__)
262 fo <- openStdFile (2::Int)
263 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
265 #ifndef __PARALLEL_HASKELL__
266 fo <- makeForeignObj fo
267 addForeignFinalizer fo (freeStdFileObject fo)
269 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
270 -- when stderr and stdout are both connected to a terminal, ensure
271 -- that anything buffered on stdout is flushed prior to writing to
273 hConnectTo stdout hdl
276 _ -> do ioError <- constructError "stderr"
277 newHandle (mkErrorHandle__ ioError)
281 %*********************************************************
283 \subsection[OpeningClosing]{Opening and Closing Files}
285 %*********************************************************
288 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
289 deriving (Eq, Ord, Ix, Enum, Read, Show)
294 deriving (Eq, Read, Show)
296 openFile :: FilePath -> IOMode -> IO Handle
297 openFile fp im = openFileEx fp (TextMode im)
299 openFileEx :: FilePath -> IOModeEx -> IO Handle
302 fo <- primOpenFile (packString f)
304 (binary::Int) -- ConcHask: SAFE, won't block
305 if fo /= nullAddr then do
306 #ifndef __PARALLEL_HASKELL__
307 fo <- makeForeignObj fo
308 addForeignFinalizer fo (freeFileObject fo)
310 (bm, bf_size) <- getBMode__ fo
311 mkBuffer__ fo bf_size
312 newHandle (Handle__ fo htype bm f)
314 constructErrorAndFailWithInfo "openFile" f
318 BinaryMode bmo -> (bmo, 1)
319 TextMode tmo -> (tmo, 0)
329 ReadMode -> ReadHandle
330 WriteMode -> WriteHandle
331 AppendMode -> AppendHandle
332 ReadWriteMode -> ReadWriteHandle
335 Computation $openFile file mode$ allocates and returns a new, open
336 handle to manage the file {\em file}. It manages input if {\em mode}
337 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
338 and both input and output if mode is $ReadWriteMode$.
340 If the file does not exist and it is opened for output, it should be
341 created as a new file. If {\em mode} is $WriteMode$ and the file
342 already exists, then it should be truncated to zero length. The
343 handle is positioned at the end of the file if {\em mode} is
344 $AppendMode$, and otherwise at the beginning (in which case its
345 internal position is 0).
347 Implementations should enforce, locally to the Haskell process,
348 multiple-reader single-writer locking on files, which is to say that
349 there may either be many handles on the same file which manage input,
350 or just one handle on the file which manages output. If any open or
351 semi-closed handle is managing a file for output, no new handle can be
352 allocated for that file. If any open or semi-closed handle is
353 managing a file for input, new handles can only be allocated if they
354 do not manage output.
356 Two files are the same if they have the same absolute name. An
357 implementation is free to impose stricter conditions.
360 hClose :: Handle -> IO ()
363 withHandle__ handle $ \ handle_ -> do
364 case haType__ handle_ of
365 ErrorHandle theError -> ioError theError
366 ClosedHandle -> return handle_
368 rc <- closeFile (haFO__ handle_)
369 (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
370 {- We explicitly close a file object so that we can be told
371 if there were any errors. Note that after @hClose@
372 has been performed, the ForeignObj embedded in the Handle
373 is still lying around in the heap, so care is taken
374 to avoid closing the file object when the ForeignObj
375 is finalized. (we overwrite the file ptr in the underlying
376 FileObject with a NULL as part of closeFile())
379 then return (handle_{ haType__ = ClosedHandle,
380 haFO__ = nullFile__ })
381 else constructErrorAndFail "hClose"
385 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
386 computation finishes, any items buffered for output and not already
387 sent to the operating system are flushed as for $flush$.
389 %*********************************************************
391 \subsection[FileSize]{Detecting the size of a file}
393 %*********************************************************
396 For a handle {\em hdl} which attached to a physical file, $hFileSize
397 hdl$ returns the size of {\em hdl} in terms of the number of items
398 which can be read from {\em hdl}.
401 hFileSize :: Handle -> IO Integer
403 withHandle_ handle $ \ handle_ -> do
404 case haType__ handle_ of
405 ErrorHandle theError -> ioError theError
406 ClosedHandle -> ioe_closedHandle "hFileSize" handle
407 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
410 mem <- primNewByteArray 8{-sizeof_int64-}
411 rc <- fileSize_int64 (haFO__ handle_) mem -- ConcHask: SAFE, won't block
413 result <- primReadInt64Array mem 0
414 return (primInt64ToInteger result)
416 constructErrorAndFail "hFileSize"
419 -- HACK! We build a unique MP_INT of the right shape to hold
420 -- a single unsigned word, and we let the C routine
421 -- change the data bits
423 case int2Integer# 1# of
425 rc <- fileSize (haFO__ handle_) d -- ConcHask: SAFE, won't block
426 if rc == (0::Int) then
429 constructErrorAndFail "hFileSize"
433 %*********************************************************
435 \subsection[EOF]{Detecting the End of Input}
437 %*********************************************************
440 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
441 @True@ if no further input can be taken from @hdl@ or for a
442 physical file, if the current I/O position is equal to the length of
443 the file. Otherwise, it returns @False@.
446 hIsEOF :: Handle -> IO Bool
448 rc <- mayBlockRead "hIsEOF" handle fileEOF
452 _ -> constructErrorAndFail "hIsEOF"
458 %*********************************************************
460 \subsection[Buffering]{Buffering Operations}
462 %*********************************************************
464 Three kinds of buffering are supported: line-buffering,
465 block-buffering or no-buffering. See @IOBase@ for definition
466 and further explanation of what the type represent.
468 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
469 handle {\em hdl} on subsequent reads and writes.
473 If {\em mode} is @LineBuffering@, line-buffering should be
476 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
477 should be enabled if possible. The size of the buffer is {\em n} items
478 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
480 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
483 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
484 to @NoBuffering@, then any items in the output buffer are written to
485 the device, and any items in the input buffer are discarded. The
486 default buffering mode when a handle is opened is
487 implementation-dependent and may depend on the object which is
488 attached to that handle.
491 hSetBuffering :: Handle -> BufferMode -> IO ()
493 hSetBuffering handle mode =
495 BlockBuffering (Just n)
497 (IOError (Just handle)
500 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
502 withHandle__ handle $ \ handle_ -> do
503 case haType__ handle_ of
504 ErrorHandle theError -> ioError theError
505 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
508 - we flush the old buffer regardless of whether
509 the new buffer could fit the contents of the old buffer
511 - allow a handle's buffering to change even if IO has
512 occurred (ANSI C spec. does not allow this, nor did
513 the previous implementation of IO.hSetBuffering).
514 - a non-standard extension is to allow the buffering
515 of semi-closed handles to change [sof 6/98]
517 let fo = haFO__ handle_
518 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
521 return (handle_{ haBufferMode__ = mode })
523 -- Note: failure to change the buffer size will cause old buffer to be flushed.
524 constructErrorAndFail "hSetBuffering"
530 BlockBuffering Nothing -> -2
531 BlockBuffering (Just n) -> n
534 The action @hFlush hdl@ causes any items buffered for output
535 in handle {\em hdl} to be sent immediately to the operating
539 hFlush :: Handle -> IO ()
541 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
542 let fo = haFO__ handle_
543 rc <- mayBlock fo (flushFile fo) -- ConcHask: UNSAFE, may block
547 constructErrorAndFail "hFlush"
552 %*********************************************************
554 \subsection[Seeking]{Repositioning Handles}
556 %*********************************************************
561 Handle -- Q: should this be a weak or strong ref. to the handle?
562 -- [what's the winning argument for it not being strong? --sof]
565 instance Eq HandlePosn where
566 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
568 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
569 -- We represent it as an Integer on the Haskell side, but
570 -- cheat slightly in that hGetPosn calls upon a C helper
571 -- that reports the position back via (merely) an Int.
572 type HandlePosition = Integer
574 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
575 mkHandlePosn h p = HandlePosn h p
577 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
578 deriving (Eq, Ord, Ix, Enum, Read, Show)
581 Computation @hGetPosn hdl@ returns the current I/O
582 position of {\em hdl} as an abstract position. Computation
583 $hSetPosn p$ sets the position of {\em hdl}
584 to a previously obtained position {\em p}.
587 hGetPosn :: Handle -> IO HandlePosn
589 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
590 posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block
591 if posn /= -1 then do
592 return (mkHandlePosn handle (fromInt posn))
594 constructErrorAndFail "hGetPosn"
596 hSetPosn :: HandlePosn -> IO ()
597 hSetPosn (HandlePosn handle i@(S# _)) = hSetPosn (HandlePosn handle (toBig i))
598 hSetPosn (HandlePosn handle (J# s# d#)) =
599 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
600 -- not as silly as it looks: the handle may have been closed in the meantime.
601 let fo = haFO__ handle_
602 rc <- mayBlock fo (setFilePosn fo (I# s#) d#) -- ConcHask: UNSAFE, may block
606 constructErrorAndFail "hSetPosn"
609 The action @hSeek hdl mode i@ sets the position of handle
610 @hdl@ depending on @mode@. If @mode@ is
612 * AbsoluteSeek - The position of @hdl@ is set to @i@.
613 * RelativeSeek - The position of @hdl@ is set to offset @i@ from
614 the current position.
615 * SeekFromEnd - The position of @hdl@ is set to offset @i@ from
618 Some handles may not be seekable (see @hIsSeekable@), or only
619 support a subset of the possible positioning operations (e.g. it may
620 only be possible to seek to the end of a tape, or to a positive
621 offset from the beginning or current position).
623 It is not possible to set a negative I/O position, or for a physical
624 file, an I/O position beyond the current end-of-file.
627 - when seeking using @SeekFromEnd@, positive offsets (>=0) means
628 seeking at or past EOF.
629 - relative seeking on buffered handles can lead to non-obvious results.
632 hSeek :: Handle -> SeekMode -> Integer -> IO ()
634 hSeek handle mode offset =
635 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
636 let fo = haFO__ handle_
637 rc <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
639 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
640 hSeek handle mode (J# s# d#) =
641 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
642 let fo = haFO__ handle_
643 rc <- mayBlock fo (seekFile fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
648 constructErrorAndFail "hSeek"
651 whence = case mode of
657 %*********************************************************
659 \subsection[Query]{Handle Properties}
661 %*********************************************************
663 A number of operations return information about the properties of a
664 handle. Each of these operations returns $True$ if the
665 handle has the specified property, and $False$
668 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
669 {\em hdl} is not block-buffered. Otherwise it returns
670 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
671 $( Just n )$ for block-buffering of {\em n} bytes.
674 hIsOpen :: Handle -> IO Bool
676 withHandle_ handle $ \ handle_ -> do
677 case haType__ handle_ of
678 ErrorHandle theError -> ioError theError
679 ClosedHandle -> return False
680 SemiClosedHandle -> return False
683 hIsClosed :: Handle -> IO Bool
685 withHandle_ handle $ \ handle_ -> do
686 case haType__ handle_ of
687 ErrorHandle theError -> ioError theError
688 ClosedHandle -> return True
691 {- not defined, nor exported, but mentioned
692 here for documentation purposes:
694 hSemiClosed :: Handle -> IO Bool
698 return (not (ho || hc))
701 hIsReadable :: Handle -> IO Bool
703 withHandle_ handle $ \ handle_ -> do
704 case haType__ handle_ of
705 ErrorHandle theError -> ioError theError
706 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
707 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
708 htype -> return (isReadable htype)
710 isReadable ReadHandle = True
711 isReadable ReadWriteHandle = True
714 hIsWritable :: Handle -> IO Bool
716 withHandle_ handle $ \ handle_ -> do
717 case haType__ handle_ of
718 ErrorHandle theError -> ioError theError
719 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
720 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
721 htype -> return (isWritable htype)
723 isWritable AppendHandle = True
724 isWritable WriteHandle = True
725 isWritable ReadWriteHandle = True
729 #ifndef __PARALLEL_HASKELL__
730 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
732 getBMode__ :: Addr -> IO (BufferMode, Int)
735 rc <- getBufferMode fo -- ConcHask: SAFE, won't block
737 0 -> return (NoBuffering, 0)
738 -1 -> return (LineBuffering, default_buffer_size)
739 -2 -> return (BlockBuffering Nothing, default_buffer_size)
740 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
741 n -> return (BlockBuffering (Just n), n)
743 default_buffer_size :: Int
744 default_buffer_size = (const_BUFSIZ - 1)
747 Querying how a handle buffers its data:
750 hGetBuffering :: Handle -> IO BufferMode
751 hGetBuffering handle =
752 withHandle_ handle $ \ handle_ -> do
753 case haType__ handle_ of
754 ErrorHandle theError -> ioError theError
755 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
758 We're being non-standard here, and allow the buffering
759 of a semi-closed handle to be queried. -- sof 6/98
761 return (haBufferMode__ handle_) -- could be stricter..
765 hIsSeekable :: Handle -> IO Bool
767 withHandle_ handle $ \ handle_ -> do
768 case haType__ handle_ of
769 ErrorHandle theError -> ioError theError
770 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
771 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
772 AppendHandle -> return False
774 rc <- seekFileP (haFO__ handle_) -- ConcHask: SAFE, won't block
778 _ -> constructErrorAndFail "hIsSeekable"
782 %*********************************************************
784 \subsection{Changing echo status}
786 %*********************************************************
788 Non-standard GHC extension is to allow the echoing status
789 of a handles connected to terminals to be reconfigured:
792 hSetEcho :: Handle -> Bool -> IO ()
793 hSetEcho handle on = do
794 isT <- hIsTerminalDevice handle
798 withHandle_ handle $ \ handle_ -> do
799 case haType__ handle_ of
800 ErrorHandle theError -> ioError theError
801 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
803 rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
806 else constructErrorAndFail "hSetEcho"
808 hGetEcho :: Handle -> IO Bool
810 isT <- hIsTerminalDevice handle
814 withHandle_ handle $ \ handle_ -> do
815 case haType__ handle_ of
816 ErrorHandle theError -> ioError theError
817 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
819 rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
823 _ -> constructErrorAndFail "hSetEcho"
825 hIsTerminalDevice :: Handle -> IO Bool
826 hIsTerminalDevice handle = do
827 withHandle_ handle $ \ handle_ -> do
828 case haType__ handle_ of
829 ErrorHandle theError -> ioError theError
830 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
832 rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
836 _ -> constructErrorAndFail "hIsTerminalDevice"
840 hConnectTerms :: Handle -> Handle -> IO ()
841 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
843 hConnectTo :: Handle -> Handle -> IO ()
844 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
846 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
847 hConnectHdl_ hW hR is_tty =
848 wantRWHandle "hConnectTo" hW $ \ hW_ ->
849 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
850 setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
852 #ifndef __PARALLEL_HASKELL__
853 #define FILE_OBJECT ForeignObj
855 #define FILE_OBJECT Addr
860 As an extension, we also allow characters to be pushed back.
861 Like ANSI C stdio, we guarantee no more than one character of
862 pushback. (For unbuffered channels, the (default) push-back limit is
866 hUngetChar :: Handle -> Char -> IO ()
867 hUngetChar handle c =
868 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
869 rc <- ungetChar (haFO__ handle_) c -- ConcHask: SAFE, won't block
871 then constructErrorAndFail "hUngetChar"
877 Hoisting files in in one go is sometimes useful, so we support
878 this as an extension:
881 -- in one go, read file into an externally allocated buffer.
882 slurpFile :: FilePath -> IO (Addr, Int)
884 handle <- openFile fname ReadMode
885 sz <- hFileSize handle
886 if sz > toInteger (maxBound::Int) then
887 ioError (userError "slurpFile: file too big")
889 let sz_i = fromInteger sz
890 chunk <- allocMemory__ sz_i
894 constructErrorAndFail "slurpFile"
896 rc <- withHandle_ handle ( \ handle_ -> do
897 let fo = haFO__ handle_
898 mayBlock fo (readChunk fo chunk 0 sz_i) -- ConcHask: UNSAFE, may block.
902 then constructErrorAndFail "slurpFile"
903 else return (chunk, rc)
905 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
906 hFillBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
907 hFillBufBA handle buf sz
908 | sz <= 0 = ioError (IOError (Just handle)
911 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
912 | otherwise = hFillBuf' sz 0
914 hFillBuf' sz len = do
915 r <- mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf len sz)
916 if r >= sz || r == 0 -- r == 0 indicates EOF
918 else hFillBuf' (sz-r) (len+r)
921 hFillBuf :: Handle -> Addr -> Int -> IO Int
922 hFillBuf handle buf sz
923 | sz <= 0 = ioError (IOError (Just handle)
926 ("illegal buffer size " ++ showsPrec 9 sz []))
927 -- 9 => should be parens'ified.
928 | otherwise = hFillBuf' sz 0
930 hFillBuf' sz len = do
931 r <- mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf len sz)
932 if r >= sz || r == 0 -- r == 0 indicates EOF
934 else hFillBuf' (sz-r) (len+r)
937 The @hPutBuf hdl buf len@ action writes an already packed sequence of
938 bytes to the file/channel managed by @hdl@ - non-standard.
941 hPutBuf :: Handle -> Addr -> Int -> IO ()
942 hPutBuf handle buf sz
943 | sz <= 0 = ioError (IOError (Just handle)
946 ("illegal buffer size " ++ showsPrec 9 sz []))
947 -- 9 => should be parens'ified.
948 | otherwise = hPutBuf' sz 0
951 r <- mayBlockWrite "hPutBuf" handle (\fo -> writeBuf fo buf len sz)
954 else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
956 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
957 hPutBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO ()
958 hPutBufBA handle buf sz
959 | sz <= 0 = ioError (IOError (Just handle)
962 ("illegal buffer size " ++ showsPrec 9 sz []))
963 -- 9 => should be parens'ified.
964 | otherwise = hPutBuf' sz 0
967 r <- mayBlockWrite "hPutBufBA" handle (\fo -> writeBufBA fo buf len sz)
970 else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
974 Sometimes it's useful to get at the file descriptor that
975 the Handle contains..
978 getHandleFd :: Handle -> IO Int
980 withHandle_ handle $ \ handle_ -> do
981 case (haType__ handle_) of
982 ErrorHandle theError -> ioError theError
983 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
985 fd <- getFileFd (haFO__ handle_)
990 %*********************************************************
992 \subsection{Miscellaneous}
994 %*********************************************************
996 These three functions are meant to get things out of @IOErrors@.
1001 ioeGetFileName :: IOError -> Maybe FilePath
1002 ioeGetErrorString :: IOError -> String
1003 ioeGetHandle :: IOError -> Maybe Handle
1005 ioeGetHandle (IOError h _ _ _) = h
1006 ioeGetErrorString (IOError _ iot _ str) =
1008 EOF -> "end of file"
1011 ioeGetFileName (IOError _ _ _ str) =
1012 case span (/=':') str of
1018 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
1019 PrelMain.mainIO) and report them - topHandler is the exception
1020 handler they should use for this:
1023 -- make sure we handle errors while reporting the error!
1024 -- (e.g. evaluating the string passed to 'error' might generate
1025 -- another error, etc.)
1026 topHandler :: Bool -> Exception -> IO ()
1027 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1029 real_handler :: Bool -> Exception -> IO ()
1030 real_handler bombOut ex =
1032 AsyncException StackOverflow -> reportStackOverflow bombOut
1033 ErrorCall s -> reportError bombOut s
1034 other -> reportError bombOut (showsPrec 0 other "\n")
1036 reportStackOverflow :: Bool -> IO ()
1037 reportStackOverflow bombOut = do
1038 (hFlush stdout) `catchException` (\ _ -> return ())
1039 callStackOverflowHook
1045 reportError :: Bool -> String -> IO ()
1046 reportError bombOut str = do
1047 (hFlush stdout) `catchException` (\ _ -> return ())
1048 let bs@(ByteArray _ len _) = packString str
1049 writeErrString addrOf_ErrorHdrHook bs len
1055 foreign label "ErrorHdrHook"
1056 addrOf_ErrorHdrHook :: Addr
1058 foreign import ccall "writeErrString__" unsafe
1059 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1061 foreign import ccall "stackOverflow"
1062 callStackOverflowHook :: IO ()
1064 foreign import ccall "stg_exit"
1065 stg_exit :: Int -> IO ()
1069 A number of operations want to get at a readable or writeable handle, and fail
1073 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1074 wantReadableHandle fun handle act =
1075 withHandle_ handle $ \ handle_ -> do
1076 case haType__ handle_ of
1077 ErrorHandle theError -> ioError theError
1078 ClosedHandle -> ioe_closedHandle fun handle
1079 SemiClosedHandle -> ioe_closedHandle fun handle
1080 AppendHandle -> ioError not_readable_error
1081 WriteHandle -> ioError not_readable_error
1084 not_readable_error =
1085 IOError (Just handle) IllegalOperation fun
1086 ("handle is not open for reading")
1088 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1089 wantWriteableHandle fun handle act =
1090 withHandle_ handle $ \ handle_ -> do
1091 case haType__ handle_ of
1092 ErrorHandle theError -> ioError theError
1093 ClosedHandle -> ioe_closedHandle fun handle
1094 SemiClosedHandle -> ioe_closedHandle fun handle
1095 ReadHandle -> ioError not_writeable_error
1098 not_writeable_error =
1099 IOError (Just handle) IllegalOperation fun
1100 ("handle is not open for writing")
1102 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1103 wantRWHandle fun handle act =
1104 withHandle_ handle $ \ handle_ -> do
1105 case haType__ handle_ of
1106 ErrorHandle theError -> ioError theError
1107 ClosedHandle -> ioe_closedHandle fun handle
1108 SemiClosedHandle -> ioe_closedHandle fun handle
1111 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1112 wantSeekableHandle fun handle act =
1113 withHandle_ handle $ \ handle_ -> do
1114 case haType__ handle_ of
1115 ErrorHandle theError -> ioError theError
1116 ClosedHandle -> ioe_closedHandle fun handle
1117 SemiClosedHandle -> ioe_closedHandle fun handle
1120 not_seekable_error =
1121 IOError (Just handle)
1122 IllegalOperation fun
1123 ("handle is not seekable")
1127 Internal function for creating an @IOError@ representing the
1128 access to a closed file.
1131 ioe_closedHandle :: String -> Handle -> IO a
1132 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1135 Internal helper functions for Concurrent Haskell implementation
1139 #ifndef __PARALLEL_HASKELL__
1140 mayBlock :: ForeignObj -> IO Int -> IO Int
1142 mayBlock :: Addr -> IO Int -> IO Int
1145 mayBlock fo act = do
1148 -5 -> do -- (possibly blocking) read
1151 mayBlock fo act -- input available, re-try
1152 -6 -> do -- (possibly blocking) write
1155 mayBlock fo act -- output possible
1156 -7 -> do -- (possibly blocking) write on connected handle
1157 fd <- getConnFileFd fo
1159 mayBlock fo act -- output possible
1168 mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
1169 mayBlockRead fname handle fn = do
1170 r <- wantReadableHandle fname handle $ \ handle_ -> do
1171 let fo = haFO__ handle_
1174 -5 -> do -- (possibly blocking) read
1176 return (BlockRead fd)
1177 -6 -> do -- (possibly blocking) write
1179 return (BlockWrite fd)
1180 -7 -> do -- (possibly blocking) write on connected handle
1181 fd <- getConnFileFd fo
1182 return (BlockWrite fd)
1185 then return (NoBlock rc)
1186 else constructErrorAndFail fname
1190 mayBlockRead fname handle fn
1193 mayBlockRead fname handle fn
1194 NoBlock c -> return c
1196 mayBlockWrite :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
1197 mayBlockWrite fname handle fn = do
1198 r <- wantWriteableHandle fname handle $ \ handle_ -> do
1199 let fo = haFO__ handle_
1202 -5 -> do -- (possibly blocking) read
1204 return (BlockRead fd)
1205 -6 -> do -- (possibly blocking) write
1207 return (BlockWrite fd)
1208 -7 -> do -- (possibly blocking) write on connected handle
1209 fd <- getConnFileFd fo
1210 return (BlockWrite fd)
1213 then return (NoBlock rc)
1214 else constructErrorAndFail fname
1218 mayBlockWrite fname handle fn
1221 mayBlockWrite fname handle fn
1222 NoBlock c -> return c
1225 Foreign import declarations of helper functions:
1230 type Bytes = PrimByteArray RealWorld
1232 type Bytes = ByteArray#
1235 foreign import "libHS_cbits" "inputReady" unsafe
1236 inputReady :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1237 foreign import "libHS_cbits" "fileGetc" unsafe
1238 fileGetc :: FILE_OBJECT -> IO Int
1239 foreign import "libHS_cbits" "fileLookAhead" unsafe
1240 fileLookAhead :: FILE_OBJECT -> IO Int
1241 foreign import "libHS_cbits" "readBlock" unsafe
1242 readBlock :: FILE_OBJECT -> IO Int
1243 foreign import "libHS_cbits" "readLine" unsafe
1244 readLine :: FILE_OBJECT -> IO Int
1245 foreign import "libHS_cbits" "readChar" unsafe
1246 readChar :: FILE_OBJECT -> IO Int
1247 foreign import "libHS_cbits" "writeFileObject" unsafe
1248 writeFileObject :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1249 foreign import "libHS_cbits" "filePutc" unsafe
1250 filePutc :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1251 foreign import "libHS_cbits" "getBufStart" unsafe
1252 getBufStart :: FILE_OBJECT -> Int -> IO Addr
1253 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1254 getWriteableBuf :: FILE_OBJECT -> IO Addr
1255 foreign import "libHS_cbits" "getBufWPtr" unsafe
1256 getBufWPtr :: FILE_OBJECT -> IO Int
1257 foreign import "libHS_cbits" "setBufWPtr" unsafe
1258 setBufWPtr :: FILE_OBJECT -> Int -> IO ()
1259 foreign import "libHS_cbits" "closeFile" unsafe
1260 closeFile :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1261 foreign import "libHS_cbits" "fileEOF" unsafe
1262 fileEOF :: FILE_OBJECT -> IO Int{-ret code-}
1263 foreign import "libHS_cbits" "setBuffering" unsafe
1264 setBuffering :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1265 foreign import "libHS_cbits" "flushFile" unsafe
1266 flushFile :: FILE_OBJECT -> IO Int{-ret code-}
1267 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1268 flushConnectedBuf :: FILE_OBJECT -> IO ()
1269 foreign import "libHS_cbits" "getBufferMode" unsafe
1270 getBufferMode :: FILE_OBJECT -> IO Int{-ret code-}
1272 foreign import "libHS_cbits" "seekFile_int64" unsafe
1273 seekFile :: FILE_OBJECT -> Int -> Int64 -> IO Int
1275 foreign import "libHS_cbits" "seekFile" unsafe
1276 seekFile :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1279 foreign import "libHS_cbits" "seekFileP" unsafe
1280 seekFileP :: FILE_OBJECT -> IO Int{-ret code-}
1281 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1282 setTerminalEcho :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1283 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1284 getTerminalEcho :: FILE_OBJECT -> IO Int{-ret code-}
1285 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1286 isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1287 foreign import "libHS_cbits" "setConnectedTo" unsafe
1288 setConnectedTo :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1289 foreign import "libHS_cbits" "ungetChar" unsafe
1290 ungetChar :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1291 foreign import "libHS_cbits" "readChunk" unsafe
1292 readChunk :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1293 foreign import "libHS_cbits" "readChunk" unsafe
1294 readChunkBA :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1295 foreign import "libHS_cbits" "writeBuf" unsafe
1296 writeBuf :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1298 foreign import "libHS_cbits" "writeBufBA" unsafe
1299 writeBufBA :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1301 foreign import "libHS_cbits" "getFileFd" unsafe
1302 getFileFd :: FILE_OBJECT -> IO Int{-fd-}
1304 foreign import "libHS_cbits" "fileSize_int64" unsafe
1305 fileSize_int64 :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1307 foreign import "libHS_cbits" "fileSize" unsafe
1308 fileSize :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1311 foreign import "libHS_cbits" "getFilePosn" unsafe
1312 getFilePosn :: FILE_OBJECT -> IO Int
1313 foreign import "libHS_cbits" "setFilePosn" unsafe
1314 setFilePosn :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1315 foreign import "libHS_cbits" "getConnFileFd" unsafe
1316 getConnFileFd :: FILE_OBJECT -> IO Int{-fd-}
1317 foreign import "libHS_cbits" "getLock" unsafe
1318 getLock :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1319 foreign import "libHS_cbits" "openStdFile" unsafe
1320 openStdFile :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1321 foreign import "libHS_cbits" "openFile" unsafe
1322 primOpenFile :: ByteArray Int{-CString-}
1325 -> IO Addr {-file obj-}
1326 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1329 foreign import "libHS_cbits" "setBinaryMode__"
1330 setBinaryMode :: FILE_OBJECT -> Int -> IO Int