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 -fcompiling-prelude -fno-implicit-prelude -#include "cbits/stgio.h" #-}
12 #include "cbits/stgerror.h"
14 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
15 module PrelHandle where
19 import PrelAddr ( Addr, nullAddr )
20 import PrelByteArr ( ByteArray(..), MutableByteArray(..) )
21 import PrelRead ( Read )
22 import PrelList ( span )
25 import PrelMaybe ( Maybe(..) )
27 import PrelNum ( toBig, Integer(..), Num(..) )
29 import PrelAddr ( Addr, nullAddr )
30 import PrelReal ( toInteger )
31 import PrelPack ( packString )
32 #ifndef __PARALLEL_HASKELL__
33 import PrelWeak ( addForeignFinalizer )
38 #ifndef __PARALLEL_HASKELL__
39 import PrelForeign ( makeForeignObj )
42 #endif /* ndef(__HUGS__) */
45 #define __CONCURRENT_HASKELL__
49 #ifndef __PARALLEL_HASKELL__
50 #define FILE_OBJECT ForeignObj
52 #define FILE_OBJECT Addr
56 %*********************************************************
58 \subsection{Types @Handle@, @Handle__@}
60 %*********************************************************
62 The @Handle@ and @Handle__@ types are defined in @IOBase@.
65 {-# INLINE newHandle #-}
66 newHandle :: Handle__ -> IO Handle
68 -- Use MVars for concurrent Haskell
69 newHandle hc = newMVar hc >>= \ h ->
73 %*********************************************************
75 \subsection{@withHandle@ operations}
77 %*********************************************************
79 In the concurrent world, handles are locked during use. This is done
80 by wrapping an MVar around the handle which acts as a mutex over
81 operations on the handle.
83 To avoid races, we use the following bracketing operations. The idea
84 is to obtain the lock, do some operation and replace the lock again,
85 whether the operation succeeded or failed. We also want to handle the
86 case where the thread receives an exception while processing the IO
87 operation: in these cases we also want to relinquish the lock.
89 There are three versions of @withHandle@: corresponding to the three
90 possible combinations of:
92 - the operation may side-effect the handle
93 - the operation may return a result
95 If the operation generates an error or an exception is raised, the
96 orignal handle is always replaced [ this is the case at the moment,
97 but we might want to revisit this in the future --SDM ].
100 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
101 {-# INLINE withHandle #-}
102 withHandle (Handle h) act = do
104 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
108 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
109 {-# INLINE withHandle_ #-}
110 withHandle_ (Handle h) act = do
112 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
116 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
117 {-# INLINE withHandle__ #-}
118 withHandle__ (Handle h) act = do
120 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
125 nullFile__ is only used for closed handles, plugging it in as a null
126 file object reference.
129 nullFile__ :: FILE_OBJECT
131 #ifndef __PARALLEL_HASKELL__
132 unsafePerformIO (makeForeignObj nullAddr (return ()))
138 mkClosedHandle__ :: Handle__
146 mkErrorHandle__ :: IOError -> Handle__
147 mkErrorHandle__ ioe =
155 %*********************************************************
157 \subsection{Handle Finalizers}
159 %*********************************************************
162 foreign import "libHS_cbits" "freeStdFileObject" unsafe
163 freeStdFileObject :: Addr -> IO ()
164 foreign import "libHS_cbits" "freeFileObject" unsafe
165 freeFileObject :: Addr -> IO ()
169 %*********************************************************
171 \subsection[StdHandles]{Standard handles}
173 %*********************************************************
175 Three handles are allocated during program initialisation. The first
176 two manage input or output from the Haskell program's standard input
177 or output channel respectively. The third manages output to the
178 standard error channel. These handles are initially open.
182 stdin, stdout, stderr :: Handle
184 stdout = unsafePerformIO (do
185 rc <- getLock (1::Int) (1::Int) -- ConcHask: SAFE, won't block
187 0 -> newHandle (mkClosedHandle__)
189 fo <- openStdFile (1::Int)
190 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
192 #ifndef __PARALLEL_HASKELL__
193 fo <- makeForeignObj fo (freeStdFileObject fo)
197 /* I dont care what the Haskell report says, in an interactive system,
198 * stdout should be unbuffered by default.
202 (bm, bf_size) <- getBMode__ fo
203 mkBuffer__ fo bf_size
205 newHandle (Handle__ fo WriteHandle bm "stdout")
206 _ -> do ioError <- constructError "stdout"
207 newHandle (mkErrorHandle__ ioError)
210 stdin = unsafePerformIO (do
211 rc <- getLock (0::Int) (0::Int) -- ConcHask: SAFE, won't block
213 0 -> newHandle (mkClosedHandle__)
215 fo <- openStdFile (0::Int)
216 (1::Int){-readable-} -- ConcHask: SAFE, won't block
218 #ifndef __PARALLEL_HASKELL__
219 fo <- makeForeignObj fo (freeStdFileObject fo)
221 (bm, bf_size) <- getBMode__ fo
222 mkBuffer__ fo bf_size
223 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
224 -- when stdin and stdout are both connected to a terminal, ensure
225 -- that anything buffered on stdout is flushed prior to reading from stdin.
227 hConnectTerms stdout hdl
229 _ -> do ioError <- constructError "stdin"
230 newHandle (mkErrorHandle__ ioError)
234 stderr = unsafePerformIO (do
235 rc <- getLock (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
237 0 -> newHandle (mkClosedHandle__)
239 fo <- openStdFile (2::Int)
240 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
242 #ifndef __PARALLEL_HASKELL__
243 fo <- makeForeignObj fo (freeStdFileObject fo)
245 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
246 -- when stderr and stdout are both connected to a terminal, ensure
247 -- that anything buffered on stdout is flushed prior to writing to
249 hConnectTo stdout hdl
252 _ -> do ioError <- constructError "stderr"
253 newHandle (mkErrorHandle__ ioError)
257 %*********************************************************
259 \subsection[OpeningClosing]{Opening and Closing Files}
261 %*********************************************************
264 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
265 deriving (Eq, Ord, Ix, Enum, Read, Show)
270 deriving (Eq, Read, Show)
272 openFile :: FilePath -> IOMode -> IO Handle
273 openFile fp im = openFileEx fp (TextMode im)
275 openFileEx :: FilePath -> IOModeEx -> IO Handle
278 fo <- primOpenFile (packString f)
280 (binary::Int) -- ConcHask: SAFE, won't block
281 if fo /= nullAddr then do
282 #ifndef __PARALLEL_HASKELL__
283 fo <- makeForeignObj fo (freeFileObject fo)
285 (bm, bf_size) <- getBMode__ fo
286 mkBuffer__ fo bf_size
287 newHandle (Handle__ fo htype bm f)
289 constructErrorAndFailWithInfo "openFile" f
293 BinaryMode bmo -> (bmo, 1)
294 TextMode tmo -> (tmo, 0)
304 ReadMode -> ReadHandle
305 WriteMode -> WriteHandle
306 AppendMode -> AppendHandle
307 ReadWriteMode -> ReadWriteHandle
310 Computation $openFile file mode$ allocates and returns a new, open
311 handle to manage the file {\em file}. It manages input if {\em mode}
312 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
313 and both input and output if mode is $ReadWriteMode$.
315 If the file does not exist and it is opened for output, it should be
316 created as a new file. If {\em mode} is $WriteMode$ and the file
317 already exists, then it should be truncated to zero length. The
318 handle is positioned at the end of the file if {\em mode} is
319 $AppendMode$, and otherwise at the beginning (in which case its
320 internal position is 0).
322 Implementations should enforce, locally to the Haskell process,
323 multiple-reader single-writer locking on files, which is to say that
324 there may either be many handles on the same file which manage input,
325 or just one handle on the file which manages output. If any open or
326 semi-closed handle is managing a file for output, no new handle can be
327 allocated for that file. If any open or semi-closed handle is
328 managing a file for input, new handles can only be allocated if they
329 do not manage output.
331 Two files are the same if they have the same absolute name. An
332 implementation is free to impose stricter conditions.
335 hClose :: Handle -> IO ()
338 withHandle__ handle $ \ handle_ -> do
339 case haType__ handle_ of
340 ErrorHandle theError -> ioError theError
341 ClosedHandle -> return handle_
343 rc <- closeFile (haFO__ handle_)
344 (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
345 {- We explicitly close a file object so that we can be told
346 if there were any errors. Note that after @hClose@
347 has been performed, the ForeignObj embedded in the Handle
348 is still lying around in the heap, so care is taken
349 to avoid closing the file object when the ForeignObj
350 is finalized. (we overwrite the file ptr in the underlying
351 FileObject with a NULL as part of closeFile())
354 then return (handle_{ haType__ = ClosedHandle,
355 haFO__ = nullFile__ })
356 else constructErrorAndFail "hClose"
360 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
361 computation finishes, any items buffered for output and not already
362 sent to the operating system are flushed as for $flush$.
364 %*********************************************************
366 \subsection[FileSize]{Detecting the size of a file}
368 %*********************************************************
371 For a handle {\em hdl} which attached to a physical file, $hFileSize
372 hdl$ returns the size of {\em hdl} in terms of the number of items
373 which can be read from {\em hdl}.
376 hFileSize :: Handle -> IO Integer
378 withHandle_ handle $ \ handle_ -> do
379 case haType__ handle_ of
380 ErrorHandle theError -> ioError theError
381 ClosedHandle -> ioe_closedHandle "hFileSize" handle
382 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
385 mem <- primNewByteArray 8{-sizeof_int64-}
386 rc <- fileSize_int64 (haFO__ handle_) mem -- ConcHask: SAFE, won't block
388 result <- primReadInt64Array mem 0
389 return (primInt64ToInteger result)
391 constructErrorAndFail "hFileSize"
394 -- HACK! We build a unique MP_INT of the right shape to hold
395 -- a single unsigned word, and we let the C routine
396 -- change the data bits
398 case int2Integer# 1# of
400 rc <- fileSize (haFO__ handle_) d -- ConcHask: SAFE, won't block
401 if rc == (0::Int) then
404 constructErrorAndFail "hFileSize"
408 %*********************************************************
410 \subsection[EOF]{Detecting the End of Input}
412 %*********************************************************
415 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
416 @True@ if no further input can be taken from @hdl@ or for a
417 physical file, if the current I/O position is equal to the length of
418 the file. Otherwise, it returns @False@.
421 hIsEOF :: Handle -> IO Bool
423 rc <- mayBlockRead "hIsEOF" handle fileEOF
427 _ -> constructErrorAndFail "hIsEOF"
433 %*********************************************************
435 \subsection[Buffering]{Buffering Operations}
437 %*********************************************************
439 Three kinds of buffering are supported: line-buffering,
440 block-buffering or no-buffering. See @IOBase@ for definition
441 and further explanation of what the type represent.
443 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
444 handle {\em hdl} on subsequent reads and writes.
448 If {\em mode} is @LineBuffering@, line-buffering should be
451 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
452 should be enabled if possible. The size of the buffer is {\em n} items
453 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
455 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
458 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
459 to @NoBuffering@, then any items in the output buffer are written to
460 the device, and any items in the input buffer are discarded. The
461 default buffering mode when a handle is opened is
462 implementation-dependent and may depend on the object which is
463 attached to that handle.
466 hSetBuffering :: Handle -> BufferMode -> IO ()
468 hSetBuffering handle mode =
470 BlockBuffering (Just n)
472 (IOError (Just handle)
475 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
477 withHandle__ handle $ \ handle_ -> do
478 case haType__ handle_ of
479 ErrorHandle theError -> ioError theError
480 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
483 - we flush the old buffer regardless of whether
484 the new buffer could fit the contents of the old buffer
486 - allow a handle's buffering to change even if IO has
487 occurred (ANSI C spec. does not allow this, nor did
488 the previous implementation of IO.hSetBuffering).
489 - a non-standard extension is to allow the buffering
490 of semi-closed handles to change [sof 6/98]
492 let fo = haFO__ handle_
493 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
496 return (handle_{ haBufferMode__ = mode })
498 -- Note: failure to change the buffer size will cause old buffer to be flushed.
499 constructErrorAndFail "hSetBuffering"
505 BlockBuffering Nothing -> -2
506 BlockBuffering (Just n) -> n
509 The action @hFlush hdl@ causes any items buffered for output
510 in handle {\em hdl} to be sent immediately to the operating
514 hFlush :: Handle -> IO ()
516 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
517 let fo = haFO__ handle_
518 rc <- mayBlock fo (flushFile fo) -- ConcHask: UNSAFE, may block
522 constructErrorAndFail "hFlush"
527 %*********************************************************
529 \subsection[Seeking]{Repositioning Handles}
531 %*********************************************************
536 Handle -- Q: should this be a weak or strong ref. to the handle?
537 -- [what's the winning argument for it not being strong? --sof]
540 instance Eq HandlePosn where
541 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
543 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
544 -- We represent it as an Integer on the Haskell side, but
545 -- cheat slightly in that hGetPosn calls upon a C helper
546 -- that reports the position back via (merely) an Int.
547 type HandlePosition = Integer
549 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
550 mkHandlePosn h p = HandlePosn h p
552 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
553 deriving (Eq, Ord, Ix, Enum, Read, Show)
556 Computation @hGetPosn hdl@ returns the current I/O
557 position of {\em hdl} as an abstract position. Computation
558 $hSetPosn p$ sets the position of {\em hdl}
559 to a previously obtained position {\em p}.
562 hGetPosn :: Handle -> IO HandlePosn
564 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
565 posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block
566 if posn /= -1 then do
567 return (mkHandlePosn handle (fromInt posn))
569 constructErrorAndFail "hGetPosn"
571 hSetPosn :: HandlePosn -> IO ()
572 hSetPosn (HandlePosn handle i@(S# _)) = hSetPosn (HandlePosn handle (toBig i))
573 hSetPosn (HandlePosn handle (J# s# d#)) =
574 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
575 -- not as silly as it looks: the handle may have been closed in the meantime.
576 let fo = haFO__ handle_
577 rc <- mayBlock fo (setFilePosn fo (I# s#) d#) -- ConcHask: UNSAFE, may block
581 constructErrorAndFail "hSetPosn"
584 The action @hSeek hdl mode i@ sets the position of handle
585 @hdl@ depending on @mode@. If @mode@ is
587 * AbsoluteSeek - The position of @hdl@ is set to @i@.
588 * RelativeSeek - The position of @hdl@ is set to offset @i@ from
589 the current position.
590 * SeekFromEnd - The position of @hdl@ is set to offset @i@ from
593 Some handles may not be seekable (see @hIsSeekable@), or only
594 support a subset of the possible positioning operations (e.g. it may
595 only be possible to seek to the end of a tape, or to a positive
596 offset from the beginning or current position).
598 It is not possible to set a negative I/O position, or for a physical
599 file, an I/O position beyond the current end-of-file.
602 - when seeking using @SeekFromEnd@, positive offsets (>=0) means
603 seeking at or past EOF.
604 - relative seeking on buffered handles can lead to non-obvious results.
607 hSeek :: Handle -> SeekMode -> Integer -> IO ()
609 hSeek handle mode offset =
610 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
611 let fo = haFO__ handle_
612 rc <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
614 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
615 hSeek handle mode (J# s# d#) =
616 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
617 let fo = haFO__ handle_
618 rc <- mayBlock fo (seekFile fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
623 constructErrorAndFail "hSeek"
626 whence = case mode of
632 %*********************************************************
634 \subsection[Query]{Handle Properties}
636 %*********************************************************
638 A number of operations return information about the properties of a
639 handle. Each of these operations returns $True$ if the
640 handle has the specified property, and $False$
643 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
644 {\em hdl} is not block-buffered. Otherwise it returns
645 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
646 $( Just n )$ for block-buffering of {\em n} bytes.
649 hIsOpen :: Handle -> IO Bool
651 withHandle_ handle $ \ handle_ -> do
652 case haType__ handle_ of
653 ErrorHandle theError -> ioError theError
654 ClosedHandle -> return False
655 SemiClosedHandle -> return False
658 hIsClosed :: Handle -> IO Bool
660 withHandle_ handle $ \ handle_ -> do
661 case haType__ handle_ of
662 ErrorHandle theError -> ioError theError
663 ClosedHandle -> return True
666 {- not defined, nor exported, but mentioned
667 here for documentation purposes:
669 hSemiClosed :: Handle -> IO Bool
673 return (not (ho || hc))
676 hIsReadable :: Handle -> IO Bool
678 withHandle_ handle $ \ handle_ -> do
679 case haType__ handle_ of
680 ErrorHandle theError -> ioError theError
681 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
682 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
683 htype -> return (isReadable htype)
685 isReadable ReadHandle = True
686 isReadable ReadWriteHandle = True
689 hIsWritable :: Handle -> IO Bool
691 withHandle_ handle $ \ handle_ -> do
692 case haType__ handle_ of
693 ErrorHandle theError -> ioError theError
694 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
695 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
696 htype -> return (isWritable htype)
698 isWritable AppendHandle = True
699 isWritable WriteHandle = True
700 isWritable ReadWriteHandle = True
704 getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
706 rc <- getBufferMode fo -- ConcHask: SAFE, won't block
708 0 -> return (NoBuffering, 0)
709 -1 -> return (LineBuffering, default_buffer_size)
710 -2 -> return (BlockBuffering Nothing, default_buffer_size)
711 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
712 n -> return (BlockBuffering (Just n), n)
714 default_buffer_size :: Int
715 default_buffer_size = (const_BUFSIZ - 1)
718 Querying how a handle buffers its data:
721 hGetBuffering :: Handle -> IO BufferMode
722 hGetBuffering handle =
723 withHandle_ handle $ \ handle_ -> do
724 case haType__ handle_ of
725 ErrorHandle theError -> ioError theError
726 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
729 We're being non-standard here, and allow the buffering
730 of a semi-closed handle to be queried. -- sof 6/98
732 return (haBufferMode__ handle_) -- could be stricter..
736 hIsSeekable :: Handle -> IO Bool
738 withHandle_ handle $ \ handle_ -> do
739 case haType__ handle_ of
740 ErrorHandle theError -> ioError theError
741 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
742 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
743 AppendHandle -> return False
745 rc <- seekFileP (haFO__ handle_) -- ConcHask: SAFE, won't block
749 _ -> constructErrorAndFail "hIsSeekable"
753 %*********************************************************
755 \subsection{Changing echo status}
757 %*********************************************************
759 Non-standard GHC extension is to allow the echoing status
760 of a handles connected to terminals to be reconfigured:
763 hSetEcho :: Handle -> Bool -> IO ()
764 hSetEcho handle on = do
765 isT <- hIsTerminalDevice handle
769 withHandle_ handle $ \ handle_ -> do
770 case haType__ handle_ of
771 ErrorHandle theError -> ioError theError
772 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
774 rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
777 else constructErrorAndFail "hSetEcho"
779 hGetEcho :: Handle -> IO Bool
781 isT <- hIsTerminalDevice handle
785 withHandle_ handle $ \ handle_ -> do
786 case haType__ handle_ of
787 ErrorHandle theError -> ioError theError
788 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
790 rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
794 _ -> constructErrorAndFail "hSetEcho"
796 hIsTerminalDevice :: Handle -> IO Bool
797 hIsTerminalDevice handle = do
798 withHandle_ handle $ \ handle_ -> do
799 case haType__ handle_ of
800 ErrorHandle theError -> ioError theError
801 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
803 rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
807 _ -> constructErrorAndFail "hIsTerminalDevice"
811 hConnectTerms :: Handle -> Handle -> IO ()
812 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
814 hConnectTo :: Handle -> Handle -> IO ()
815 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
817 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
818 hConnectHdl_ hW hR is_tty =
819 wantRWHandle "hConnectTo" hW $ \ hW_ ->
820 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
821 setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
824 As an extension, we also allow characters to be pushed back.
825 Like ANSI C stdio, we guarantee no more than one character of
826 pushback. (For unbuffered channels, the (default) push-back limit is
830 hUngetChar :: Handle -> Char -> IO ()
831 hUngetChar handle c =
832 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
833 rc <- ungetChar (haFO__ handle_) c -- ConcHask: SAFE, won't block
835 then constructErrorAndFail "hUngetChar"
841 Hoisting files in in one go is sometimes useful, so we support
842 this as an extension:
845 -- in one go, read file into an externally allocated buffer.
846 slurpFile :: FilePath -> IO (Addr, Int)
848 handle <- openFile fname ReadMode
849 sz <- hFileSize handle
850 if sz > toInteger (maxBound::Int) then
851 ioError (userError "slurpFile: file too big")
853 let sz_i = fromInteger sz
854 chunk <- allocMemory__ sz_i
858 constructErrorAndFail "slurpFile"
860 rc <- withHandle_ handle ( \ handle_ -> do
861 let fo = haFO__ handle_
862 mayBlock fo (readChunk fo chunk 0 sz_i) -- ConcHask: UNSAFE, may block.
866 then constructErrorAndFail "slurpFile"
867 else return (chunk, rc)
869 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
870 hFillBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
871 hFillBufBA handle buf sz
872 | sz <= 0 = ioError (IOError (Just handle)
875 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
876 | otherwise = hFillBuf' sz 0
878 hFillBuf' sz len = do
879 r <- mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf len sz)
880 if r >= sz || r == 0 -- r == 0 indicates EOF
882 else hFillBuf' (sz-r) (len+r)
885 hFillBuf :: Handle -> Addr -> Int -> IO Int
886 hFillBuf handle buf sz
887 | sz <= 0 = ioError (IOError (Just handle)
890 ("illegal buffer size " ++ showsPrec 9 sz []))
891 -- 9 => should be parens'ified.
892 | otherwise = hFillBuf' sz 0
894 hFillBuf' sz len = do
895 r <- mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf len sz)
896 if r >= sz || r == 0 -- r == 0 indicates EOF
898 else hFillBuf' (sz-r) (len+r)
901 The @hPutBuf hdl buf len@ action writes an already packed sequence of
902 bytes to the file/channel managed by @hdl@ - non-standard.
905 hPutBuf :: Handle -> Addr -> Int -> IO ()
906 hPutBuf handle buf sz
907 | sz <= 0 = ioError (IOError (Just handle)
910 ("illegal buffer size " ++ showsPrec 9 sz []))
911 -- 9 => should be parens'ified.
912 | otherwise = hPutBuf' sz 0
915 r <- mayBlockWrite "hPutBuf" handle (\fo -> writeBuf fo buf len sz)
918 else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
920 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
921 hPutBufBA :: Handle -> MutableByteArray RealWorld a -> Int -> IO ()
922 hPutBufBA 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 = hPutBuf' sz 0
931 r <- mayBlockWrite "hPutBufBA" handle (\fo -> writeBufBA fo buf len sz)
934 else hPutBuf' (sz-r) (len+r) -- <= sz indicates blocking
938 Sometimes it's useful to get at the file descriptor that
939 the Handle contains..
942 getHandleFd :: Handle -> IO Int
944 withHandle_ handle $ \ handle_ -> do
945 case (haType__ handle_) of
946 ErrorHandle theError -> ioError theError
947 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
949 fd <- getFileFd (haFO__ handle_)
954 %*********************************************************
956 \subsection{Miscellaneous}
958 %*********************************************************
960 These three functions are meant to get things out of @IOErrors@.
965 ioeGetFileName :: IOError -> Maybe FilePath
966 ioeGetErrorString :: IOError -> String
967 ioeGetHandle :: IOError -> Maybe Handle
969 ioeGetHandle (IOError h _ _ _) = h
970 ioeGetErrorString (IOError _ iot _ str) =
975 ioeGetFileName (IOError _ _ _ str) =
976 case span (/=':') str of
982 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
983 PrelMain.mainIO) and report them - topHandler is the exception
984 handler they should use for this:
987 -- make sure we handle errors while reporting the error!
988 -- (e.g. evaluating the string passed to 'error' might generate
989 -- another error, etc.)
990 topHandler :: Bool -> Exception -> IO ()
991 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
993 real_handler :: Bool -> Exception -> IO ()
994 real_handler bombOut ex =
996 AsyncException StackOverflow -> reportStackOverflow bombOut
997 ErrorCall s -> reportError bombOut s
998 other -> reportError bombOut (showsPrec 0 other "\n")
1000 reportStackOverflow :: Bool -> IO ()
1001 reportStackOverflow bombOut = do
1002 (hFlush stdout) `catchException` (\ _ -> return ())
1003 callStackOverflowHook
1009 reportError :: Bool -> String -> IO ()
1010 reportError bombOut str = do
1011 (hFlush stdout) `catchException` (\ _ -> return ())
1012 let bs@(ByteArray _ len _) = packString str
1013 writeErrString addrOf_ErrorHdrHook bs len
1019 foreign label "ErrorHdrHook"
1020 addrOf_ErrorHdrHook :: Addr
1022 foreign import ccall "writeErrString__" unsafe
1023 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1025 foreign import ccall "stackOverflow"
1026 callStackOverflowHook :: IO ()
1028 foreign import ccall "stg_exit"
1029 stg_exit :: Int -> IO ()
1033 A number of operations want to get at a readable or writeable handle, and fail
1037 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1038 wantReadableHandle fun handle act =
1039 withHandle_ handle $ \ handle_ -> do
1040 case haType__ handle_ of
1041 ErrorHandle theError -> ioError theError
1042 ClosedHandle -> ioe_closedHandle fun handle
1043 SemiClosedHandle -> ioe_closedHandle fun handle
1044 AppendHandle -> ioError not_readable_error
1045 WriteHandle -> ioError not_readable_error
1048 not_readable_error =
1049 IOError (Just handle) IllegalOperation fun
1050 ("handle is not open for reading")
1052 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1053 wantWriteableHandle fun handle act =
1054 withHandle_ handle $ \ handle_ -> do
1055 case haType__ handle_ of
1056 ErrorHandle theError -> ioError theError
1057 ClosedHandle -> ioe_closedHandle fun handle
1058 SemiClosedHandle -> ioe_closedHandle fun handle
1059 ReadHandle -> ioError not_writeable_error
1062 not_writeable_error =
1063 IOError (Just handle) IllegalOperation fun
1064 ("handle is not open for writing")
1066 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1067 wantRWHandle fun handle act =
1068 withHandle_ handle $ \ handle_ -> do
1069 case haType__ handle_ of
1070 ErrorHandle theError -> ioError theError
1071 ClosedHandle -> ioe_closedHandle fun handle
1072 SemiClosedHandle -> ioe_closedHandle fun handle
1075 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1076 wantSeekableHandle fun handle act =
1077 withHandle_ handle $ \ handle_ -> do
1078 case haType__ handle_ of
1079 ErrorHandle theError -> ioError theError
1080 ClosedHandle -> ioe_closedHandle fun handle
1081 SemiClosedHandle -> ioe_closedHandle fun handle
1084 not_seekable_error =
1085 IOError (Just handle)
1086 IllegalOperation fun
1087 ("handle is not seekable")
1091 Internal function for creating an @IOError@ representing the
1092 access to a closed file.
1095 ioe_closedHandle :: String -> Handle -> IO a
1096 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1099 Internal helper functions for Concurrent Haskell implementation
1103 mayBlock :: FILE_OBJECT -> IO Int -> IO Int
1104 mayBlock fo act = do
1107 -5 -> do -- (possibly blocking) read
1110 mayBlock fo act -- input available, re-try
1111 -6 -> do -- (possibly blocking) write
1114 mayBlock fo act -- output possible
1115 -7 -> do -- (possibly blocking) write on connected handle
1116 fd <- getConnFileFd fo
1118 mayBlock fo act -- output possible
1127 mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1128 mayBlockRead fname handle fn = do
1129 r <- wantReadableHandle fname handle $ \ handle_ -> do
1130 let fo = haFO__ handle_
1133 -5 -> do -- (possibly blocking) read
1135 return (BlockRead fd)
1136 -6 -> do -- (possibly blocking) write
1138 return (BlockWrite fd)
1139 -7 -> do -- (possibly blocking) write on connected handle
1140 fd <- getConnFileFd fo
1141 return (BlockWrite fd)
1144 then return (NoBlock rc)
1145 else constructErrorAndFail fname
1149 mayBlockRead fname handle fn
1152 mayBlockRead fname handle fn
1153 NoBlock c -> return c
1155 mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1156 mayBlockWrite fname handle fn = do
1157 r <- wantWriteableHandle fname handle $ \ handle_ -> do
1158 let fo = haFO__ handle_
1161 -5 -> do -- (possibly blocking) read
1163 return (BlockRead fd)
1164 -6 -> do -- (possibly blocking) write
1166 return (BlockWrite fd)
1167 -7 -> do -- (possibly blocking) write on connected handle
1168 fd <- getConnFileFd fo
1169 return (BlockWrite fd)
1172 then return (NoBlock rc)
1173 else constructErrorAndFail fname
1177 mayBlockWrite fname handle fn
1180 mayBlockWrite fname handle fn
1181 NoBlock c -> return c
1184 Foreign import declarations of helper functions:
1189 type Bytes = PrimByteArray RealWorld
1191 type Bytes = ByteArray#
1194 foreign import "libHS_cbits" "inputReady" unsafe
1195 inputReady :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1196 foreign import "libHS_cbits" "fileGetc" unsafe
1197 fileGetc :: FILE_OBJECT -> IO Int
1198 foreign import "libHS_cbits" "fileLookAhead" unsafe
1199 fileLookAhead :: FILE_OBJECT -> IO Int
1200 foreign import "libHS_cbits" "readBlock" unsafe
1201 readBlock :: FILE_OBJECT -> IO Int
1202 foreign import "libHS_cbits" "readLine" unsafe
1203 readLine :: FILE_OBJECT -> IO Int
1204 foreign import "libHS_cbits" "readChar" unsafe
1205 readChar :: FILE_OBJECT -> IO Int
1206 foreign import "libHS_cbits" "writeFileObject" unsafe
1207 writeFileObject :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1208 foreign import "libHS_cbits" "filePutc" unsafe
1209 filePutc :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1210 foreign import "libHS_cbits" "getBufStart" unsafe
1211 getBufStart :: FILE_OBJECT -> Int -> IO Addr
1212 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1213 getWriteableBuf :: FILE_OBJECT -> IO Addr
1214 foreign import "libHS_cbits" "getBufWPtr" unsafe
1215 getBufWPtr :: FILE_OBJECT -> IO Int
1216 foreign import "libHS_cbits" "setBufWPtr" unsafe
1217 setBufWPtr :: FILE_OBJECT -> Int -> IO ()
1218 foreign import "libHS_cbits" "closeFile" unsafe
1219 closeFile :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1220 foreign import "libHS_cbits" "fileEOF" unsafe
1221 fileEOF :: FILE_OBJECT -> IO Int{-ret code-}
1222 foreign import "libHS_cbits" "setBuffering" unsafe
1223 setBuffering :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1224 foreign import "libHS_cbits" "flushFile" unsafe
1225 flushFile :: FILE_OBJECT -> IO Int{-ret code-}
1226 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1227 flushConnectedBuf :: FILE_OBJECT -> IO ()
1228 foreign import "libHS_cbits" "getBufferMode" unsafe
1229 getBufferMode :: FILE_OBJECT -> IO Int{-ret code-}
1231 foreign import "libHS_cbits" "seekFile_int64" unsafe
1232 seekFile :: FILE_OBJECT -> Int -> Int64 -> IO Int
1234 foreign import "libHS_cbits" "seekFile" unsafe
1235 seekFile :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1238 foreign import "libHS_cbits" "seekFileP" unsafe
1239 seekFileP :: FILE_OBJECT -> IO Int{-ret code-}
1240 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1241 setTerminalEcho :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1242 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1243 getTerminalEcho :: FILE_OBJECT -> IO Int{-ret code-}
1244 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1245 isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1246 foreign import "libHS_cbits" "setConnectedTo" unsafe
1247 setConnectedTo :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1248 foreign import "libHS_cbits" "ungetChar" unsafe
1249 ungetChar :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1250 foreign import "libHS_cbits" "readChunk" unsafe
1251 readChunk :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1252 foreign import "libHS_cbits" "readChunk" unsafe
1253 readChunkBA :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1254 foreign import "libHS_cbits" "writeBuf" unsafe
1255 writeBuf :: FILE_OBJECT -> Addr -> Int -> Int -> IO Int{-ret code-}
1257 foreign import "libHS_cbits" "writeBufBA" unsafe
1258 writeBufBA :: FILE_OBJECT -> MutableByteArray s a -> Int -> Int -> IO Int{-ret code-}
1260 foreign import "libHS_cbits" "getFileFd" unsafe
1261 getFileFd :: FILE_OBJECT -> IO Int{-fd-}
1263 foreign import "libHS_cbits" "fileSize_int64" unsafe
1264 fileSize_int64 :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1266 foreign import "libHS_cbits" "fileSize" unsafe
1267 fileSize :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1270 foreign import "libHS_cbits" "getFilePosn" unsafe
1271 getFilePosn :: FILE_OBJECT -> IO Int
1272 foreign import "libHS_cbits" "setFilePosn" unsafe
1273 setFilePosn :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1274 foreign import "libHS_cbits" "getConnFileFd" unsafe
1275 getConnFileFd :: FILE_OBJECT -> IO Int{-fd-}
1276 foreign import "libHS_cbits" "getLock" unsafe
1277 getLock :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1278 foreign import "libHS_cbits" "openStdFile" unsafe
1279 openStdFile :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1280 foreign import "libHS_cbits" "openFile" unsafe
1281 primOpenFile :: ByteArray Int{-CString-}
1284 -> IO Addr {-file obj-}
1285 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1288 foreign import "libHS_cbits" "setBinaryMode__"
1289 setBinaryMode :: FILE_OBJECT -> Int -> IO Int