2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelHandle]{Module @PrelHandle@}
7 This module defines Haskell {\em handles} and the basic operations
8 which are supported for them.
11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
12 #include "cbits/error.h"
14 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
15 module PrelHandle where
18 import PrelArr ( newVar, readVar, writeVar, ByteArray )
19 import PrelRead ( Read )
20 import PrelList ( span )
22 import PrelException ( throw, ioError, catchException )
23 import PrelMaybe ( Maybe(..) )
24 import PrelAddr ( Addr, nullAddr )
25 import PrelBounded () -- get at Bounded Int instance.
26 import PrelNum ( toInteger )
27 import PrelWeak ( addForeignFinaliser )
28 #if __CONCURRENT_HASKELL__
33 #ifndef __PARALLEL_HASKELL__
34 import PrelForeign ( makeForeignObj )
37 #endif /* ndef(__HUGS__) */
40 #define cat2(x,y) x/**/y
41 #define CCALL(fun) cat2(prim_,fun)
42 #define __CONCURRENT_HASKELL__
44 #define sizeof_int64 8
46 #define CCALL(fun) _ccall_ fun
47 #define const_BUFSIZ ``BUFSIZ''
48 #define primPackString
51 #ifndef __PARALLEL_HASKELL__
52 #define FILE_OBJECT ForeignObj
54 #define FILE_OBJECT Addr
59 %*********************************************************
61 \subsection{Types @Handle@, @Handle__@}
63 %*********************************************************
65 The @Handle@ and @Handle__@ types are defined in @IOBase@.
68 {-# INLINE newHandle #-}
69 {-# INLINE withHandle #-}
70 {-# INLINE writeHandle #-}
71 newHandle :: Handle__ -> IO Handle
72 withHandle :: Handle -> (Handle__ -> IO a) -> IO a
73 writeHandle :: Handle -> Handle__ -> IO ()
75 #if defined(__CONCURRENT_HASKELL__)
77 -- Use MVars for concurrent Haskell
78 newHandle hc = newMVar hc >>= \ h ->
81 -- withHandle grabs the handle lock, performs
82 -- some operation over it, making sure that we
83 -- unlock & reset the handle state should an
84 -- exception occur while performing said op.
85 withHandle (Handle h) act = do
87 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
90 writeHandle (Handle h) hc = putMVar h hc
93 -- Use ordinary MutableVars for non-concurrent Haskell
94 newHandle hc = stToIO (newVar hc >>= \ h ->
97 -- of questionable value to install this exception
98 -- handler, but let's do it in the non-concurrent
100 withHandle (Handle h) act = do
101 h_ <- stToIO (readVar h)
102 v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
105 writeHandle (Handle h) hc = stToIO (writeVar h hc)
110 nullFile__ is only used for closed handles, plugging it in as a null
111 file object reference.
114 nullFile__ :: FILE_OBJECT
116 #ifndef __PARALLEL_HASKELL__
117 unsafePerformIO (makeForeignObj nullAddr)
123 mkClosedHandle__ :: Handle__
131 mkErrorHandle__ :: IOError -> Handle__
132 mkErrorHandle__ ioe =
140 %*********************************************************
142 \subsection{Handle Finalisers}
144 %*********************************************************
148 freeStdFileObject :: ForeignObj -> IO ()
149 freeStdFileObject fo = CCALL(freeStdFileObject) fo
151 freeFileObject :: ForeignObj -> IO ()
152 freeFileObject fo = CCALL(freeFileObject) fo
154 foreign import stdcall "libHS_cbits.so" "freeStdFileObject" freeStdFileObject :: ForeignObj -> IO ()
155 foreign import stdcall "libHS_cbits.so" "freeFileObject" freeFileObject :: ForeignObj -> IO ()
159 %*********************************************************
161 \subsection[StdHandles]{Standard handles}
163 %*********************************************************
165 Three handles are allocated during program initialisation. The first
166 two manage input or output from the Haskell program's standard input
167 or output channel respectively. The third manages output to the
168 standard error channel. These handles are initially open.
172 stdin, stdout, stderr :: Handle
174 stdout = unsafePerformIO (do
175 rc <- CCALL(getLock) (1::Int) (1::Int) -- ConcHask: SAFE, won't block
177 0 -> newHandle (mkClosedHandle__)
179 #ifndef __CONCURRENT_HASKELL__
180 fo <- CCALL(openStdFile) (1::Int)
181 (1::Int){-flush on close-}
182 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
184 fo <- CCALL(openStdFile) (1::Int)
185 ((1{-flush on close-} {-+ 128 don't block on I/O-})::Int)
186 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
188 -- NOTE: turn off non-blocking I/O until
189 -- we've got proper support for threadWait{Read,Write}
191 #ifndef __PARALLEL_HASKELL__
192 fo <- makeForeignObj fo
193 addForeignFinaliser 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 <- CCALL(getLock) (0::Int) (0::Int) -- ConcHask: SAFE, won't block
213 0 -> newHandle (mkClosedHandle__)
215 #ifndef __CONCURRENT_HASKELL__
216 fo <- CCALL(openStdFile) (0::Int)
217 (0::Int){-don't flush on close -}
218 (1::Int){-readable-} -- ConcHask: SAFE, won't block
220 fo <- CCALL(openStdFile) (0::Int)
221 ((0{-flush on close-} {-+ 128 don't block on I/O-})::Int)
222 (1::Int){-readable-} -- ConcHask: SAFE, won't block
225 #ifndef __PARALLEL_HASKELL__
226 fo <- makeForeignObj fo
227 addForeignFinaliser fo (freeStdFileObject fo)
229 (bm, bf_size) <- getBMode__ fo
230 mkBuffer__ fo bf_size
231 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
232 -- when stdin and stdout are both connected to a terminal, ensure
233 -- that anything buffered on stdout is flushed prior to reading from stdin.
235 hConnectTerms stdout hdl
237 _ -> do ioError <- constructError "stdin"
238 newHandle (mkErrorHandle__ ioError)
242 stderr = unsafePerformIO (do
243 rc <- CCALL(getLock) (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
245 0 -> newHandle (mkClosedHandle__)
247 #ifndef __CONCURRENT_HASKELL__
248 fo <- CCALL(openStdFile) (2::Int)
249 (1::Int){-flush on close-}
250 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
252 fo <- CCALL(openStdFile) (2::Int)
253 ((1{-flush on close-} {- + 128 don't block on I/O-})::Int)
254 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
257 #ifndef __PARALLEL_HASKELL__
258 fo <- makeForeignObj fo
259 addForeignFinaliser fo (freeStdFileObject fo)
261 newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
262 _ -> do ioError <- constructError "stderr"
263 newHandle (mkErrorHandle__ ioError)
267 %*********************************************************
269 \subsection[OpeningClosing]{Opening and Closing Files}
271 %*********************************************************
274 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
275 deriving (Eq, Ord, Ix, Enum, Read, Show)
280 deriving (Eq, Read, Show)
282 openFile :: FilePath -> IOMode -> IO Handle
283 openFile fp im = openFileEx fp (TextMode im)
285 openFileEx :: FilePath -> IOModeEx -> IO Handle
288 fo <- CCALL(openFile) (primPackString f) (file_mode::Int)
290 (file_flags::Int) -- ConcHask: SAFE, won't block
291 if fo /= nullAddr then do
292 #ifndef __PARALLEL_HASKELL__
293 fo <- makeForeignObj fo
294 addForeignFinaliser fo (freeFileObject fo)
296 (bm, bf_size) <- getBMode__ fo
297 mkBuffer__ fo bf_size
298 newHandle (Handle__ fo htype bm f)
300 constructErrorAndFailWithInfo "openFile" f
304 BinaryMode bmo -> (bmo, 1)
305 TextMode tmo -> (tmo, 0)
307 #ifndef __CONCURRENT_HASKELL__
308 file_flags = file_flags'
310 file_flags = file_flags' {-+ 128 Don't block on I/O-}
313 (file_flags', file_mode) =
318 ReadWriteMode -> (1, 3)
321 ReadMode -> ReadHandle
322 WriteMode -> WriteHandle
323 AppendMode -> AppendHandle
324 ReadWriteMode -> ReadWriteHandle
327 Computation $openFile file mode$ allocates and returns a new, open
328 handle to manage the file {\em file}. It manages input if {\em mode}
329 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
330 and both input and output if mode is $ReadWriteMode$.
332 If the file does not exist and it is opened for output, it should be
333 created as a new file. If {\em mode} is $WriteMode$ and the file
334 already exists, then it should be truncated to zero length. The
335 handle is positioned at the end of the file if {\em mode} is
336 $AppendMode$, and otherwise at the beginning (in which case its
337 internal position is 0).
339 Implementations should enforce, locally to the Haskell process,
340 multiple-reader single-writer locking on files, which is to say that
341 there may either be many handles on the same file which manage input,
342 or just one handle on the file which manages output. If any open or
343 semi-closed handle is managing a file for output, no new handle can be
344 allocated for that file. If any open or semi-closed handle is
345 managing a file for input, new handles can only be allocated if they
346 do not manage output.
348 Two files are the same if they have the same absolute name. An
349 implementation is free to impose stricter conditions.
352 hClose :: Handle -> IO ()
355 withHandle handle $ \ handle_ -> do
356 case haType__ handle_ of
357 ErrorHandle theError -> do
358 writeHandle handle handle_
361 writeHandle handle handle_
362 ioe_closedHandle "hClose" handle
364 rc <- CCALL(closeFile) (haFO__ handle_) (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
365 {- We explicitly close a file object so that we can be told
366 if there were any errors. Note that after @hClose@
367 has been performed, the ForeignObj embedded in the Handle
368 is still lying around in the heap, so care is taken
369 to avoid closing the file object when the ForeignObj
370 is finalised. (we overwrite the file ptr in the underlying
371 FileObject with a NULL as part of closeFile())
375 writeHandle handle (handle_{ haType__ = ClosedHandle,
376 haFO__ = nullFile__ })
378 writeHandle handle handle_
379 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 -> do
404 writeHandle handle handle_
407 writeHandle handle handle_
408 ioe_closedHandle "hFileSize" handle
409 SemiClosedHandle -> do
410 writeHandle handle handle_
411 ioe_closedHandle "hFileSize" handle
414 mem <- primNewByteArray sizeof_int64
415 rc <- CCALL(fileSize_int64) (haFO__ handle_) mem -- ConcHask: SAFE, won't block
416 writeHandle handle handle_
418 result <- primReadInt64Array mem 0
419 return (primInt64ToInteger result)
421 constructErrorAndFail "hFileSize"
424 -- HACK! We build a unique MP_INT of the right shape to hold
425 -- a single unsigned word, and we let the C routine
426 -- change the data bits
428 -- For some reason, this fails to typecheck if converted to a do
430 _casm_ ``%r = 1;'' >>= \(I# hack#) ->
431 case int2Integer hack# of
432 result@(J# _ _ d#) -> do
433 rc <- CCALL(fileSize) (haFO__ handle_) d# -- ConcHask: SAFE, won't block
434 writeHandle handle handle_
435 if rc == (0::Int) then
438 constructErrorAndFail "hFileSize"
442 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
443 @True@ if no further input can be taken from @hdl@ or for a
444 physical file, if the current I/O position is equal to the length of
445 the file. Otherwise, it returns @False@.
448 hIsEOF :: Handle -> IO Bool
450 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
451 let fo = haFO__ handle_
452 rc <- mayBlock fo (CCALL(fileEOF) fo) -- ConcHask: UNSAFE, may block
453 writeHandle handle handle_
457 _ -> constructErrorAndFail "hIsEOF"
463 %*********************************************************
465 \subsection[Buffering]{Buffering Operations}
467 %*********************************************************
469 Three kinds of buffering are supported: line-buffering,
470 block-buffering or no-buffering. See @IOBase@ for definition
471 and further explanation of what the type represent.
473 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
474 handle {\em hdl} on subsequent reads and writes.
478 If {\em mode} is @LineBuffering@, line-buffering should be
481 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
482 should be enabled if possible. The size of the buffer is {\em n} items
483 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
485 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
488 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
489 to @NoBuffering@, then any items in the output buffer are written to
490 the device, and any items in the input buffer are discarded. The
491 default buffering mode when a handle is opened is
492 implementation-dependent and may depend on the object which is
493 attached to that handle.
496 hSetBuffering :: Handle -> BufferMode -> IO ()
498 hSetBuffering handle mode =
500 BlockBuffering (Just n)
502 (IOError (Just handle)
505 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
507 withHandle handle $ \ handle_ -> do
508 case haType__ handle_ of
509 ErrorHandle theError -> do
510 writeHandle handle handle_
513 writeHandle handle handle_
514 ioe_closedHandle "hSetBuffering" handle
517 - we flush the old buffer regardless of whether
518 the new buffer could fit the contents of the old buffer
520 - allow a handle's buffering to change even if IO has
521 occurred (ANSI C spec. does not allow this, nor did
522 the previous implementation of IO.hSetBuffering).
523 - a non-standard extension is to allow the buffering
524 of semi-closed handles to change [sof 6/98]
526 let fo = haFO__ handle_
527 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
530 writeHandle handle (handle_{ haBufferMode__ = mode })
532 -- Note: failure to change the buffer size will cause old buffer to be flushed.
533 writeHandle handle handle_
534 constructErrorAndFail "hSetBuffering"
540 BlockBuffering Nothing -> -2
541 BlockBuffering (Just n) -> n
544 The action @hFlush hdl@ causes any items buffered for output
545 in handle {\em hdl} to be sent immediately to the operating
549 hFlush :: Handle -> IO ()
551 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
552 let fo = haFO__ handle_
553 rc <- mayBlock fo (CCALL(flushFile) fo) -- ConcHask: UNSAFE, may block
554 writeHandle handle handle_
558 constructErrorAndFail "hFlush"
563 %*********************************************************
565 \subsection[Seeking]{Repositioning Handles}
567 %*********************************************************
572 Handle -- Q: should this be a weak or strong ref. to the handle?
575 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
576 deriving (Eq, Ord, Ix, Enum, Read, Show)
579 Computation @hGetPosn hdl@ returns the current I/O
580 position of {\em hdl} as an abstract position. Computation
581 $hSetPosn p$ sets the position of {\em hdl}
582 to a previously obtained position {\em p}.
585 hGetPosn :: Handle -> IO HandlePosn
587 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
588 posn <- CCALL(getFilePosn) (haFO__ handle_) -- ConcHask: SAFE, won't block
589 writeHandle handle handle_
591 return (HandlePosn handle posn)
593 constructErrorAndFail "hGetPosn"
595 hSetPosn :: HandlePosn -> IO ()
596 hSetPosn (HandlePosn handle posn) =
597 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
598 let fo = haFO__ handle_
599 rc <- mayBlock fo (CCALL(setFilePosn) fo posn) -- ConcHask: UNSAFE, may block
600 writeHandle handle handle_
604 constructErrorAndFail "hSetPosn"
607 The action @hSeek hdl mode i@ sets the position of handle
608 @hdl@ depending on @mode@. If @mode@ is
610 \item[{\bf AbsoluteSeek}] The position of @hdl@ is set to @i@.
611 \item[{\bf RelativeSeek}] The position of @hdl@ is set to offset @i@ from
612 the current position.
613 \item[{\bf SeekFromEnd}] The position of @hdl@ is set to offset @i@ from
617 Some handles may not be seekable (see @hIsSeekable@), or only support a
618 subset of the possible positioning operations (e.g. it may only be
619 possible to seek to the end of a tape, or to a positive offset from
620 the beginning or current position).
622 It is not possible to set a negative I/O position, or for a physical
623 file, an I/O position beyond the current end-of-file.
626 - when seeking using @SeekFromEnd@, positive offsets (>=0) means seeking
628 - relative seeking on buffered handles can lead to non-obvious results.
631 hSeek :: Handle -> SeekMode -> Integer -> IO ()
633 hSeek handle mode offset =
634 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
635 let fo = haFO__ handle_
636 rc <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
638 hSeek handle mode (J# _ s# d#) =
639 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
640 let fo = haFO__ handle_
641 rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
643 writeHandle handle handle_
647 constructErrorAndFail "hSeek"
650 whence = case mode of
656 %*********************************************************
658 \subsection[Query]{Handle Properties}
660 %*********************************************************
662 A number of operations return information about the properties of a
663 handle. Each of these operations returns $True$ if the
664 handle has the specified property, and $False$
667 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
668 {\em hdl} is not block-buffered. Otherwise it returns
669 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
670 $( Just n )$ for block-buffering of {\em n} bytes.
673 hIsOpen :: Handle -> IO Bool
675 withHandle handle $ \ handle_ -> do
676 case haType__ handle_ of
677 ErrorHandle theError -> do
678 writeHandle handle handle_
681 writeHandle handle handle_
683 SemiClosedHandle -> do
684 writeHandle handle handle_
687 writeHandle handle handle_
690 hIsClosed :: Handle -> IO Bool
692 withHandle handle $ \ handle_ -> do
693 case haType__ handle_ of
694 ErrorHandle theError -> do
695 writeHandle handle handle_
698 writeHandle handle handle_
701 writeHandle handle handle_
704 {- not defined, nor exported, but mentioned
705 here for documentation purposes:
707 hSemiClosed :: Handle -> IO Bool
711 return (not (ho || hc))
714 hIsReadable :: Handle -> IO Bool
716 withHandle handle $ \ handle_ -> do
717 case haType__ handle_ of
718 ErrorHandle theError -> do
719 writeHandle handle handle_
722 writeHandle handle handle_
723 ioe_closedHandle "hIsReadable" handle
724 SemiClosedHandle -> do
725 writeHandle handle handle_
726 ioe_closedHandle "hIsReadable" handle
728 writeHandle handle handle_
729 return (isReadable htype)
731 isReadable ReadHandle = True
732 isReadable ReadWriteHandle = True
735 hIsWritable :: Handle -> IO Bool
737 withHandle handle $ \ handle_ -> do
738 case haType__ handle_ of
739 ErrorHandle theError -> do
740 writeHandle handle handle_
743 writeHandle handle handle_
744 ioe_closedHandle "hIsWritable" handle
745 SemiClosedHandle -> do
746 writeHandle handle handle_
747 ioe_closedHandle "hIsWritable" handle
749 writeHandle handle handle_
750 return (isWritable htype)
752 isWritable AppendHandle = True
753 isWritable WriteHandle = True
754 isWritable ReadWriteHandle = True
758 #ifndef __PARALLEL_HASKELL__
759 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
761 getBMode__ :: Addr -> IO (BufferMode, Int)
764 rc <- CCALL(getBufferMode) fo -- ConcHask: SAFE, won't block
766 0 -> return (NoBuffering, 0)
767 -1 -> return (LineBuffering, default_buffer_size)
768 -2 -> return (BlockBuffering Nothing, default_buffer_size)
769 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
770 n -> return (BlockBuffering (Just n), n)
772 default_buffer_size :: Int
773 default_buffer_size = (const_BUFSIZ - 1)
776 Querying how a handle buffers its data:
779 hGetBuffering :: Handle -> IO BufferMode
780 hGetBuffering handle =
781 withHandle handle $ \ handle_ -> do
782 case haType__ handle_ of
783 ErrorHandle theError -> do
784 writeHandle handle handle_
787 writeHandle handle handle_
788 ioe_closedHandle "hGetBuffering" handle
791 We're being non-standard here, and allow the buffering
792 of a semi-closed handle to be queried. -- sof 6/98
794 let v = haBufferMode__ handle_
795 writeHandle handle handle_
796 return v -- could be stricter..
801 hIsSeekable :: Handle -> IO Bool
803 withHandle handle $ \ handle_ -> do
804 case haType__ handle_ of
805 ErrorHandle theError -> do
806 writeHandle handle handle_
809 writeHandle handle handle_
810 ioe_closedHandle "hIsSeekable" handle
811 SemiClosedHandle -> do
812 writeHandle handle handle_
813 ioe_closedHandle "hIsSeekable" handle
815 writeHandle handle handle_
818 rc <- CCALL(seekFileP) (haFO__ handle_) -- ConcHask: SAFE, won't block
819 writeHandle handle handle_
823 _ -> constructErrorAndFail "hIsSeekable"
827 %*********************************************************
829 \subsection{Changing echo status}
831 %*********************************************************
833 Non-standard GHC extension is to allow the echoing status
834 of a handles connected to terminals to be reconfigured:
837 hSetEcho :: Handle -> Bool -> IO ()
838 hSetEcho handle on = do
839 isT <- hIsTerminalDevice handle
843 withHandle handle $ \ handle_ -> do
844 case haType__ handle_ of
845 ErrorHandle theError -> do
846 writeHandle handle handle_
849 writeHandle handle handle_
850 ioe_closedHandle "hSetEcho" handle
852 rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int) -- ConcHask: SAFE, won't block
853 writeHandle handle handle_
856 else constructErrorAndFail "hSetEcho"
858 hGetEcho :: Handle -> IO Bool
860 isT <- hIsTerminalDevice handle
864 withHandle handle $ \ handle_ -> do
865 case haType__ handle_ of
866 ErrorHandle theError -> do
867 writeHandle handle handle_
870 writeHandle handle handle_
871 ioe_closedHandle "hGetEcho" handle
873 rc <- CCALL(getTerminalEcho) (haFO__ handle_) -- ConcHask: SAFE, won't block
874 writeHandle handle handle_
878 _ -> constructErrorAndFail "hSetEcho"
880 hIsTerminalDevice :: Handle -> IO Bool
881 hIsTerminalDevice handle = do
882 withHandle handle $ \ handle_ -> do
883 case haType__ handle_ of
884 ErrorHandle theError -> do
885 writeHandle handle handle_
888 writeHandle handle handle_
889 ioe_closedHandle "hIsTerminalDevice" handle
891 rc <- CCALL(isTerminalDevice) (haFO__ handle_) -- ConcHask: SAFE, won't block
892 writeHandle handle handle_
896 _ -> constructErrorAndFail "hIsTerminalDevice"
900 hConnectTerms :: Handle -> Handle -> IO ()
901 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
903 hConnectTo :: Handle -> Handle -> IO ()
904 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
906 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
907 hConnectHdl_ hW hR is_tty =
908 wantWriteableHandle "hConnectTo" hW $ \ hW_ -> do
909 wantReadableHandle "hConnectTo" hR $ \ hR_ -> do
910 CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
916 As an extension, we also allow characters to be pushed back.
917 Like ANSI C stdio, we guarantee no more than one character of
918 pushback. (For unbuffered channels, the (default) push-back limit is
922 hUngetChar :: Handle -> Char -> IO ()
923 hUngetChar handle c =
924 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
925 rc <- CCALL(ungetChar) (haFO__ handle_) c -- ConcHask: SAFE, won't block
926 writeHandle handle handle_
928 then constructErrorAndFail "hUngetChar"
934 Hoisting files in in one go is sometimes useful, so we support
935 this as an extension:
938 -- in one go, read file into an externally allocated buffer.
939 slurpFile :: FilePath -> IO (Addr, Int)
941 handle <- openFile fname ReadMode
942 sz <- hFileSize handle
943 if sz > toInteger (maxBound::Int) then
944 ioError (userError "slurpFile: file too big")
946 let sz_i = fromInteger sz
947 chunk <- CCALL(allocMemory__) (sz_i::Int)
951 constructErrorAndFail "slurpFile"
953 withHandle handle $ \ handle_ -> do
954 let fo = haFO__ handle_
955 rc <- mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
956 writeHandle handle handle_
959 then constructErrorAndFail "slurpFile"
960 else return (chunk, rc)
962 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
963 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
964 hFillBufBA handle buf sz
965 | sz <= 0 = ioError (IOError (Just handle)
968 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
970 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
971 let fo = haFO__ handle_
973 rc <- mayBlock fo (CCALL(readChunkBA) fo buf sz) -- ConcHask: UNSAFE, may block.
975 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
977 writeHandle handle handle_
980 else constructErrorAndFail "hFillBufBA"
983 hFillBuf :: Handle -> Addr -> Int -> IO Int
984 hFillBuf handle buf sz
985 | sz <= 0 = ioError (IOError (Just handle)
988 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
990 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
991 let fo = haFO__ handle_
992 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
993 writeHandle handle handle_
996 else constructErrorAndFail "hFillBuf"
1000 The @hPutBuf hdl buf len@ action writes an already packed sequence of
1001 bytes to the file/channel managed by @hdl@ - non-standard.
1004 hPutBuf :: Handle -> Addr -> Int -> IO ()
1005 hPutBuf handle buf len =
1006 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
1007 let fo = haFO__ handle_
1008 rc <- mayBlock fo (CCALL(writeBuf) fo buf len) -- ConcHask: UNSAFE, may block.
1009 writeHandle handle handle_
1012 else constructErrorAndFail "hPutBuf"
1014 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
1015 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
1016 hPutBufBA handle buf len =
1017 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
1018 let fo = haFO__ handle_
1019 rc <- mayBlock fo (CCALL(writeBufBA) fo buf len) -- ConcHask: UNSAFE, may block.
1020 writeHandle handle handle_
1023 else constructErrorAndFail "hPutBuf"
1027 Sometimes it's useful to get at the file descriptor that
1028 the Handle contains..
1031 getHandleFd :: Handle -> IO Int
1032 getHandleFd handle = do
1033 withHandle handle $ \ handle_ -> do
1034 case (haType__ handle_) of
1035 ErrorHandle theError -> do
1036 writeHandle handle handle_
1039 writeHandle handle handle_
1040 ioe_closedHandle "getHandleFd" handle
1042 fd <- CCALL(getFileFd) (haFO__ handle_)
1043 writeHandle handle handle_
1048 %*********************************************************
1050 \subsection{Miscellaneous}
1052 %*********************************************************
1054 These three functions are meant to get things out of @IOErrors@.
1059 ioeGetFileName :: IOError -> Maybe FilePath
1060 ioeGetErrorString :: IOError -> String
1061 ioeGetHandle :: IOError -> Maybe Handle
1063 ioeGetHandle (IOError h _ _ _) = h
1064 ioeGetErrorString (IOError _ iot _ str) =
1066 EOF -> "end of file"
1069 ioeGetFileName (IOError _ _ _ str) =
1070 case span (/=':') str of
1076 A number of operations want to get at a readable or writeable handle, and fail
1080 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1081 wantReadableHandle fun handle act =
1082 withHandle handle $ \ handle_ -> do
1083 case haType__ handle_ of
1084 ErrorHandle theError -> do
1085 writeHandle handle handle_
1088 writeHandle handle handle_
1089 ioe_closedHandle fun handle
1090 SemiClosedHandle -> do
1091 writeHandle handle handle_
1092 ioe_closedHandle fun handle
1094 writeHandle handle handle_
1095 ioError not_readable_error
1097 writeHandle handle handle_
1098 ioError not_readable_error
1101 not_readable_error =
1102 IOError (Just handle) IllegalOperation fun
1103 ("handle is not open for reading")
1105 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1106 wantWriteableHandle fun handle act =
1107 withHandle handle $ \ handle_ -> do
1108 case haType__ handle_ of
1109 ErrorHandle theError -> do
1110 writeHandle handle handle_
1113 writeHandle handle handle_
1114 ioe_closedHandle fun handle
1115 SemiClosedHandle -> do
1116 writeHandle handle handle_
1117 ioe_closedHandle fun handle
1119 writeHandle handle handle_
1120 ioError not_writeable_error
1123 not_writeable_error =
1124 IOError (Just handle) IllegalOperation fun
1125 ("handle is not open for writing")
1127 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1128 wantSeekableHandle fun handle act =
1129 withHandle handle $ \ handle_ -> do
1130 case haType__ handle_ of
1131 ErrorHandle theError -> do
1132 writeHandle handle handle_
1135 writeHandle handle handle_
1136 ioe_closedHandle fun handle
1137 SemiClosedHandle -> do
1138 writeHandle handle handle_
1139 ioe_closedHandle fun handle
1141 writeHandle handle handle_
1142 ioError not_seekable_error
1145 not_seekable_error =
1146 IOError (Just handle)
1147 IllegalOperation fun
1148 ("handle is not seekable")
1152 Internal function for creating an @IOError@ representing the
1153 access to a closed file.
1156 ioe_closedHandle :: String -> Handle -> IO a
1157 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1160 Internal helper functions for Concurrent Haskell implementation
1164 #ifndef __PARALLEL_HASKELL__
1165 mayBlock :: ForeignObj -> IO Int -> IO Int
1167 mayBlock :: Addr -> IO Int -> IO Int
1170 #ifndef notyet /*__CONCURRENT_HASKELL__*/
1171 mayBlock _ act = act
1173 mayBlock fo act = do
1176 -5 -> do -- (possibly blocking) read
1177 fd <- CCALL(getFileFd) fo
1179 CCALL(clearNonBlockingIOFlag__) fo -- force read to happen this time.
1180 mayBlock fo act -- input available, re-try
1181 -6 -> do -- (possibly blocking) write
1182 fd <- CCALL(getFileFd) fo
1184 CCALL(clearNonBlockingIOFlag__) fo -- force write to happen this time.
1185 mayBlock fo act -- output possible
1186 -7 -> do -- (possibly blocking) write on connected handle
1187 fd <- CCALL(getConnFileFd) fo
1189 CCALL(clearConnNonBlockingIOFlag__) fo -- force write to happen this time.
1190 mayBlock fo act -- output possible
1192 CCALL(setNonBlockingIOFlag__) fo -- reset file object.
1193 CCALL(setConnNonBlockingIOFlag__) fo -- reset (connected) file object.
1200 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
1202 -- Hugs does actually have the primops needed to implement these
1203 -- but, like GHC, the primops don't actually do anything...
1204 threadDelay _ = return ()
1205 threadWaitRead _ = return ()
1206 threadWaitWrite _ = return ()
1215 type Exclusive = Int -- really Bool
1218 type OpenStdFlags = Int
1219 type OpenFlags = Int
1220 type Readable = Int -- really Bool
1221 type Flush = Int -- really Bool
1222 type RC = Int -- standard return code
1224 type IOFileAddr = Addr -- as returned from functions
1225 type CString = PrimByteArray
1226 type Bytes = PrimMutableByteArray RealWorld
1228 #ifndef __PARALLEL_HASKELL__
1229 type FILE_OBJ = ForeignObj -- as passed into functions
1231 type FILE_OBJ = Addr
1234 foreign import ccall "libHS_cbits.so" "setBuf" unsafe prim_setBuf :: FILE_OBJ -> Addr -> Int -> IO ()
1235 foreign import ccall "libHS_cbits.so" "getBufSize" unsafe prim_getBufSize :: FILE_OBJ -> IO Int
1236 foreign import ccall "libHS_cbits.so" "inputReady" unsafe prim_inputReady :: FILE_OBJ -> Int -> IO RC
1237 foreign import ccall "libHS_cbits.so" "fileGetc" unsafe prim_fileGetc :: FILE_OBJ -> IO Int
1238 foreign import ccall "libHS_cbits.so" "fileLookAhead" unsafe prim_fileLookAhead :: FILE_OBJ -> IO Int
1239 foreign import ccall "libHS_cbits.so" "readBlock" unsafe prim_readBlock :: FILE_OBJ -> IO Int
1240 foreign import ccall "libHS_cbits.so" "readLine" unsafe prim_readLine :: FILE_OBJ -> IO Int
1241 foreign import ccall "libHS_cbits.so" "readChar" unsafe prim_readChar :: FILE_OBJ -> IO Int
1242 foreign import ccall "libHS_cbits.so" "writeFileObject" unsafe prim_writeFileObject :: FILE_OBJ -> Int -> IO RC
1243 foreign import ccall "libHS_cbits.so" "filePutc" unsafe prim_filePutc :: FILE_OBJ -> Char -> IO RC
1244 foreign import ccall "libHS_cbits.so" "getBufStart" unsafe prim_getBufStart :: FILE_OBJ -> Int -> IO Addr
1245 foreign import ccall "libHS_cbits.so" "getWriteableBuf" unsafe prim_getWriteableBuf :: FILE_OBJ -> IO Addr
1246 foreign import ccall "libHS_cbits.so" "getBufWPtr" unsafe prim_getBufWPtr :: FILE_OBJ -> IO Int
1247 foreign import ccall "libHS_cbits.so" "setBufWPtr" unsafe prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
1248 foreign import ccall "libHS_cbits.so" "closeFile" unsafe prim_closeFile :: FILE_OBJ -> Flush -> IO RC
1249 foreign import ccall "libHS_cbits.so" "fileEOF" unsafe prim_fileEOF :: FILE_OBJ -> IO RC
1250 foreign import ccall "libHS_cbits.so" "setBuffering" unsafe prim_setBuffering :: FILE_OBJ -> Int -> IO RC
1251 foreign import ccall "libHS_cbits.so" "flushFile" unsafe prim_flushFile :: FILE_OBJ -> IO RC
1252 foreign import ccall "libHS_cbits.so" "getBufferMode" unsafe prim_getBufferMode :: FILE_OBJ -> IO RC
1253 foreign import ccall "libHS_cbits.so" "seekFile_int64" unsafe prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
1254 foreign import ccall "libHS_cbits.so" "seekFileP" unsafe prim_seekFileP :: FILE_OBJ -> IO RC
1255 foreign import ccall "libHS_cbits.so" "setTerminalEcho" unsafe prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
1256 foreign import ccall "libHS_cbits.so" "getTerminalEcho" unsafe prim_getTerminalEcho :: FILE_OBJ -> IO RC
1257 foreign import ccall "libHS_cbits.so" "isTerminalDevice" unsafe prim_isTerminalDevice :: FILE_OBJ -> IO RC
1258 foreign import ccall "libHS_cbits.so" "setConnectedTo" unsafe prim_setConnectedTo :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
1259 foreign import ccall "libHS_cbits.so" "ungetChar" unsafe prim_ungetChar :: FILE_OBJ -> Char -> IO RC
1260 foreign import ccall "libHS_cbits.so" "readChunk" unsafe prim_readChunk :: FILE_OBJ -> Addr -> Int -> IO RC
1261 foreign import ccall "libHS_cbits.so" "writeBuf" unsafe prim_writeBuf :: FILE_OBJ -> Addr -> Int -> IO RC
1262 foreign import ccall "libHS_cbits.so" "getFileFd" unsafe prim_getFileFd :: FILE_OBJ -> IO FD
1263 foreign import ccall "libHS_cbits.so" "fileSize_int64" unsafe prim_fileSize_int64 :: FILE_OBJ -> Bytes -> IO RC
1264 foreign import ccall "libHS_cbits.so" "getFilePosn" unsafe prim_getFilePosn :: FILE_OBJ -> IO Int
1265 foreign import ccall "libHS_cbits.so" "setFilePosn" unsafe prim_setFilePosn :: FILE_OBJ -> Int -> IO Int
1266 foreign import ccall "libHS_cbits.so" "getConnFileFd" unsafe prim_getConnFileFd :: FILE_OBJ -> IO FD
1267 foreign import ccall "libHS_cbits.so" "allocMemory__" unsafe prim_allocMemory__ :: Int -> IO Addr
1268 foreign import ccall "libHS_cbits.so" "getLock" unsafe prim_getLock :: FD -> Exclusive -> IO RC
1269 foreign import ccall "libHS_cbits.so" "openStdFile" unsafe prim_openStdFile :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
1270 foreign import ccall "libHS_cbits.so" "openFile" unsafe prim_openFile :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
1271 foreign import ccall "libHS_cbits.so" "freeFileObject" unsafe prim_freeFileObject :: FILE_OBJ -> IO ()
1272 foreign import ccall "libHS_cbits.so" "freeStdFileObject" unsafe prim_freeStdFileObject :: FILE_OBJ -> IO ()
1273 foreign import ccall "libHS_cbits.so" "const_BUFSIZ" unsafe const_BUFSIZ :: Int
1275 foreign import ccall "libHS_cbits.so" "setConnNonBlockingIOFlag__" unsafe prim_setConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1276 foreign import ccall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" unsafe prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1277 foreign import ccall "libHS_cbits.so" "setNonBlockingIOFlag__" unsafe prim_setNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1278 foreign import ccall "libHS_cbits.so" "clearNonBlockingIOFlag__" unsafe prim_clearNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1280 foreign import ccall "libHS_cbits.so" "getErrStr__" unsafe prim_getErrStr__ :: IO Addr
1281 foreign import ccall "libHS_cbits.so" "getErrNo__" unsafe prim_getErrNo__ :: IO Int
1282 foreign import ccall "libHS_cbits.so" "getErrType__" unsafe prim_getErrType__ :: IO Int