1 % ------------------------------------------------------------------------------
2 % $Id: PrelHandle.lhs,v 1.66 2001/01/11 17:25:57 simonmar Exp $
4 % (c) The AQUA Project, Glasgow University, 1994-2000
7 \section[PrelHandle]{Module @PrelHandle@}
9 This module defines Haskell {\em handles} and the basic operations
10 which are supported for them.
13 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
14 #include "cbits/stgerror.h"
16 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
17 module PrelHandle where
22 import PrelByteArr ( ByteArray(..) )
23 import PrelRead ( Read )
24 import PrelList ( break )
26 import PrelMaybe ( Maybe(..) )
29 import PrelNum ( toBig, Integer(..), Num(..) )
31 import PrelReal ( toInteger )
32 import PrelPack ( packString )
36 #ifndef __PARALLEL_HASKELL__
37 import PrelForeign ( newForeignPtr, mkForeignPtr, addForeignPtrFinalizer )
40 #endif /* ndef(__HUGS__) */
43 #define __CONCURRENT_HASKELL__
47 #ifndef __PARALLEL_HASKELL__
48 #define FILE_OBJECT (ForeignPtr ())
50 #define FILE_OBJECT (Ptr ())
55 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
56 mkBuffer__ fo sz_in_bytes = do
59 0 -> return nullPtr -- this has the effect of overwriting the pointer to the old buffer.
61 chunk <- malloc sz_in_bytes
63 then ioException (IOError Nothing ResourceExhausted
64 "mkBuffer__" "not enough virtual memory" Nothing)
66 setBuf fo chunk sz_in_bytes
69 %*********************************************************
71 \subsection{Types @Handle@, @Handle__@}
73 %*********************************************************
75 The @Handle@ and @Handle__@ types are defined in @IOBase@.
78 {-# INLINE newHandle #-}
79 newHandle :: Handle__ -> IO Handle
81 -- Use MVars for concurrent Haskell
82 newHandle hc = newMVar hc >>= \ h ->
86 %*********************************************************
88 \subsection{@withHandle@ operations}
90 %*********************************************************
92 In the concurrent world, handles are locked during use. This is done
93 by wrapping an MVar around the handle which acts as a mutex over
94 operations on the handle.
96 To avoid races, we use the following bracketing operations. The idea
97 is to obtain the lock, do some operation and replace the lock again,
98 whether the operation succeeded or failed. We also want to handle the
99 case where the thread receives an exception while processing the IO
100 operation: in these cases we also want to relinquish the lock.
102 There are three versions of @withHandle@: corresponding to the three
103 possible combinations of:
105 - the operation may side-effect the handle
106 - the operation may return a result
108 If the operation generates an error or an exception is raised, the
109 orignal handle is always replaced [ this is the case at the moment,
110 but we might want to revisit this in the future --SDM ].
113 withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
114 {-# INLINE withHandle #-}
115 withHandle (Handle h) act =
118 (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
122 withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
123 {-# INLINE withHandle_ #-}
124 withHandle_ (Handle h) act =
127 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
131 withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
132 {-# INLINE withHandle__ #-}
133 withHandle__ (Handle h) act =
136 h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
141 nullFile__ is only used for closed handles, plugging it in as a null
142 file object reference.
145 nullFile__ :: FILE_OBJECT
147 #ifndef __PARALLEL_HASKELL__
148 unsafePerformIO (newForeignPtr nullPtr (return ()))
154 mkClosedHandle__ :: Handle__
156 Handle__ { haFO__ = nullFile__,
157 haType__ = ClosedHandle,
158 haBufferMode__ = NoBuffering,
159 haFilePath__ = "closed file",
164 %*********************************************************
166 \subsection{Handle Finalizers}
168 %*********************************************************
171 stdHandleFinalizer :: Handle -> IO ()
172 stdHandleFinalizer (Handle hdl) = do
173 handle <- takeMVar hdl
174 let fo = haFO__ handle
176 freeBuffers (haBuffers__ handle)
178 handleFinalizer :: Handle -> IO ()
179 handleFinalizer (Handle hdl) = do
180 handle <- takeMVar hdl
181 let fo = haFO__ handle
183 freeBuffers (haBuffers__ handle)
185 freeBuffers [] = return ()
186 freeBuffers (b:bs) = do { free b; freeBuffers bs }
188 foreign import "libHS_cbits" "freeStdFileObject" unsafe
189 freeStdFileObject :: FILE_OBJECT -> IO ()
190 foreign import "libHS_cbits" "freeFileObject" unsafe
191 freeFileObject :: FILE_OBJECT -> IO ()
192 foreign import "free" unsafe
193 free :: Ptr a -> IO ()
196 %*********************************************************
198 \subsection[StdHandles]{Standard handles}
200 %*********************************************************
202 Three handles are allocated during program initialisation. The first
203 two manage input or output from the Haskell program's standard input
204 or output channel respectively. The third manages output to the
205 standard error channel. These handles are initially open.
209 stdin, stdout, stderr :: Handle
211 stdout = unsafePerformIO (do
212 rc <- getLock (1::Int) (1::Int) -- ConcHask: SAFE, won't block
214 0 -> newHandle (mkClosedHandle__)
216 fo <- openStdFile (1::Int)
217 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
219 #ifndef __PARALLEL_HASKELL__
220 fo <- mkForeignPtr fo
221 -- I know this is deprecated, but I couldn't bring myself
222 -- to move fixIO into the prelude just so I could use
223 -- newForeignPtr. --SDM
227 /* I dont care what the Haskell report says, in an interactive system,
228 * stdout should be unbuffered by default.
232 (bm, bf_size) <- getBMode__ fo
233 mkBuffer__ fo bf_size
235 hdl <- newHandle (Handle__ fo WriteHandle bm "stdout" [])
237 #ifndef __PARALLEL_HASKELL__
238 addForeignPtrFinalizer fo (stdHandleFinalizer hdl)
242 _ -> constructErrorAndFail "stdout"
245 stdin = unsafePerformIO (do
246 rc <- getLock (0::Int) (0::Int) -- ConcHask: SAFE, won't block
248 0 -> newHandle (mkClosedHandle__)
250 fo <- openStdFile (0::Int)
251 (1::Int){-readable-} -- ConcHask: SAFE, won't block
253 #ifndef __PARALLEL_HASKELL__
254 fo <- mkForeignPtr fo
256 (bm, bf_size) <- getBMode__ fo
257 mkBuffer__ fo bf_size
258 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin" [])
259 -- when stdin and stdout are both connected to a terminal, ensure
260 -- that anything buffered on stdout is flushed prior to reading from
262 #ifndef __PARALLEL_HASKELL__
263 addForeignPtrFinalizer fo (stdHandleFinalizer hdl)
265 hConnectTerms stdout hdl
267 _ -> constructErrorAndFail "stdin"
271 stderr = unsafePerformIO (do
272 rc <- getLock (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
274 0 -> newHandle (mkClosedHandle__)
276 fo <- openStdFile (2::Int)
277 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
279 #ifndef __PARALLEL_HASKELL__
280 fo <- mkForeignPtr fo
282 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr" [])
283 -- when stderr and stdout are both connected to a terminal, ensure
284 -- that anything buffered on stdout is flushed prior to writing to
286 #ifndef __PARALLEL_HASKELL__
287 addForeignPtrFinalizer fo (stdHandleFinalizer hdl)
289 hConnectTo stdout hdl
292 _ -> constructErrorAndFail "stderr"
296 %*********************************************************
298 \subsection[OpeningClosing]{Opening and Closing Files}
300 %*********************************************************
303 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
304 deriving (Eq, Ord, Ix, Enum, Read, Show)
309 deriving (Eq, Read, Show)
311 openFile :: FilePath -> IOMode -> IO Handle
312 openFile fp im = openFileEx fp (TextMode im)
314 openFileEx :: FilePath -> IOModeEx -> IO Handle
317 fo <- primOpenFile (packString f)
319 (binary::Int) -- ConcHask: SAFE, won't block
320 if fo /= nullPtr then do
321 #ifndef __PARALLEL_HASKELL__
322 fo <- mkForeignPtr fo
324 (bm, bf_size) <- getBMode__ fo
325 mkBuffer__ fo bf_size
326 hdl <- newHandle (Handle__ fo htype bm f [])
327 #ifndef __PARALLEL_HASKELL__
328 addForeignPtrFinalizer fo (handleFinalizer hdl)
332 constructErrorAndFailWithInfo "openFile" f
336 BinaryMode bmo -> (bmo, 1)
337 TextMode tmo -> (tmo, 0)
347 ReadMode -> ReadHandle
348 WriteMode -> WriteHandle
349 AppendMode -> AppendHandle
350 ReadWriteMode -> ReadWriteHandle
353 Computation $openFile file mode$ allocates and returns a new, open
354 handle to manage the file {\em file}. It manages input if {\em mode}
355 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
356 and both input and output if mode is $ReadWriteMode$.
358 If the file does not exist and it is opened for output, it should be
359 created as a new file. If {\em mode} is $WriteMode$ and the file
360 already exists, then it should be truncated to zero length. The
361 handle is positioned at the end of the file if {\em mode} is
362 $AppendMode$, and otherwise at the beginning (in which case its
363 internal position is 0).
365 Implementations should enforce, locally to the Haskell process,
366 multiple-reader single-writer locking on files, which is to say that
367 there may either be many handles on the same file which manage input,
368 or just one handle on the file which manages output. If any open or
369 semi-closed handle is managing a file for output, no new handle can be
370 allocated for that file. If any open or semi-closed handle is
371 managing a file for input, new handles can only be allocated if they
372 do not manage output.
374 Two files are the same if they have the same absolute name. An
375 implementation is free to impose stricter conditions.
378 hClose :: Handle -> IO ()
381 withHandle__ handle $ \ handle_ -> do
382 case haType__ handle_ of
383 ClosedHandle -> return handle_
385 rc <- closeFile (haFO__ handle_)
386 (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
387 {- We explicitly close a file object so that we can be told
388 if there were any errors. Note that after @hClose@
389 has been performed, the ForeignPtr embedded in the Handle
390 is still lying around in the heap, so care is taken
391 to avoid closing the file object when the ForeignPtr
392 is finalized. (we overwrite the file ptr in the underlying
393 FileObject with a NULL as part of closeFile())
397 then constructErrorAndFail "hClose"
399 -- free the spare buffers (except the handle buffer)
400 -- associated with this handle.
401 else do freeBuffers (haBuffers__ handle_)
402 return (handle_{ haType__ = ClosedHandle,
406 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
407 computation finishes, any items buffered for output and not already
408 sent to the operating system are flushed as for $flush$.
410 %*********************************************************
412 \subsection[FileSize]{Detecting the size of a file}
414 %*********************************************************
417 For a handle {\em hdl} which attached to a physical file, $hFileSize
418 hdl$ returns the size of {\em hdl} in terms of the number of items
419 which can be read from {\em hdl}.
422 hFileSize :: Handle -> IO Integer
424 withHandle_ handle $ \ handle_ -> do
425 case haType__ handle_ of
426 ClosedHandle -> ioe_closedHandle "hFileSize" handle
427 SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
430 mem <- primNewByteArray 8{-sizeof_int64-}
431 rc <- fileSize_int64 (haFO__ handle_) mem -- ConcHask: SAFE, won't block
433 result <- primReadInt64Array mem 0
434 return (primInt64ToInteger result)
436 constructErrorAndFail "hFileSize"
439 -- HACK! We build a unique MP_INT of the right shape to hold
440 -- a single unsigned word, and we let the C routine
441 -- change the data bits
443 case int2Integer# 1# of
445 rc <- fileSize (haFO__ handle_) d -- ConcHask: SAFE, won't block
446 if rc == (0::Int) then
449 constructErrorAndFail "hFileSize"
453 %*********************************************************
455 \subsection[EOF]{Detecting the End of Input}
457 %*********************************************************
460 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
461 @True@ if no further input can be taken from @hdl@ or for a
462 physical file, if the current I/O position is equal to the length of
463 the file. Otherwise, it returns @False@.
466 hIsEOF :: Handle -> IO Bool
468 rc <- mayBlockRead "hIsEOF" handle fileEOF
472 _ -> constructErrorAndFail "hIsEOF"
478 %*********************************************************
480 \subsection[Buffering]{Buffering Operations}
482 %*********************************************************
484 Three kinds of buffering are supported: line-buffering,
485 block-buffering or no-buffering. See @IOBase@ for definition
486 and further explanation of what the type represent.
488 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
489 handle {\em hdl} on subsequent reads and writes.
493 If {\em mode} is @LineBuffering@, line-buffering should be
496 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
497 should be enabled if possible. The size of the buffer is {\em n} items
498 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
500 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
503 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
504 to @NoBuffering@, then any items in the output buffer are written to
505 the device, and any items in the input buffer are discarded. The
506 default buffering mode when a handle is opened is
507 implementation-dependent and may depend on the object which is
508 attached to that handle.
511 hSetBuffering :: Handle -> BufferMode -> IO ()
513 hSetBuffering handle mode =
515 BlockBuffering (Just n)
516 | n <= 0 -> ioException
517 (IOError (Just handle)
520 ("illegal buffer size " ++ showsPrec 9 n [])
521 -- 9 => should be parens'ified.
524 withHandle__ handle $ \ handle_ -> do
525 case haType__ handle_ of
526 ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
529 - we flush the old buffer regardless of whether
530 the new buffer could fit the contents of the old buffer
532 - allow a handle's buffering to change even if IO has
533 occurred (ANSI C spec. does not allow this, nor did
534 the previous implementation of IO.hSetBuffering).
535 - a non-standard extension is to allow the buffering
536 of semi-closed handles to change [sof 6/98]
538 let fo = haFO__ handle_
539 rc <- mayBlock fo (setBuffering fo bsize) -- ConcHask: UNSAFE, may block
542 return (handle_{ haBufferMode__ = mode })
544 -- Note: failure to change the buffer size will cause old buffer to be flushed.
545 constructErrorAndFail "hSetBuffering"
551 BlockBuffering Nothing -> -2
552 BlockBuffering (Just n) -> n
555 The action @hFlush hdl@ causes any items buffered for output
556 in handle {\em hdl} to be sent immediately to the operating
560 hFlush :: Handle -> IO ()
562 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
563 let fo = haFO__ handle_
564 rc <- mayBlock fo (flushFile fo) -- ConcHask: UNSAFE, may block
568 constructErrorAndFail "hFlush"
573 %*********************************************************
575 \subsection[Seeking]{Repositioning Handles}
577 %*********************************************************
582 Handle -- Q: should this be a weak or strong ref. to the handle?
583 -- [what's the winning argument for it not being strong? --sof]
586 instance Eq HandlePosn where
587 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
589 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
590 -- We represent it as an Integer on the Haskell side, but
591 -- cheat slightly in that hGetPosn calls upon a C helper
592 -- that reports the position back via (merely) an Int.
593 type HandlePosition = Integer
595 mkHandlePosn :: Handle -> HandlePosition -> HandlePosn
596 mkHandlePosn h p = HandlePosn h p
598 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
599 deriving (Eq, Ord, Ix, Enum, Read, Show)
602 Computation @hGetPosn hdl@ returns the current I/O
603 position of {\em hdl} as an abstract position. Computation
604 $hSetPosn p$ sets the position of {\em hdl}
605 to a previously obtained position {\em p}.
608 hGetPosn :: Handle -> IO HandlePosn
610 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
611 posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block
612 if posn /= -1 then do
613 return (mkHandlePosn handle (fromInt posn))
615 constructErrorAndFail "hGetPosn"
617 hSetPosn :: HandlePosn -> IO ()
618 hSetPosn (HandlePosn handle i@(S# _)) = hSetPosn (HandlePosn handle (toBig i))
619 hSetPosn (HandlePosn handle (J# s# d#)) =
620 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do
621 -- not as silly as it looks: the handle may have been closed in the meantime.
622 let fo = haFO__ handle_
623 rc <- mayBlock fo (setFilePosn fo (I# s#) d#) -- ConcHask: UNSAFE, may block
627 constructErrorAndFail "hSetPosn"
630 The action @hSeek hdl mode i@ sets the position of handle
631 @hdl@ depending on @mode@. If @mode@ is
633 * AbsoluteSeek - The position of @hdl@ is set to @i@.
634 * RelativeSeek - The position of @hdl@ is set to offset @i@ from
635 the current position.
636 * SeekFromEnd - The position of @hdl@ is set to offset @i@ from
639 Some handles may not be seekable (see @hIsSeekable@), or only
640 support a subset of the possible positioning operations (e.g. it may
641 only be possible to seek to the end of a tape, or to a positive
642 offset from the beginning or current position).
644 It is not possible to set a negative I/O position, or for a physical
645 file, an I/O position beyond the current end-of-file.
648 - when seeking using @SeekFromEnd@, positive offsets (>=0) means
649 seeking at or past EOF.
650 - relative seeking on buffered handles can lead to non-obvious results.
653 hSeek :: Handle -> SeekMode -> Integer -> IO ()
655 hSeek handle mode offset =
656 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
657 let fo = haFO__ handle_
658 rc <- mayBlock fo (seekFile fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
660 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
661 hSeek handle mode (J# s# d#) =
662 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
663 let fo = haFO__ handle_
664 rc <- mayBlock fo (seekFile fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
669 constructErrorAndFail "hSeek"
672 whence = case mode of
678 %*********************************************************
680 \subsection[Query]{Handle Properties}
682 %*********************************************************
684 A number of operations return information about the properties of a
685 handle. Each of these operations returns $True$ if the
686 handle has the specified property, and $False$
689 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
690 {\em hdl} is not block-buffered. Otherwise it returns
691 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
692 $( Just n )$ for block-buffering of {\em n} bytes.
695 hIsOpen :: Handle -> IO Bool
697 withHandle_ handle $ \ handle_ -> do
698 case haType__ handle_ of
699 ClosedHandle -> return False
700 SemiClosedHandle -> return False
703 hIsClosed :: Handle -> IO Bool
705 withHandle_ handle $ \ handle_ -> do
706 case haType__ handle_ of
707 ClosedHandle -> return True
710 {- not defined, nor exported, but mentioned
711 here for documentation purposes:
713 hSemiClosed :: Handle -> IO Bool
717 return (not (ho || hc))
720 hIsReadable :: Handle -> IO Bool
722 withHandle_ handle $ \ handle_ -> do
723 case haType__ handle_ of
724 ClosedHandle -> ioe_closedHandle "hIsReadable" handle
725 SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
726 htype -> return (isReadable htype)
728 isReadable ReadHandle = True
729 isReadable ReadWriteHandle = True
732 hIsWritable :: Handle -> IO Bool
734 withHandle_ handle $ \ handle_ -> do
735 case haType__ handle_ of
736 ClosedHandle -> ioe_closedHandle "hIsWritable" handle
737 SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
738 htype -> return (isWritable htype)
740 isWritable AppendHandle = True
741 isWritable WriteHandle = True
742 isWritable ReadWriteHandle = True
746 getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
748 rc <- getBufferMode fo -- ConcHask: SAFE, won't block
750 0 -> return (NoBuffering, 0)
751 -1 -> return (LineBuffering, default_buffer_size)
752 -2 -> return (BlockBuffering Nothing, default_buffer_size)
753 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
754 n -> return (BlockBuffering (Just n), n)
756 default_buffer_size :: Int
757 default_buffer_size = const_BUFSIZ
760 Querying how a handle buffers its data:
763 hGetBuffering :: Handle -> IO BufferMode
764 hGetBuffering handle =
765 withHandle_ handle $ \ handle_ -> do
766 case haType__ handle_ of
767 ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
770 We're being non-standard here, and allow the buffering
771 of a semi-closed handle to be queried. -- sof 6/98
773 return (haBufferMode__ handle_) -- could be stricter..
777 hIsSeekable :: Handle -> IO Bool
779 withHandle_ handle $ \ handle_ -> do
780 case haType__ handle_ of
781 ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
782 SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
783 AppendHandle -> return False
785 rc <- seekFileP (haFO__ handle_) -- ConcHask: SAFE, won't block
789 _ -> constructErrorAndFail "hIsSeekable"
793 %*********************************************************
795 \subsection{Changing echo status}
797 %*********************************************************
799 Non-standard GHC extension is to allow the echoing status
800 of a handles connected to terminals to be reconfigured:
803 hSetEcho :: Handle -> Bool -> IO ()
804 hSetEcho handle on = do
805 isT <- hIsTerminalDevice handle
809 withHandle_ handle $ \ handle_ -> do
810 case haType__ handle_ of
811 ClosedHandle -> ioe_closedHandle "hSetEcho" handle
813 rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
816 else constructErrorAndFail "hSetEcho"
818 hGetEcho :: Handle -> IO Bool
820 isT <- hIsTerminalDevice handle
824 withHandle_ handle $ \ handle_ -> do
825 case haType__ handle_ of
826 ClosedHandle -> ioe_closedHandle "hGetEcho" handle
828 rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
832 _ -> constructErrorAndFail "hSetEcho"
834 hIsTerminalDevice :: Handle -> IO Bool
835 hIsTerminalDevice handle = do
836 withHandle_ handle $ \ handle_ -> do
837 case haType__ handle_ of
838 ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
840 rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
844 _ -> constructErrorAndFail "hIsTerminalDevice"
848 hConnectTerms :: Handle -> Handle -> IO ()
849 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
851 hConnectTo :: Handle -> Handle -> IO ()
852 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
854 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
855 hConnectHdl_ hW hR is_tty =
856 wantRWHandle "hConnectTo" hW $ \ hW_ ->
857 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
858 setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
861 As an extension, we also allow characters to be pushed back.
862 Like ANSI C stdio, we guarantee no more than one character of
863 pushback. (For unbuffered channels, the (default) push-back limit is
867 hUngetChar :: Handle -> Char -> IO ()
868 hUngetChar handle c =
869 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
870 rc <- ungetChar (haFO__ handle_) c -- ConcHask: SAFE, won't block
872 then constructErrorAndFail "hUngetChar"
878 Hoisting files in in one go is sometimes useful, so we support
879 this as an extension:
882 -- in one go, read file into an externally allocated buffer.
883 slurpFile :: FilePath -> IO (Ptr (), Int)
885 handle <- openFile fname ReadMode
886 sz <- hFileSize handle
887 if sz > toInteger (maxBound::Int) then
888 ioError (userError "slurpFile: file too big")
890 let sz_i = fromInteger sz
895 constructErrorAndFail "slurpFile"
897 rc <- withHandle_ handle ( \ handle_ -> do
898 let fo = haFO__ handle_
899 mayBlock fo (readChunk fo chunk 0 sz_i) -- ConcHask: UNSAFE, may block.
903 then constructErrorAndFail "slurpFile"
904 else return (chunk, rc)
908 Sometimes it's useful to get at the file descriptor that
909 the Handle contains..
912 getHandleFd :: Handle -> IO Int
914 withHandle_ handle $ \ handle_ -> do
915 case (haType__ handle_) of
916 ClosedHandle -> ioe_closedHandle "getHandleFd" handle
918 fd <- getFileFd (haFO__ handle_)
923 %*********************************************************
925 \subsection{Miscellaneous}
927 %*********************************************************
929 These three functions are meant to get things out of @IOErrors@.
934 ioeGetFileName :: IOError -> Maybe FilePath
935 ioeGetErrorString :: IOError -> String
936 ioeGetHandle :: IOError -> Maybe Handle
938 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
939 ioeGetHandle (UserError _) = Nothing
940 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
942 ioeGetErrorString (IOException (IOError _ iot _ str _)) =
946 ioeGetErrorString (UserError str) = str
947 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
949 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
950 ioeGetFileName (UserError _) = Nothing
951 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
954 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
955 PrelMain.mainIO) and report them - topHandler is the exception
956 handler they should use for this:
959 -- make sure we handle errors while reporting the error!
960 -- (e.g. evaluating the string passed to 'error' might generate
961 -- another error, etc.)
962 topHandler :: Bool -> Exception -> IO ()
963 topHandler bombOut err = catchException (real_handler bombOut err) (topHandler bombOut)
965 real_handler :: Bool -> Exception -> IO ()
966 real_handler bombOut ex =
968 AsyncException StackOverflow -> reportStackOverflow bombOut
969 ErrorCall s -> reportError bombOut s
970 other -> reportError bombOut (showsPrec 0 other "\n")
972 reportStackOverflow :: Bool -> IO ()
973 reportStackOverflow bombOut = do
974 (hFlush stdout) `catchException` (\ _ -> return ())
975 callStackOverflowHook
981 reportError :: Bool -> String -> IO ()
982 reportError bombOut str = do
983 (hFlush stdout) `catchException` (\ _ -> return ())
984 let bs@(ByteArray _ len _) = packString str
985 writeErrString addrOf_ErrorHdrHook bs len
991 foreign import ccall "addrOf_ErrorHdrHook" unsafe
992 addrOf_ErrorHdrHook :: Ptr ()
994 foreign import ccall "writeErrString__" unsafe
995 writeErrString :: Ptr () -> ByteArray Int -> Int -> IO ()
997 -- SUP: Are the hooks allowed to re-enter Haskell land? If yes, remove the unsafe below.
998 foreign import ccall "stackOverflow" unsafe
999 callStackOverflowHook :: IO ()
1001 foreign import ccall "stg_exit" unsafe
1002 stg_exit :: Int -> IO ()
1006 A number of operations want to get at a readable or writeable handle, and fail
1010 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1011 wantReadableHandle fun handle act =
1012 withHandle_ handle $ \ handle_ -> do
1013 case haType__ handle_ of
1014 ClosedHandle -> ioe_closedHandle fun handle
1015 SemiClosedHandle -> ioe_closedHandle fun handle
1016 AppendHandle -> ioException not_readable_error
1017 WriteHandle -> ioException not_readable_error
1020 not_readable_error =
1021 IOError (Just handle) IllegalOperation fun
1022 "handle is not open for reading" Nothing
1024 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1025 wantWriteableHandle fun handle act =
1026 withHandle_ handle $ \ handle_ ->
1027 checkWriteableHandle fun handle handle_ (act handle_)
1029 wantWriteableHandle_ :: String -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
1030 wantWriteableHandle_ fun handle act =
1031 withHandle handle $ \ handle_ ->
1032 checkWriteableHandle fun handle handle_ (act handle_)
1034 checkWriteableHandle fun handle handle_ act
1035 = case haType__ handle_ of
1036 ClosedHandle -> ioe_closedHandle fun handle
1037 SemiClosedHandle -> ioe_closedHandle fun handle
1038 ReadHandle -> ioException not_writeable_error
1041 not_writeable_error =
1042 IOError (Just handle) IllegalOperation fun
1043 "handle is not open for writing" Nothing
1045 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1046 wantRWHandle fun handle act =
1047 withHandle_ handle $ \ handle_ -> do
1048 case haType__ handle_ of
1049 ClosedHandle -> ioe_closedHandle fun handle
1050 SemiClosedHandle -> ioe_closedHandle fun handle
1053 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1054 wantSeekableHandle fun handle act =
1055 withHandle_ handle $ \ handle_ -> do
1056 case haType__ handle_ of
1057 ClosedHandle -> ioe_closedHandle fun handle
1058 SemiClosedHandle -> ioe_closedHandle fun handle
1062 Internal function for creating an @IOError@ representing the
1063 access to a closed file.
1066 ioe_closedHandle :: String -> Handle -> IO a
1067 ioe_closedHandle fun h = ioException (IOError (Just h) IllegalOperation fun
1068 "handle is closed" Nothing)
1071 Internal helper functions for Concurrent Haskell implementation
1075 mayBlock :: FILE_OBJECT -> IO Int -> IO Int
1076 mayBlock fo act = do
1079 -5 -> do -- (possibly blocking) read
1082 mayBlock fo act -- input available, re-try
1083 -6 -> do -- (possibly blocking) write
1086 mayBlock fo act -- output possible
1087 -7 -> do -- (possibly blocking) write on connected handle
1088 fd <- getConnFileFd fo
1090 mayBlock fo act -- output possible
1099 mayBlockRead :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1100 mayBlockRead fname handle fn = do
1101 r <- wantReadableHandle fname handle $ \ handle_ -> do
1102 let fo = haFO__ handle_
1105 -5 -> do -- (possibly blocking) read
1107 return (BlockRead fd)
1108 -6 -> do -- (possibly blocking) write
1110 return (BlockWrite fd)
1111 -7 -> do -- (possibly blocking) write on connected handle
1112 fd <- getConnFileFd fo
1113 return (BlockWrite fd)
1116 then return (NoBlock rc)
1117 else constructErrorAndFail fname
1121 mayBlockRead fname handle fn
1124 mayBlockRead fname handle fn
1125 NoBlock c -> return c
1127 mayBlockRead' :: String -> Handle
1128 -> (FILE_OBJECT -> IO Int)
1129 -> (FILE_OBJECT -> Int -> IO a)
1131 mayBlockRead' fname handle fn io = do
1132 r <- wantReadableHandle fname handle $ \ handle_ -> do
1133 let fo = haFO__ handle_
1136 -5 -> do -- (possibly blocking) read
1138 return (BlockRead fd)
1139 -6 -> do -- (possibly blocking) write
1141 return (BlockWrite fd)
1142 -7 -> do -- (possibly blocking) write on connected handle
1143 fd <- getConnFileFd fo
1144 return (BlockWrite fd)
1147 then do a <- io fo rc
1149 else constructErrorAndFail fname
1153 mayBlockRead' fname handle fn io
1156 mayBlockRead' fname handle fn io
1157 NoBlock c -> return c
1159 mayBlockWrite :: String -> Handle -> (FILE_OBJECT -> IO Int) -> IO Int
1160 mayBlockWrite fname handle fn = do
1161 r <- wantWriteableHandle fname handle $ \ handle_ -> do
1162 let fo = haFO__ handle_
1165 -5 -> do -- (possibly blocking) read
1167 return (BlockRead fd)
1168 -6 -> do -- (possibly blocking) write
1170 return (BlockWrite fd)
1171 -7 -> do -- (possibly blocking) write on connected handle
1172 fd <- getConnFileFd fo
1173 return (BlockWrite fd)
1176 then return (NoBlock rc)
1177 else constructErrorAndFail fname
1181 mayBlockWrite fname handle fn
1184 mayBlockWrite fname handle fn
1185 NoBlock c -> return c
1188 Foreign import declarations of helper functions:
1193 type Bytes = PrimByteArray RealWorld
1195 type Bytes = ByteArray#
1198 foreign import "libHS_cbits" "inputReady" unsafe
1199 inputReady :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1200 foreign import "libHS_cbits" "fileGetc" unsafe
1201 fileGetc :: FILE_OBJECT -> IO Int
1202 foreign import "libHS_cbits" "fileLookAhead" unsafe
1203 fileLookAhead :: FILE_OBJECT -> IO Int
1204 foreign import "libHS_cbits" "readBlock" unsafe
1205 readBlock :: FILE_OBJECT -> IO Int
1206 foreign import "libHS_cbits" "readLine" unsafe
1207 readLine :: FILE_OBJECT -> IO Int
1208 foreign import "libHS_cbits" "readChar" unsafe
1209 readChar :: FILE_OBJECT -> IO Int
1210 foreign import "libHS_cbits" "writeFileObject" unsafe
1211 writeFileObject :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1212 foreign import "libHS_cbits" "filePutc" unsafe
1213 filePutc :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1214 foreign import "libHS_cbits" "write_" unsafe
1215 write_ :: FILE_OBJECT -> Ptr () -> Int -> IO Int{-ret code-}
1216 foreign import "libHS_cbits" "getBufStart" unsafe
1217 getBufStart :: FILE_OBJECT -> Int -> IO (Ptr ())
1218 foreign import "libHS_cbits" "getWriteableBuf" unsafe
1219 getWriteableBuf :: FILE_OBJECT -> IO (Ptr ())
1220 foreign import "libHS_cbits" "getBuf" unsafe
1221 getBuf :: FILE_OBJECT -> IO (Ptr ())
1222 foreign import "libHS_cbits" "getBufWPtr" unsafe
1223 getBufWPtr :: FILE_OBJECT -> IO Int
1224 foreign import "libHS_cbits" "setBufWPtr" unsafe
1225 setBufWPtr :: FILE_OBJECT -> Int -> IO ()
1226 foreign import "libHS_cbits" "closeFile" unsafe
1227 closeFile :: FILE_OBJECT -> Int{-Flush-} -> IO Int{-ret code-}
1228 foreign import "libHS_cbits" "fileEOF" unsafe
1229 fileEOF :: FILE_OBJECT -> IO Int{-ret code-}
1230 foreign import "libHS_cbits" "setBuffering" unsafe
1231 setBuffering :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1232 foreign import "libHS_cbits" "flushFile" unsafe
1233 flushFile :: FILE_OBJECT -> IO Int{-ret code-}
1234 foreign import "libHS_cbits" "flushConnectedBuf" unsafe
1235 flushConnectedBuf :: FILE_OBJECT -> IO ()
1236 foreign import "libHS_cbits" "getBufferMode" unsafe
1237 getBufferMode :: FILE_OBJECT -> IO Int{-ret code-}
1239 foreign import "libHS_cbits" "seekFile_int64" unsafe
1240 seekFile :: FILE_OBJECT -> Int -> Int64 -> IO Int
1242 foreign import "libHS_cbits" "seekFile" unsafe
1243 seekFile :: FILE_OBJECT -> Int -> Int -> Bytes -> IO Int
1246 foreign import "libHS_cbits" "seekFileP" unsafe
1247 seekFileP :: FILE_OBJECT -> IO Int{-ret code-}
1248 foreign import "libHS_cbits" "setTerminalEcho" unsafe
1249 setTerminalEcho :: FILE_OBJECT -> Int -> IO Int{-ret code-}
1250 foreign import "libHS_cbits" "getTerminalEcho" unsafe
1251 getTerminalEcho :: FILE_OBJECT -> IO Int{-ret code-}
1252 foreign import "libHS_cbits" "isTerminalDevice" unsafe
1253 isTerminalDevice :: FILE_OBJECT -> IO Int{-ret code-}
1254 foreign import "libHS_cbits" "setConnectedTo" unsafe
1255 setConnectedTo :: FILE_OBJECT -> FILE_OBJECT -> Int -> IO ()
1256 foreign import "libHS_cbits" "ungetChar" unsafe
1257 ungetChar :: FILE_OBJECT -> Char -> IO Int{-ret code-}
1258 foreign import "libHS_cbits" "readChunk" unsafe
1259 readChunk :: FILE_OBJECT -> Ptr 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-}
1281 -> IO (Ptr ()){-file object-}
1282 foreign import "libHS_cbits" "openFile" unsafe
1283 primOpenFile :: ByteArray Int{-CString-}
1286 -> IO (Ptr ()){-file object-}
1287 foreign import "libHS_cbits" "const_BUFSIZ" unsafe
1290 foreign import "libHS_cbits" "setBinaryMode__" unsafe
1291 setBinaryMode :: FILE_OBJECT -> Int -> IO Int