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(..) )
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 import PrelWeak ( addForeignFinalizer )
35 #ifdef __CONCURRENT_HASKELL__
39 #ifndef __PARALLEL_HASKELL__
40 import PrelForeign ( makeForeignObj )
43 #endif /* ndef(__HUGS__) */
46 #define __CONCURRENT_HASKELL__
50 #ifndef __PARALLEL_HASKELL__
51 #define FILE_OBJECT ForeignObj
53 #define FILE_OBJECT Addr
57 %*********************************************************
59 \subsection{Types @Handle@, @Handle__@}
61 %*********************************************************
63 The @Handle@ and @Handle__@ types are defined in @IOBase@.
66 {-# INLINE newHandle #-}
67 {-# INLINE withHandle #-}
68 newHandle :: Handle__ -> IO Handle
70 #if defined(__CONCURRENT_HASKELL__)
72 -- Use MVars for concurrent Haskell
73 newHandle hc = newMVar hc >>= \ h ->
77 -- Use ordinary MutableVars for non-concurrent Haskell
78 newHandle hc = stToIO (newVar hc >>= \ h ->
83 %*********************************************************
85 \subsection{@withHandle@ operations}
87 %*********************************************************
89 In the concurrent world, handles are locked during use. This is done
90 by wrapping an MVar around the handle which acts as a mutex over
91 operations on the handle.
93 To avoid races, we use the following bracketing operations. The idea
94 is to obtain the lock, do some operation and replace the lock again,
95 whether the operation succeeded or failed. We also want to handle the
96 case where the thread receives an exception while processing the IO
97 operation: in these cases we also want to relinquish the lock.
99 There are three versions of @withHandle@: corresponding to the three
100 possible combinations of:
102 - the operation may side-effect the handle
103 - the operation may return a result
105 If the operation generates an error or an exception is raised, the
106 orignal handle is always replaced [ this is the case at the moment,
107 but we might want to revisit this in the future --SDM ].
110 #ifdef __CONCURRENT_HASKELL__
111 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
112 withHandle (Handle h) act = do
114 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
118 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
119 withHandle_ (Handle h) act = do
121 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
125 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
126 withHandle__ (Handle h) act = do
128 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
133 -- of questionable value to install this exception
134 -- handler, but let's do it in the non-concurrent
135 -- case too, for now.
136 withHandle (Handle h) act = do
137 h_ <- stToIO (readVar h)
138 v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
144 nullFile__ is only used for closed handles, plugging it in as a null
145 file object reference.
148 nullFile__ :: FILE_OBJECT
150 #ifndef __PARALLEL_HASKELL__
151 unsafePerformIO (makeForeignObj nullAddr)
157 mkClosedHandle__ :: Handle__
165 mkErrorHandle__ :: IOError -> Handle__
166 mkErrorHandle__ ioe =
174 %*********************************************************
176 \subsection{Handle Finalizers}
178 %*********************************************************
181 foreign import "libHS_cbits" "freeStdFileObject" unsafe
182 freeStdFileObject :: FILE_OBJECT -> IO ()
183 foreign import "libHS_cbits" "freeFileObject" unsafe
184 freeFileObject :: FILE_OBJECT -> IO ()
188 %*********************************************************
190 \subsection[StdHandles]{Standard handles}
192 %*********************************************************
194 Three handles are allocated during program initialisation. The first
195 two manage input or output from the Haskell program's standard input
196 or output channel respectively. The third manages output to the
197 standard error channel. These handles are initially open.
201 stdin, stdout, stderr :: Handle
203 stdout = unsafePerformIO (do
204 rc <- getLock (1::Int) (1::Int) -- ConcHask: SAFE, won't block
206 0 -> newHandle (mkClosedHandle__)
208 fo <- openStdFile (1::Int)
209 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
211 #ifndef __PARALLEL_HASKELL__
212 fo <- makeForeignObj fo
213 addForeignFinalizer fo (freeStdFileObject fo)
217 /* I dont care what the Haskell report says, in an interactive system,
218 * stdout should be unbuffered by default.
222 (bm, bf_size) <- getBMode__ fo
223 mkBuffer__ fo bf_size
225 newHandle (Handle__ fo WriteHandle bm "stdout")
226 _ -> do ioError <- constructError "stdout"
227 newHandle (mkErrorHandle__ ioError)
230 stdin = unsafePerformIO (do
231 rc <- getLock (0::Int) (0::Int) -- ConcHask: SAFE, won't block
233 0 -> newHandle (mkClosedHandle__)
235 fo <- openStdFile (0::Int)
236 (1::Int){-readable-} -- ConcHask: SAFE, won't block
238 #ifndef __PARALLEL_HASKELL__
239 fo <- makeForeignObj fo
240 addForeignFinalizer fo (freeStdFileObject fo)
242 (bm, bf_size) <- getBMode__ fo
243 mkBuffer__ fo bf_size
244 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
245 -- when stdin and stdout are both connected to a terminal, ensure
246 -- that anything buffered on stdout is flushed prior to reading from stdin.
248 hConnectTerms stdout hdl
250 _ -> do ioError <- constructError "stdin"
251 newHandle (mkErrorHandle__ ioError)
255 stderr = unsafePerformIO (do
256 rc <- getLock (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
258 0 -> newHandle (mkClosedHandle__)
260 fo <- openStdFile (2::Int)
261 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
263 #ifndef __PARALLEL_HASKELL__
264 fo <- makeForeignObj fo
265 addForeignFinalizer fo (freeStdFileObject fo)
267 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
268 -- when stderr and stdout are both connected to a terminal, ensure
269 -- that anything buffered on stdout is flushed prior to writing to
271 hConnectTo stdout hdl
274 _ -> do ioError <- constructError "stderr"
275 newHandle (mkErrorHandle__ ioError)
279 %*********************************************************
281 \subsection[OpeningClosing]{Opening and Closing Files}
283 %*********************************************************
286 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
287 deriving (Eq, Ord, Ix, Enum, Read, Show)
292 deriving (Eq, Read, Show)
294 openFile :: FilePath -> IOMode -> IO Handle
295 openFile fp im = openFileEx fp (TextMode im)
297 openFileEx :: FilePath -> IOModeEx -> IO Handle
300 fo <- primOpenFile (packString f)
302 (binary::Int) -- ConcHask: SAFE, won't block
303 if fo /= nullAddr then do
304 #ifndef __PARALLEL_HASKELL__
305 fo <- makeForeignObj fo
306 addForeignFinalizer fo (freeFileObject fo)
308 (bm, bf_size) <- getBMode__ fo
309 mkBuffer__ fo bf_size
310 newHandle (Handle__ fo htype bm f)
312 constructErrorAndFailWithInfo "openFile" f
316 BinaryMode bmo -> (bmo, 1)
317 TextMode tmo -> (tmo, 0)
327 ReadMode -> ReadHandle
328 WriteMode -> WriteHandle
329 AppendMode -> AppendHandle
330 ReadWriteMode -> ReadWriteHandle
333 Computation $openFile file mode$ allocates and returns a new, open
334 handle to manage the file {\em file}. It manages input if {\em mode}
335 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
336 and both input and output if mode is $ReadWriteMode$.
338 If the file does not exist and it is opened for output, it should be
339 created as a new file. If {\em mode} is $WriteMode$ and the file
340 already exists, then it should be truncated to zero length. The
341 handle is positioned at the end of the file if {\em mode} is
342 $AppendMode$, and otherwise at the beginning (in which case its
343 internal position is 0).
345 Implementations should enforce, locally to the Haskell process,
346 multiple-reader single-writer locking on files, which is to say that
347 there may either be many handles on the same file which manage input,
348 or just one handle on the file which manages output. If any open or
349 semi-closed handle is managing a file for output, no new handle can be
350 allocated for that file. If any open or semi-closed handle is
351 managing a file for input, new handles can only be allocated if they
352 do not manage output.
354 Two files are the same if they have the same absolute name. An
355 implementation is free to impose stricter conditions.
358 hClose :: Handle -> IO ()
361 withHandle__ handle $ \ handle_ -> do
362 case haType__ handle_ of
363 ErrorHandle theError -> ioError theError
364 ClosedHandle -> return handle_
366 rc <- closeFile (haFO__ handle_)
367 (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
368 {- We explicitly close a file object so that we can be told
369 if there were any errors. Note that after @hClose@
370 has been performed, the ForeignObj embedded in the Handle
371 is still lying around in the heap, so care is taken
372 to avoid closing the file object when the ForeignObj
373 is finalized. (we overwrite the file ptr in the underlying
374 FileObject with a NULL as part of closeFile())
377 then return (handle_{ haType__ = ClosedHandle,
378 haFO__ = nullFile__ })
379 else constructErrorAndFail "hClose"
383 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
384 computation finishes, any items buffered for output and not already
385 sent to the operating system are flushed as for $flush$.
387 %*********************************************************
389 \subsection[EOF]{Detecting the End of Input}
391 %*********************************************************
394 For a handle {\em hdl} which attached to a physical file, $hFileSize
395 hdl$ returns the size of {\em hdl} in terms of the number of items
396 which can be read from {\em hdl}.
399 hFileSize :: Handle -> IO Integer
401 withHandle_ handle $ \ handle_ -> do
402 case haType__ handle_ of
403 ErrorHandle theError -> ioError theError
404 ClosedHandle -> ioe_closedHandle "hFileSize" handle
405 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
408 mem <- primNewByteArray 8{-sizeof_int64-}
409 rc <- fileSize_int64 (haFO__ handle_) mem -- ConcHask: SAFE, won't block
411 result <- primReadInt64Array mem 0
412 return (primInt64ToInteger result)
414 constructErrorAndFail "hFileSize"
417 -- HACK! We build a unique MP_INT of the right shape to hold
418 -- a single unsigned word, and we let the C routine
419 -- change the data bits
421 case int2Integer# 1# of
423 rc <- fileSize (haFO__ handle_) d -- ConcHask: SAFE, won't block
424 if rc == (0::Int) then
427 constructErrorAndFail "hFileSize"
431 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
432 @True@ if no further input can be taken from @hdl@ or for a
433 physical file, if the current I/O position is equal to the length of
434 the file. Otherwise, it returns @False@.
437 hIsEOF :: Handle -> IO Bool
439 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
440 let fo = haFO__ handle_
441 rc <- mayBlock fo (fileEOF fo) -- ConcHask: UNSAFE, may block
445 _ -> constructErrorAndFail "hIsEOF"
451 %*********************************************************
453 \subsection[Buffering]{Buffering Operations}
455 %*********************************************************
457 Three kinds of buffering are supported: line-buffering,
458 block-buffering or no-buffering. See @IOBase@ for definition
459 and further explanation of what the type represent.
461 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
462 handle {\em hdl} on subsequent reads and writes.
466 If {\em mode} is @LineBuffering@, line-buffering should be
469 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
470 should be enabled if possible. The size of the buffer is {\em n} items
471 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
473 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
476 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
477 to @NoBuffering@, then any items in the output buffer are written to
478 the device, and any items in the input buffer are discarded. The
479 default buffering mode when a handle is opened is
480 implementation-dependent and may depend on the object which is
481 attached to that handle.
484 hSetBuffering :: Handle -> BufferMode -> IO ()
486 hSetBuffering handle mode =
488 BlockBuffering (Just n)
490 (IOError (Just handle)
493 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
495 withHandle__ handle $ \ handle_ -> do
496 case haType__ handle_ of
497 ErrorHandle theError -> ioError theError
498 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
501 - we flush the old buffer regardless of whether
502 the new buffer could fit the contents of the old buffer
504 - allow a handle's buffering to change even if IO has
505 occurred (ANSI C spec. does not allow this, nor did
506 the previous implementation of IO.hSetBuffering).
507 - a non-standard extension is to allow the buffering
508 of semi-closed handles to change [sof 6/98]
510 let fo = haFO__ handle_
511 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
514 return (handle_{ haBufferMode__ = mode })
516 -- Note: failure to change the buffer size will cause old buffer to be flushed.
517 constructErrorAndFail "hSetBuffering"
523 BlockBuffering Nothing -> -2
524 BlockBuffering (Just n) -> n
527 The action @hFlush hdl@ causes any items buffered for output
528 in handle {\em hdl} to be sent immediately to the operating
532 hFlush :: Handle -> IO ()
534 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
535 let fo = haFO__ handle_
536 rc <- mayBlock fo (flushFile fo) -- ConcHask: UNSAFE, may block
540 constructErrorAndFail "hFlush"
545 %*********************************************************
547 \subsection[Seeking]{Repositioning Handles}
549 %*********************************************************
554 Handle -- Q: should this be a weak or strong ref. to the handle?
555 -- [what's the winning argument for it not being strong? --sof]
558 instance Eq HandlePosn where
559 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
561 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
562 -- We represent it as an Integer on the Haskell side, but
563 -- cheat slightly in that hGetPosn calls upon a C helper
564 -- that reports the position back via (merely) an Int.
565 type HandlePosition = Integer
567 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
568 mkHandlePosn h p = HandlePosn h p
570 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
571 deriving (Eq, Ord, Ix, Enum, Read, Show)
574 Computation @hGetPosn hdl@ returns the current I/O
575 position of {\em hdl} as an abstract position. Computation
576 $hSetPosn p$ sets the position of {\em hdl}
577 to a previously obtained position {\em p}.
580 hGetPosn :: Handle -> IO HandlePosn
582 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
583 posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block
584 if posn /= -1 then do
585 return (mkHandlePosn handle (fromInt posn))
587 constructErrorAndFail "hGetPosn"
589 hSetPosn :: HandlePosn -> IO ()
590 hSetPosn (HandlePosn handle i@(S# _)) = hSetPosn (HandlePosn handle (toBig i))
591 hSetPosn (HandlePosn handle (J# s# d#)) =
592 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
593 -- not as silly as it looks: the handle may have been closed in the meantime.
594 let fo = haFO__ handle_
595 rc <- mayBlock fo (setFilePosn fo (I# s#) d#) -- ConcHask: UNSAFE, may block
599 constructErrorAndFail "hSetPosn"
602 The action @hSeek hdl mode i@ sets the position of handle
603 @hdl@ depending on @mode@. If @mode@ is
605 * AbsoluteSeek - The position of @hdl@ is set to @i@.
606 * RelativeSeek - The position of @hdl@ is set to offset @i@ from
607 the current position.
608 * SeekFromEnd - The position of @hdl@ is set to offset @i@ from
611 Some handles may not be seekable (see @hIsSeekable@), or only
612 support a subset of the possible positioning operations (e.g. it may
613 only be possible to seek to the end of a tape, or to a positive
614 offset from the beginning or current position).
616 It is not possible to set a negative I/O position, or for a physical
617 file, an I/O position beyond the current end-of-file.
620 - when seeking using @SeekFromEnd@, positive offsets (>=0) means
621 seeking at or past EOF.
622 - relative seeking on buffered handles can lead to non-obvious results.
625 hSeek :: Handle -> SeekMode -> Integer -> IO ()
627 hSeek handle mode offset =
628 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
629 let fo = haFO__ handle_
630 rc <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
632 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
633 hSeek handle mode (J# s# d#) =
634 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
635 let fo = haFO__ handle_
636 rc <- mayBlock fo (seekFile fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
641 constructErrorAndFail "hSeek"
644 whence = case mode of
650 %*********************************************************
652 \subsection[Query]{Handle Properties}
654 %*********************************************************
656 A number of operations return information about the properties of a
657 handle. Each of these operations returns $True$ if the
658 handle has the specified property, and $False$
661 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
662 {\em hdl} is not block-buffered. Otherwise it returns
663 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
664 $( Just n )$ for block-buffering of {\em n} bytes.
667 hIsOpen :: Handle -> IO Bool
669 withHandle_ handle $ \ handle_ -> do
670 case haType__ handle_ of
671 ErrorHandle theError -> ioError theError
672 ClosedHandle -> return False
673 SemiClosedHandle -> return False
676 hIsClosed :: Handle -> IO Bool
678 withHandle_ handle $ \ handle_ -> do
679 case haType__ handle_ of
680 ErrorHandle theError -> ioError theError
681 ClosedHandle -> return True
684 {- not defined, nor exported, but mentioned
685 here for documentation purposes:
687 hSemiClosed :: Handle -> IO Bool
691 return (not (ho || hc))
694 hIsReadable :: Handle -> IO Bool
696 withHandle_ handle $ \ handle_ -> do
697 case haType__ handle_ of
698 ErrorHandle theError -> ioError theError
699 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
700 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
701 htype -> return (isReadable htype)
703 isReadable ReadHandle = True
704 isReadable ReadWriteHandle = True
707 hIsWritable :: Handle -> IO Bool
709 withHandle_ handle $ \ handle_ -> do
710 case haType__ handle_ of
711 ErrorHandle theError -> ioError theError
712 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
713 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
714 htype -> return (isWritable htype)
716 isWritable AppendHandle = True
717 isWritable WriteHandle = True
718 isWritable ReadWriteHandle = True
722 #ifndef __PARALLEL_HASKELL__
723 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
725 getBMode__ :: Addr -> IO (BufferMode, Int)
728 rc <- getBufferMode fo -- ConcHask: SAFE, won't block
730 0 -> return (NoBuffering, 0)
731 -1 -> return (LineBuffering, default_buffer_size)
732 -2 -> return (BlockBuffering Nothing, default_buffer_size)
733 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
734 n -> return (BlockBuffering (Just n), n)
736 default_buffer_size :: Int
737 default_buffer_size = (const_BUFSIZ - 1)
740 Querying how a handle buffers its data:
743 hGetBuffering :: Handle -> IO BufferMode
744 hGetBuffering handle =
745 withHandle_ handle $ \ handle_ -> do
746 case haType__ handle_ of
747 ErrorHandle theError -> ioError theError
748 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
751 We're being non-standard here, and allow the buffering
752 of a semi-closed handle to be queried. -- sof 6/98
754 return (haBufferMode__ handle_) -- could be stricter..
758 hIsSeekable :: Handle -> IO Bool
760 withHandle_ handle $ \ handle_ -> do
761 case haType__ handle_ of
762 ErrorHandle theError -> ioError theError
763 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
764 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
765 AppendHandle -> return False
767 rc <- seekFileP (haFO__ handle_) -- ConcHask: SAFE, won't block
771 _ -> constructErrorAndFail "hIsSeekable"
775 %*********************************************************
777 \subsection{Changing echo status}
779 %*********************************************************
781 Non-standard GHC extension is to allow the echoing status
782 of a handles connected to terminals to be reconfigured:
785 hSetEcho :: Handle -> Bool -> IO ()
786 hSetEcho handle on = do
787 isT <- hIsTerminalDevice handle
791 withHandle_ handle $ \ handle_ -> do
792 case haType__ handle_ of
793 ErrorHandle theError -> ioError theError
794 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
796 rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
799 else constructErrorAndFail "hSetEcho"
801 hGetEcho :: Handle -> IO Bool
803 isT <- hIsTerminalDevice handle
807 withHandle_ handle $ \ handle_ -> do
808 case haType__ handle_ of
809 ErrorHandle theError -> ioError theError
810 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
812 rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
816 _ -> constructErrorAndFail "hSetEcho"
818 hIsTerminalDevice :: Handle -> IO Bool
819 hIsTerminalDevice handle = do
820 withHandle_ handle $ \ handle_ -> do
821 case haType__ handle_ of
822 ErrorHandle theError -> ioError theError
823 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
825 rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
829 _ -> constructErrorAndFail "hIsTerminalDevice"
833 hConnectTerms :: Handle -> Handle -> IO ()
834 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
836 hConnectTo :: Handle -> Handle -> IO ()
837 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
839 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
840 hConnectHdl_ hW hR is_tty =
841 wantRWHandle "hConnectTo" hW $ \ hW_ ->
842 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
843 setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
845 #ifndef __PARALLEL_HASKELL__
846 #define FILE_OBJECT ForeignObj
848 #define FILE_OBJECT Addr
853 As an extension, we also allow characters to be pushed back.
854 Like ANSI C stdio, we guarantee no more than one character of
855 pushback. (For unbuffered channels, the (default) push-back limit is
859 hUngetChar :: Handle -> Char -> IO ()
860 hUngetChar handle c =
861 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
862 rc <- ungetChar (haFO__ handle_) c -- ConcHask: SAFE, won't block
864 then constructErrorAndFail "hUngetChar"
870 Hoisting files in in one go is sometimes useful, so we support
871 this as an extension:
874 -- in one go, read file into an externally allocated buffer.
875 slurpFile :: FilePath -> IO (Addr, Int)
877 handle <- openFile fname ReadMode
878 sz <- hFileSize handle
879 if sz > toInteger (maxBound::Int) then
880 ioError (userError "slurpFile: file too big")
882 let sz_i = fromInteger sz
883 chunk <- allocMemory__ sz_i
887 constructErrorAndFail "slurpFile"
889 rc <- withHandle_ handle ( \ handle_ -> do
890 let fo = haFO__ handle_
891 mayBlock fo (readChunk fo chunk sz_i) -- ConcHask: UNSAFE, may block.
895 then constructErrorAndFail "slurpFile"
896 else return (chunk, rc)
898 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
899 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
900 hFillBufBA handle buf sz
901 | sz <= 0 = ioError (IOError (Just handle)
904 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
906 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
907 let fo = haFO__ handle_
908 rc <- mayBlock fo (readChunkBA fo buf sz) -- ConcHask: UNSAFE, may block.
911 else constructErrorAndFail "hFillBufBA"
914 hFillBuf :: Handle -> Addr -> Int -> IO Int
915 hFillBuf handle buf sz
916 | sz <= 0 = ioError (IOError (Just handle)
919 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
921 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
922 let fo = haFO__ handle_
923 rc <- mayBlock fo (readChunk fo buf sz) -- ConcHask: UNSAFE, may block.
926 else constructErrorAndFail "hFillBuf"
930 The @hPutBuf hdl buf len@ action writes an already packed sequence of
931 bytes to the file/channel managed by @hdl@ - non-standard.
934 hPutBuf :: Handle -> Addr -> Int -> IO ()
935 hPutBuf handle buf len =
936 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
937 let fo = haFO__ handle_
938 rc <- mayBlock fo (writeBuf fo buf len) -- ConcHask: UNSAFE, may block.
941 else constructErrorAndFail "hPutBuf"
943 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
944 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
945 hPutBufBA handle buf len =
946 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
947 let fo = haFO__ handle_
948 rc <- mayBlock fo (writeBufBA fo buf len) -- ConcHask: UNSAFE, may block.
951 else constructErrorAndFail "hPutBuf"
955 Sometimes it's useful to get at the file descriptor that
956 the Handle contains..
959 getHandleFd :: Handle -> IO Int
961 withHandle_ handle $ \ handle_ -> do
962 case (haType__ handle_) of
963 ErrorHandle theError -> ioError theError
964 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
966 fd <- getFileFd (haFO__ handle_)
971 %*********************************************************
973 \subsection{Miscellaneous}
975 %*********************************************************
977 These three functions are meant to get things out of @IOErrors@.
982 ioeGetFileName :: IOError -> Maybe FilePath
983 ioeGetErrorString :: IOError -> String
984 ioeGetHandle :: IOError -> Maybe Handle
986 ioeGetHandle (IOError h _ _ _) = h
987 ioeGetErrorString (IOError _ iot _ str) =
992 ioeGetFileName (IOError _ _ _ str) =
993 case span (/=':') str of
999 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
1000 PrelMain.mainIO) and report them - topHandler is the exception
1001 handler they should use for this:
1004 -- make sure we handle errors while reporting the error!
1005 -- (e.g. evaluating the string passed to 'error' might generate
1006 -- another error, etc.)
1007 topHandler :: Bool -> Exception -> IO ()
1008 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
1010 real_handler :: Bool -> Exception -> IO ()
1011 real_handler bombOut ex =
1013 AsyncException StackOverflow -> reportStackOverflow bombOut
1014 ErrorCall s -> reportError bombOut s
1015 other -> reportError bombOut (showsPrec 0 other "\n")
1017 reportStackOverflow :: Bool -> IO ()
1018 reportStackOverflow bombOut = do
1019 (hFlush stdout) `catchException` (\ _ -> return ())
1020 callStackOverflowHook
1026 reportError :: Bool -> String -> IO ()
1027 reportError bombOut str = do
1028 (hFlush stdout) `catchException` (\ _ -> return ())
1029 let bs@(ByteArray _ len _) = packString str
1030 writeErrString addrOf_ErrorHdrHook bs len
1036 foreign label "ErrorHdrHook"
1037 addrOf_ErrorHdrHook :: Addr
1039 foreign import ccall "writeErrString__" unsafe
1040 writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
1042 foreign import ccall "stackOverflow"
1043 callStackOverflowHook :: IO ()
1045 foreign import ccall "stg_exit"
1046 stg_exit :: Int -> IO ()
1050 A number of operations want to get at a readable or writeable handle, and fail
1054 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1055 wantReadableHandle fun handle act =
1056 withHandle_ handle $ \ handle_ -> do
1057 case haType__ handle_ of
1058 ErrorHandle theError -> ioError theError
1059 ClosedHandle -> ioe_closedHandle fun handle
1060 SemiClosedHandle -> ioe_closedHandle fun handle
1061 AppendHandle -> ioError not_readable_error
1062 WriteHandle -> ioError not_readable_error
1065 not_readable_error =
1066 IOError (Just handle) IllegalOperation fun
1067 ("handle is not open for reading")
1069 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1070 wantWriteableHandle fun handle act =
1071 withHandle_ handle $ \ handle_ -> do
1072 case haType__ handle_ of
1073 ErrorHandle theError -> ioError theError
1074 ClosedHandle -> ioe_closedHandle fun handle
1075 SemiClosedHandle -> ioe_closedHandle fun handle
1076 ReadHandle -> ioError not_writeable_error
1079 not_writeable_error =
1080 IOError (Just handle) IllegalOperation fun
1081 ("handle is not open for writing")
1083 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1084 wantRWHandle fun handle act =
1085 withHandle_ handle $ \ handle_ -> do
1086 case haType__ handle_ of
1087 ErrorHandle theError -> ioError theError
1088 ClosedHandle -> ioe_closedHandle fun handle
1089 SemiClosedHandle -> ioe_closedHandle fun handle
1092 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1093 wantSeekableHandle fun handle act =
1094 withHandle_ handle $ \ handle_ -> do
1095 case haType__ handle_ of
1096 ErrorHandle theError -> ioError theError
1097 ClosedHandle -> ioe_closedHandle fun handle
1098 SemiClosedHandle -> ioe_closedHandle fun handle
1101 not_seekable_error =
1102 IOError (Just handle)
1103 IllegalOperation fun
1104 ("handle is not seekable")
1108 Internal function for creating an @IOError@ representing the
1109 access to a closed file.
1112 ioe_closedHandle :: String -> Handle -> IO a
1113 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1116 Internal helper functions for Concurrent Haskell implementation
1120 #ifndef __PARALLEL_HASKELL__
1121 mayBlock :: ForeignObj -> IO Int -> IO Int
1123 mayBlock :: Addr -> IO Int -> IO Int
1126 mayBlock fo act = do
1129 -5 -> do -- (possibly blocking) read
1132 mayBlock fo act -- input available, re-try
1133 -6 -> do -- (possibly blocking) write
1136 mayBlock fo act -- output possible
1137 -7 -> do -- (possibly blocking) write on connected handle
1138 fd <- getConnFileFd fo
1140 mayBlock fo act -- output possible
1145 Foreign import declarations of helper functions:
1150 type Bytes = PrimByteArray RealWorld
1152 type Bytes = ByteArray#
1155 foreign import "libHS_cbits" "inputReady" unsafe
1156 inputReady :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1157 foreign import "libHS_cbits" "fileGetc" unsafe
1158 fileGetc :: FILE_OBJECT -> IO Int
1159 foreign import "libHS_cbits" "fileLookAhead" unsafe
1160 fileLookAhead :: FILE_OBJECT -> IO Int
1161 foreign import "libHS_cbits" "readBlock" unsafe
1162 readBlock :: FILE_OBJECT -> IO Int
1163 foreign import "libHS_cbits" "readLine" unsafe
1164 readLine :: FILE_OBJECT -> IO Int
1165 foreign import "libHS_cbits" "readChar" unsafe
1166 readChar :: FILE_OBJECT -> IO Int
1167 foreign import "libHS_cbits" "writeFileObject" unsafe
1168 writeFileObject :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1169 foreign import "libHS_cbits" "filePutc" unsafe
1170 filePutc :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1171 foreign import "libHS_cbits" "getBufStart" unsafe
1172 getBufStart :: FILE_OBJECT -> Int -> IO Addr
1173 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1174 getWriteableBuf :: FILE_OBJECT -> IO Addr
1175 foreign import "libHS_cbits" "getBufWPtr" unsafe
1176 getBufWPtr :: FILE_OBJECT -> IO Int
1177 foreign import "libHS_cbits" "setBufWPtr" unsafe
1178 setBufWPtr :: FILE_OBJECT -> Int -> IO ()
1179 foreign import "libHS_cbits" "closeFile" unsafe
1180 closeFile :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1181 foreign import "libHS_cbits" "fileEOF" unsafe
1182 fileEOF :: FILE_OBJECT -> IO Int{-ret code-}
1183 foreign import "libHS_cbits" "setBuffering" unsafe
1184 setBuffering :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1185 foreign import "libHS_cbits" "flushFile" unsafe
1186 flushFile :: FILE_OBJECT -> IO Int{-ret code-}
1187 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1188 flushConnectedBuf :: FILE_OBJECT -> IO ()
1189 foreign import "libHS_cbits" "getBufferMode" unsafe
1190 getBufferMode :: FILE_OBJECT -> IO Int{-ret code-}
1192 foreign import "libHS_cbits" "seekFile_int64" unsafe
1193 seekFile :: FILE_OBJECT -> Int -> Int64 -> IO Int
1195 foreign import "libHS_cbits" "seekFile" unsafe
1196 seekFile :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1199 foreign import "libHS_cbits" "seekFileP" unsafe
1200 seekFileP :: FILE_OBJECT -> IO Int{-ret code-}
1201 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1202 setTerminalEcho :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1203 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1204 getTerminalEcho :: FILE_OBJECT -> IO Int{-ret code-}
1205 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1206 isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1207 foreign import "libHS_cbits" "setConnectedTo" unsafe
1208 setConnectedTo :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1209 foreign import "libHS_cbits" "ungetChar" unsafe
1210 ungetChar :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1211 foreign import "libHS_cbits" "readChunk" unsafe
1212 readChunk :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1213 foreign import "libHS_cbits" "readChunk" unsafe
1214 readChunkBA :: FILE_OBJECT -> ByteArray Int -> Int -> IO Int{-ret code-}
1215 foreign import "libHS_cbits" "writeBuf" unsafe
1216 writeBuf :: FILE_OBJECT -> Addr -> Int -> IO Int{-ret code-}
1218 foreign import "libHS_cbits" "writeBufBA" unsafe
1219 writeBufBA :: FILE_OBJECT -> ByteArray Int -> Int -> IO Int{-ret code-}
1221 foreign import "libHS_cbits" "getFileFd" unsafe
1222 getFileFd :: FILE_OBJECT -> IO Int{-fd-}
1224 foreign import "libHS_cbits" "fileSize_int64" unsafe
1225 fileSize_int64 :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1227 foreign import "libHS_cbits" "fileSize" unsafe
1228 fileSize :: FILE_OBJECT -> Bytes -> IO Int{-ret code-}
1231 foreign import "libHS_cbits" "getFilePosn" unsafe
1232 getFilePosn :: FILE_OBJECT -> IO Int
1233 foreign import "libHS_cbits" "setFilePosn" unsafe
1234 setFilePosn :: FILE_OBJECT -> Int -> ByteArray# -> IO Int
1235 foreign import "libHS_cbits" "getConnFileFd" unsafe
1236 getConnFileFd :: FILE_OBJECT -> IO Int{-fd-}
1237 foreign import "libHS_cbits" "getLock" unsafe
1238 getLock :: Int{-Fd-} -> Int{-exclusive-} -> IO Int{-return code-}
1239 foreign import "libHS_cbits" "openStdFile" unsafe
1240 openStdFile :: Int{-fd-} -> Int{-Readable?-} -> IO Addr{-file obj-}
1241 foreign import "libHS_cbits" "openFile" unsafe
1242 primOpenFile :: ByteArray Int{-CString-}
1245 -> IO Addr {-file obj-}
1246 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1249 foreign import "libHS_cbits" "setBinaryMode__"
1250 setBinaryMode :: FILE_OBJECT -> Int -> IO Int