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, toBig )
27 import PrelWeak ( addForeignFinalizer )
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
58 %*********************************************************
60 \subsection{Types @Handle@, @Handle__@}
62 %*********************************************************
64 The @Handle@ and @Handle__@ types are defined in @IOBase@.
67 {-# INLINE newHandle #-}
68 {-# INLINE withHandle #-}
69 {-# INLINE writeHandle #-}
70 newHandle :: Handle__ -> IO Handle
71 withHandle :: Handle -> (Handle__ -> IO a) -> IO a
72 writeHandle :: Handle -> Handle__ -> IO ()
74 #if defined(__CONCURRENT_HASKELL__)
76 -- Use MVars for concurrent Haskell
77 newHandle hc = newMVar hc >>= \ h ->
80 -- withHandle grabs the handle lock, performs
81 -- some operation over it, making sure that we
82 -- unlock & reset the handle state should an
83 -- exception occur while performing said op.
84 withHandle (Handle h) act = do
86 v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
89 writeHandle (Handle h) hc = putMVar h hc
92 -- Use ordinary MutableVars for non-concurrent Haskell
93 newHandle hc = stToIO (newVar hc >>= \ h ->
96 -- of questionable value to install this exception
97 -- handler, but let's do it in the non-concurrent
99 withHandle (Handle h) act = do
100 h_ <- stToIO (readVar h)
101 v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
104 writeHandle (Handle h) hc = stToIO (writeVar h hc)
108 nullFile__ is only used for closed handles, plugging it in as a null
109 file object reference.
112 nullFile__ :: FILE_OBJECT
114 #ifndef __PARALLEL_HASKELL__
115 unsafePerformIO (makeForeignObj nullAddr)
121 mkClosedHandle__ :: Handle__
129 mkErrorHandle__ :: IOError -> Handle__
130 mkErrorHandle__ ioe =
138 %*********************************************************
140 \subsection{Handle Finalizers}
142 %*********************************************************
146 freeStdFileObject :: ForeignObj -> IO ()
147 freeStdFileObject fo = CCALL(freeStdFileObject) fo
149 freeFileObject :: ForeignObj -> IO ()
150 freeFileObject fo = CCALL(freeFileObject) fo
152 foreign import stdcall "libHS_cbits.so" "freeStdFileObject" freeStdFileObject :: ForeignObj -> IO ()
153 foreign import stdcall "libHS_cbits.so" "freeFileObject" freeFileObject :: ForeignObj -> IO ()
157 %*********************************************************
159 \subsection[StdHandles]{Standard handles}
161 %*********************************************************
163 Three handles are allocated during program initialisation. The first
164 two manage input or output from the Haskell program's standard input
165 or output channel respectively. The third manages output to the
166 standard error channel. These handles are initially open.
170 stdin, stdout, stderr :: Handle
172 stdout = unsafePerformIO (do
173 rc <- CCALL(getLock) (1::Int) (1::Int) -- ConcHask: SAFE, won't block
175 0 -> newHandle (mkClosedHandle__)
177 #ifndef __CONCURRENT_HASKELL__
178 fo <- CCALL(openStdFile) (1::Int)
179 (1::Int){-flush on close-}
180 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
182 fo <- CCALL(openStdFile) (1::Int)
183 ((1{-flush on close-} {-+ 128 don't block on I/O-})::Int)
184 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
186 -- NOTE: turn off non-blocking I/O until
187 -- we've got proper support for threadWait{Read,Write}
189 #ifndef __PARALLEL_HASKELL__
190 fo <- makeForeignObj fo
191 addForeignFinalizer fo (freeStdFileObject fo)
195 /* I dont care what the Haskell report says, in an interactive system,
196 * stdout should be unbuffered by default.
200 (bm, bf_size) <- getBMode__ fo
201 mkBuffer__ fo bf_size
203 newHandle (Handle__ fo WriteHandle bm "stdout")
204 _ -> do ioError <- constructError "stdout"
205 newHandle (mkErrorHandle__ ioError)
208 stdin = unsafePerformIO (do
209 rc <- CCALL(getLock) (0::Int) (0::Int) -- ConcHask: SAFE, won't block
211 0 -> newHandle (mkClosedHandle__)
213 #ifndef __CONCURRENT_HASKELL__
214 fo <- CCALL(openStdFile) (0::Int)
215 (0::Int){-don't flush on close -}
216 (1::Int){-readable-} -- ConcHask: SAFE, won't block
218 fo <- CCALL(openStdFile) (0::Int)
219 ((0{-flush on close-} {-+ 128 don't block on I/O-})::Int)
220 (1::Int){-readable-} -- ConcHask: SAFE, won't block
223 #ifndef __PARALLEL_HASKELL__
224 fo <- makeForeignObj fo
225 addForeignFinalizer fo (freeStdFileObject fo)
227 (bm, bf_size) <- getBMode__ fo
228 mkBuffer__ fo bf_size
229 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
230 -- when stdin and stdout are both connected to a terminal, ensure
231 -- that anything buffered on stdout is flushed prior to reading from stdin.
233 hConnectTerms stdout hdl
235 _ -> do ioError <- constructError "stdin"
236 newHandle (mkErrorHandle__ ioError)
240 stderr = unsafePerformIO (do
241 rc <- CCALL(getLock) (2::Int) (1::Int){-writeable-} -- ConcHask: SAFE, won't block
243 0 -> newHandle (mkClosedHandle__)
245 #ifndef __CONCURRENT_HASKELL__
246 fo <- CCALL(openStdFile) (2::Int)
247 (1::Int){-flush on close-}
248 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
250 fo <- CCALL(openStdFile) (2::Int)
251 ((1{-flush on close-} {- + 128 don't block on I/O-})::Int)
252 (0::Int){-writeable-} -- ConcHask: SAFE, won't block
255 #ifndef __PARALLEL_HASKELL__
256 fo <- makeForeignObj fo
257 addForeignFinalizer fo (freeStdFileObject fo)
259 hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
260 -- when stderr and stdout are both connected to a terminal, ensure
261 -- that anything buffered on stdout is flushed prior to writing to
263 hConnectTo stdout hdl
266 _ -> do ioError <- constructError "stderr"
267 newHandle (mkErrorHandle__ ioError)
271 %*********************************************************
273 \subsection[OpeningClosing]{Opening and Closing Files}
275 %*********************************************************
278 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
279 deriving (Eq, Ord, Ix, Enum, Read, Show)
284 deriving (Eq, Read, Show)
286 openFile :: FilePath -> IOMode -> IO Handle
287 openFile fp im = openFileEx fp (TextMode im)
289 openFileEx :: FilePath -> IOModeEx -> IO Handle
292 fo <- CCALL(openFile) (primPackString f) (file_mode::Int)
294 (file_flags::Int) -- ConcHask: SAFE, won't block
295 if fo /= nullAddr then do
296 #ifndef __PARALLEL_HASKELL__
297 fo <- makeForeignObj fo
298 addForeignFinalizer fo (freeFileObject fo)
300 (bm, bf_size) <- getBMode__ fo
301 mkBuffer__ fo bf_size
302 newHandle (Handle__ fo htype bm f)
304 constructErrorAndFailWithInfo "openFile" f
308 BinaryMode bmo -> (bmo, 1)
309 TextMode tmo -> (tmo, 0)
311 #ifndef __CONCURRENT_HASKELL__
312 file_flags = file_flags'
314 -- See comment next to 'stderr' for why we leave
315 -- non-blocking off for now.
316 file_flags = file_flags' {-+ 128 Don't block on I/O-}
319 (file_flags', file_mode) =
324 ReadWriteMode -> (1, 3)
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 -> do
364 writeHandle handle handle_
367 writeHandle handle handle_
368 ioe_closedHandle "hClose" handle
370 rc <- CCALL(closeFile) (haFO__ handle_) (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
371 {- We explicitly close a file object so that we can be told
372 if there were any errors. Note that after @hClose@
373 has been performed, the ForeignObj embedded in the Handle
374 is still lying around in the heap, so care is taken
375 to avoid closing the file object when the ForeignObj
376 is finalized. (we overwrite the file ptr in the underlying
377 FileObject with a NULL as part of closeFile())
381 writeHandle handle (handle_{ haType__ = ClosedHandle,
382 haFO__ = nullFile__ })
384 writeHandle handle handle_
385 constructErrorAndFail "hClose"
389 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
390 computation finishes, any items buffered for output and not already
391 sent to the operating system are flushed as for $flush$.
393 %*********************************************************
395 \subsection[EOF]{Detecting the End of Input}
397 %*********************************************************
400 For a handle {\em hdl} which attached to a physical file, $hFileSize
401 hdl$ returns the size of {\em hdl} in terms of the number of items
402 which can be read from {\em hdl}.
405 hFileSize :: Handle -> IO Integer
407 withHandle handle $ \ handle_ -> do
408 case haType__ handle_ of
409 ErrorHandle theError -> do
410 writeHandle handle handle_
413 writeHandle handle handle_
414 ioe_closedHandle "hFileSize" handle
415 SemiClosedHandle -> do
416 writeHandle handle handle_
417 ioe_closedHandle "hFileSize" handle
420 mem <- primNewByteArray sizeof_int64
421 rc <- CCALL(fileSize_int64) (haFO__ handle_) mem -- ConcHask: SAFE, won't block
422 writeHandle handle handle_
424 result <- primReadInt64Array mem 0
425 return (primInt64ToInteger result)
427 constructErrorAndFail "hFileSize"
430 -- HACK! We build a unique MP_INT of the right shape to hold
431 -- a single unsigned word, and we let the C routine
432 -- change the data bits
434 -- For some reason, this fails to typecheck if converted to a do
436 _casm_ ``%r = 1;'' >>= \(I# hack#) ->
437 case int2Integer# hack# of
439 rc <- CCALL(fileSize) (haFO__ handle_) d -- ConcHask: SAFE, won't block
440 writeHandle handle handle_
441 if rc == (0::Int) then
444 constructErrorAndFail "hFileSize"
448 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
449 @True@ if no further input can be taken from @hdl@ or for a
450 physical file, if the current I/O position is equal to the length of
451 the file. Otherwise, it returns @False@.
454 hIsEOF :: Handle -> IO Bool
456 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
457 let fo = haFO__ handle_
458 rc <- mayBlock fo (CCALL(fileEOF) fo) -- ConcHask: UNSAFE, may block
459 writeHandle handle handle_
463 _ -> constructErrorAndFail "hIsEOF"
469 %*********************************************************
471 \subsection[Buffering]{Buffering Operations}
473 %*********************************************************
475 Three kinds of buffering are supported: line-buffering,
476 block-buffering or no-buffering. See @IOBase@ for definition
477 and further explanation of what the type represent.
479 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
480 handle {\em hdl} on subsequent reads and writes.
484 If {\em mode} is @LineBuffering@, line-buffering should be
487 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
488 should be enabled if possible. The size of the buffer is {\em n} items
489 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
491 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
494 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
495 to @NoBuffering@, then any items in the output buffer are written to
496 the device, and any items in the input buffer are discarded. The
497 default buffering mode when a handle is opened is
498 implementation-dependent and may depend on the object which is
499 attached to that handle.
502 hSetBuffering :: Handle -> BufferMode -> IO ()
504 hSetBuffering handle mode =
506 BlockBuffering (Just n)
508 (IOError (Just handle)
511 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
513 withHandle handle $ \ handle_ -> do
514 case haType__ handle_ of
515 ErrorHandle theError -> do
516 writeHandle handle handle_
519 writeHandle handle handle_
520 ioe_closedHandle "hSetBuffering" handle
523 - we flush the old buffer regardless of whether
524 the new buffer could fit the contents of the old buffer
526 - allow a handle's buffering to change even if IO has
527 occurred (ANSI C spec. does not allow this, nor did
528 the previous implementation of IO.hSetBuffering).
529 - a non-standard extension is to allow the buffering
530 of semi-closed handles to change [sof 6/98]
532 let fo = haFO__ handle_
533 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
536 writeHandle handle (handle_{ haBufferMode__ = mode })
538 -- Note: failure to change the buffer size will cause old buffer to be flushed.
539 writeHandle handle handle_
540 constructErrorAndFail "hSetBuffering"
546 BlockBuffering Nothing -> -2
547 BlockBuffering (Just n) -> n
550 The action @hFlush hdl@ causes any items buffered for output
551 in handle {\em hdl} to be sent immediately to the operating
555 hFlush :: Handle -> IO ()
557 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
558 let fo = haFO__ handle_
559 rc <- mayBlock fo (CCALL(flushFile) fo) -- ConcHask: UNSAFE, may block
560 writeHandle handle handle_
564 constructErrorAndFail "hFlush"
569 %*********************************************************
571 \subsection[Seeking]{Repositioning Handles}
573 %*********************************************************
578 Handle -- Q: should this be a weak or strong ref. to the handle?
581 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
582 deriving (Eq, Ord, Ix, Enum, Read, Show)
585 Computation @hGetPosn hdl@ returns the current I/O
586 position of {\em hdl} as an abstract position. Computation
587 $hSetPosn p$ sets the position of {\em hdl}
588 to a previously obtained position {\em p}.
591 hGetPosn :: Handle -> IO HandlePosn
593 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
594 posn <- CCALL(getFilePosn) (haFO__ handle_) -- ConcHask: SAFE, won't block
595 writeHandle handle handle_
597 return (HandlePosn handle posn)
599 constructErrorAndFail "hGetPosn"
601 hSetPosn :: HandlePosn -> IO ()
602 hSetPosn (HandlePosn handle posn) =
603 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
604 let fo = haFO__ handle_
605 rc <- mayBlock fo (CCALL(setFilePosn) fo posn) -- ConcHask: UNSAFE, may block
606 writeHandle handle handle_
610 constructErrorAndFail "hSetPosn"
613 The action @hSeek hdl mode i@ sets the position of handle
614 @hdl@ depending on @mode@. If @mode@ is
616 \item[{\bf AbsoluteSeek}] The position of @hdl@ is set to @i@.
617 \item[{\bf RelativeSeek}] The position of @hdl@ is set to offset @i@ from
618 the current position.
619 \item[{\bf SeekFromEnd}] The position of @hdl@ is set to offset @i@ from
623 Some handles may not be seekable (see @hIsSeekable@), or only support a
624 subset of the possible positioning operations (e.g. it may only be
625 possible to seek to the end of a tape, or to a positive offset from
626 the beginning or current position).
628 It is not possible to set a negative I/O position, or for a physical
629 file, an I/O position beyond the current end-of-file.
632 - when seeking using @SeekFromEnd@, positive offsets (>=0) means seeking
634 - relative seeking on buffered handles can lead to non-obvious results.
637 hSeek :: Handle -> SeekMode -> Integer -> IO ()
639 hSeek handle mode offset =
640 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
641 let fo = haFO__ handle_
642 rc <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
644 hSeek handle mode i@(S# _) = hSeek handle mode (toBig i)
645 hSeek handle mode (J# s# d#) =
646 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
647 let fo = haFO__ handle_
648 rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
650 writeHandle handle handle_
654 constructErrorAndFail "hSeek"
657 whence = case mode of
663 %*********************************************************
665 \subsection[Query]{Handle Properties}
667 %*********************************************************
669 A number of operations return information about the properties of a
670 handle. Each of these operations returns $True$ if the
671 handle has the specified property, and $False$
674 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
675 {\em hdl} is not block-buffered. Otherwise it returns
676 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
677 $( Just n )$ for block-buffering of {\em n} bytes.
680 hIsOpen :: Handle -> IO Bool
682 withHandle handle $ \ handle_ -> do
683 case haType__ handle_ of
684 ErrorHandle theError -> do
685 writeHandle handle handle_
688 writeHandle handle handle_
690 SemiClosedHandle -> do
691 writeHandle handle handle_
694 writeHandle handle handle_
697 hIsClosed :: Handle -> IO Bool
699 withHandle handle $ \ handle_ -> do
700 case haType__ handle_ of
701 ErrorHandle theError -> do
702 writeHandle handle handle_
705 writeHandle handle handle_
708 writeHandle handle handle_
711 {- not defined, nor exported, but mentioned
712 here for documentation purposes:
714 hSemiClosed :: Handle -> IO Bool
718 return (not (ho || hc))
721 hIsReadable :: Handle -> IO Bool
723 withHandle handle $ \ handle_ -> do
724 case haType__ handle_ of
725 ErrorHandle theError -> do
726 writeHandle handle handle_
729 writeHandle handle handle_
730 ioe_closedHandle "hIsReadable" handle
731 SemiClosedHandle -> do
732 writeHandle handle handle_
733 ioe_closedHandle "hIsReadable" handle
735 writeHandle handle handle_
736 return (isReadable htype)
738 isReadable ReadHandle = True
739 isReadable ReadWriteHandle = True
742 hIsWritable :: Handle -> IO Bool
744 withHandle handle $ \ handle_ -> do
745 case haType__ handle_ of
746 ErrorHandle theError -> do
747 writeHandle handle handle_
750 writeHandle handle handle_
751 ioe_closedHandle "hIsWritable" handle
752 SemiClosedHandle -> do
753 writeHandle handle handle_
754 ioe_closedHandle "hIsWritable" handle
756 writeHandle handle handle_
757 return (isWritable htype)
759 isWritable AppendHandle = True
760 isWritable WriteHandle = True
761 isWritable ReadWriteHandle = True
765 #ifndef __PARALLEL_HASKELL__
766 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
768 getBMode__ :: Addr -> IO (BufferMode, Int)
771 rc <- CCALL(getBufferMode) fo -- ConcHask: SAFE, won't block
773 0 -> return (NoBuffering, 0)
774 -1 -> return (LineBuffering, default_buffer_size)
775 -2 -> return (BlockBuffering Nothing, default_buffer_size)
776 -3 -> return (NoBuffering, 0) -- only happens on un-stat()able files.
777 n -> return (BlockBuffering (Just n), n)
779 default_buffer_size :: Int
780 default_buffer_size = (const_BUFSIZ - 1)
783 Querying how a handle buffers its data:
786 hGetBuffering :: Handle -> IO BufferMode
787 hGetBuffering handle =
788 withHandle handle $ \ handle_ -> do
789 case haType__ handle_ of
790 ErrorHandle theError -> do
791 writeHandle handle handle_
794 writeHandle handle handle_
795 ioe_closedHandle "hGetBuffering" handle
798 We're being non-standard here, and allow the buffering
799 of a semi-closed handle to be queried. -- sof 6/98
801 let v = haBufferMode__ handle_
802 writeHandle handle handle_
803 return v -- could be stricter..
808 hIsSeekable :: Handle -> IO Bool
810 withHandle handle $ \ handle_ -> do
811 case haType__ handle_ of
812 ErrorHandle theError -> do
813 writeHandle handle handle_
816 writeHandle handle handle_
817 ioe_closedHandle "hIsSeekable" handle
818 SemiClosedHandle -> do
819 writeHandle handle handle_
820 ioe_closedHandle "hIsSeekable" handle
822 writeHandle handle handle_
825 rc <- CCALL(seekFileP) (haFO__ handle_) -- ConcHask: SAFE, won't block
826 writeHandle handle handle_
830 _ -> constructErrorAndFail "hIsSeekable"
834 %*********************************************************
836 \subsection{Changing echo status}
838 %*********************************************************
840 Non-standard GHC extension is to allow the echoing status
841 of a handles connected to terminals to be reconfigured:
844 hSetEcho :: Handle -> Bool -> IO ()
845 hSetEcho handle on = do
846 isT <- hIsTerminalDevice handle
850 withHandle handle $ \ handle_ -> do
851 case haType__ handle_ of
852 ErrorHandle theError -> do
853 writeHandle handle handle_
856 writeHandle handle handle_
857 ioe_closedHandle "hSetEcho" handle
859 rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int) -- ConcHask: SAFE, won't block
860 writeHandle handle handle_
863 else constructErrorAndFail "hSetEcho"
865 hGetEcho :: Handle -> IO Bool
867 isT <- hIsTerminalDevice handle
871 withHandle handle $ \ handle_ -> do
872 case haType__ handle_ of
873 ErrorHandle theError -> do
874 writeHandle handle handle_
877 writeHandle handle handle_
878 ioe_closedHandle "hGetEcho" handle
880 rc <- CCALL(getTerminalEcho) (haFO__ handle_) -- ConcHask: SAFE, won't block
881 writeHandle handle handle_
885 _ -> constructErrorAndFail "hSetEcho"
887 hIsTerminalDevice :: Handle -> IO Bool
888 hIsTerminalDevice handle = do
889 withHandle handle $ \ handle_ -> do
890 case haType__ handle_ of
891 ErrorHandle theError -> do
892 writeHandle handle handle_
895 writeHandle handle handle_
896 ioe_closedHandle "hIsTerminalDevice" handle
898 rc <- CCALL(isTerminalDevice) (haFO__ handle_) -- ConcHask: SAFE, won't block
899 writeHandle handle handle_
903 _ -> constructErrorAndFail "hIsTerminalDevice"
907 hConnectTerms :: Handle -> Handle -> IO ()
908 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
910 hConnectTo :: Handle -> Handle -> IO ()
911 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
913 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
914 hConnectHdl_ hW hR is_tty =
915 wantRWHandle "hConnectTo" hW $ \ hW_ -> do
916 wantRWHandle "hConnectTo" hR $ \ hR_ -> do
917 CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
921 #ifndef __PARALLEL_HASKELL__
922 #define FILE_OBJECT ForeignObj
924 #define FILE_OBJECT Addr
927 flushConnectedBuf :: FILE_OBJECT -> IO ()
928 flushConnectedBuf fo = CCALL(flushConnectedBuf) fo
931 As an extension, we also allow characters to be pushed back.
932 Like ANSI C stdio, we guarantee no more than one character of
933 pushback. (For unbuffered channels, the (default) push-back limit is
937 hUngetChar :: Handle -> Char -> IO ()
938 hUngetChar handle c =
939 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
940 rc <- CCALL(ungetChar) (haFO__ handle_) c -- ConcHask: SAFE, won't block
941 writeHandle handle handle_
943 then constructErrorAndFail "hUngetChar"
949 Hoisting files in in one go is sometimes useful, so we support
950 this as an extension:
953 -- in one go, read file into an externally allocated buffer.
954 slurpFile :: FilePath -> IO (Addr, Int)
956 handle <- openFile fname ReadMode
957 sz <- hFileSize handle
958 if sz > toInteger (maxBound::Int) then
959 ioError (userError "slurpFile: file too big")
961 let sz_i = fromInteger sz
962 chunk <- CCALL(allocMemory__) (sz_i::Int)
966 constructErrorAndFail "slurpFile"
968 withHandle handle $ \ handle_ -> do
969 let fo = haFO__ handle_
970 rc <- mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
971 writeHandle handle handle_
974 then constructErrorAndFail "slurpFile"
975 else return (chunk, rc)
977 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
978 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
979 hFillBufBA handle buf sz
980 | sz <= 0 = ioError (IOError (Just handle)
983 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
985 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
986 let fo = haFO__ handle_
988 rc <- mayBlock fo (CCALL(readChunkBA) fo buf sz) -- ConcHask: UNSAFE, may block.
990 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
992 writeHandle handle handle_
995 else constructErrorAndFail "hFillBufBA"
998 hFillBuf :: Handle -> Addr -> Int -> IO Int
999 hFillBuf handle buf sz
1000 | sz <= 0 = ioError (IOError (Just handle)
1003 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
1005 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
1006 let fo = haFO__ handle_
1007 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
1008 writeHandle handle handle_
1011 else constructErrorAndFail "hFillBuf"
1015 The @hPutBuf hdl buf len@ action writes an already packed sequence of
1016 bytes to the file/channel managed by @hdl@ - non-standard.
1019 hPutBuf :: Handle -> Addr -> Int -> IO ()
1020 hPutBuf handle buf len =
1021 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
1022 let fo = haFO__ handle_
1023 rc <- mayBlock fo (CCALL(writeBuf) fo buf len) -- ConcHask: UNSAFE, may block.
1024 writeHandle handle handle_
1027 else constructErrorAndFail "hPutBuf"
1029 #ifndef __HUGS__ /* An_ one Hugs doesn't provide */
1030 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
1031 hPutBufBA handle buf len =
1032 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
1033 let fo = haFO__ handle_
1034 rc <- mayBlock fo (CCALL(writeBufBA) fo buf len) -- ConcHask: UNSAFE, may block.
1035 writeHandle handle handle_
1038 else constructErrorAndFail "hPutBuf"
1042 Sometimes it's useful to get at the file descriptor that
1043 the Handle contains..
1046 getHandleFd :: Handle -> IO Int
1047 getHandleFd handle = do
1048 withHandle handle $ \ handle_ -> do
1049 case (haType__ handle_) of
1050 ErrorHandle theError -> do
1051 writeHandle handle handle_
1054 writeHandle handle handle_
1055 ioe_closedHandle "getHandleFd" handle
1057 fd <- CCALL(getFileFd) (haFO__ handle_)
1058 writeHandle handle handle_
1063 %*********************************************************
1065 \subsection{Miscellaneous}
1067 %*********************************************************
1069 These three functions are meant to get things out of @IOErrors@.
1074 ioeGetFileName :: IOError -> Maybe FilePath
1075 ioeGetErrorString :: IOError -> String
1076 ioeGetHandle :: IOError -> Maybe Handle
1078 ioeGetHandle (IOError h _ _ _) = h
1079 ioeGetErrorString (IOError _ iot _ str) =
1081 EOF -> "end of file"
1084 ioeGetFileName (IOError _ _ _ str) =
1085 case span (/=':') str of
1091 A number of operations want to get at a readable or writeable handle, and fail
1095 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1096 wantReadableHandle fun handle act =
1097 withHandle handle $ \ handle_ -> do
1098 case haType__ handle_ of
1099 ErrorHandle theError -> do
1100 writeHandle handle handle_
1103 writeHandle handle handle_
1104 ioe_closedHandle fun handle
1105 SemiClosedHandle -> do
1106 writeHandle handle handle_
1107 ioe_closedHandle fun handle
1109 writeHandle handle handle_
1110 ioError not_readable_error
1112 writeHandle handle handle_
1113 ioError not_readable_error
1116 not_readable_error =
1117 IOError (Just handle) IllegalOperation fun
1118 ("handle is not open for reading")
1120 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1121 wantWriteableHandle fun handle act =
1122 withHandle handle $ \ handle_ -> do
1123 case haType__ handle_ of
1124 ErrorHandle theError -> do
1125 writeHandle handle handle_
1128 writeHandle handle handle_
1129 ioe_closedHandle fun handle
1130 SemiClosedHandle -> do
1131 writeHandle handle handle_
1132 ioe_closedHandle fun handle
1134 writeHandle handle handle_
1135 ioError not_writeable_error
1138 not_writeable_error =
1139 IOError (Just handle) IllegalOperation fun
1140 ("handle is not open for writing")
1142 wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1143 wantRWHandle fun handle act =
1144 withHandle handle $ \ handle_ -> do
1145 case haType__ handle_ of
1146 ErrorHandle theError -> do
1147 writeHandle handle handle_
1150 writeHandle handle handle_
1151 ioe_closedHandle fun handle
1152 SemiClosedHandle -> do
1153 writeHandle handle handle_
1154 ioe_closedHandle fun handle
1158 IOError (Just handle) IllegalOperation fun
1159 ("handle is not open for reading or writing")
1161 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1162 wantSeekableHandle fun handle act =
1163 withHandle handle $ \ handle_ -> do
1164 case haType__ handle_ of
1165 ErrorHandle theError -> do
1166 writeHandle handle handle_
1169 writeHandle handle handle_
1170 ioe_closedHandle fun handle
1171 SemiClosedHandle -> do
1172 writeHandle handle handle_
1173 ioe_closedHandle fun handle
1175 writeHandle handle handle_
1176 ioError not_seekable_error
1179 not_seekable_error =
1180 IOError (Just handle)
1181 IllegalOperation fun
1182 ("handle is not seekable")
1186 Internal function for creating an @IOError@ representing the
1187 access to a closed file.
1190 ioe_closedHandle :: String -> Handle -> IO a
1191 ioe_closedHandle fun h = ioError (IOError (Just h) IllegalOperation fun "handle is closed")
1194 Internal helper functions for Concurrent Haskell implementation
1198 #ifndef __PARALLEL_HASKELL__
1199 mayBlock :: ForeignObj -> IO Int -> IO Int
1201 mayBlock :: Addr -> IO Int -> IO Int
1204 #ifndef notyet /*__CONCURRENT_HASKELL__*/
1205 mayBlock _ act = act
1207 mayBlock fo act = do
1210 -5 -> do -- (possibly blocking) read
1211 fd <- CCALL(getFileFd) fo
1213 CCALL(clearNonBlockingIOFlag__) fo -- force read to happen this time.
1214 mayBlock fo act -- input available, re-try
1215 -6 -> do -- (possibly blocking) write
1216 fd <- CCALL(getFileFd) fo
1218 CCALL(clearNonBlockingIOFlag__) fo -- force write to happen this time.
1219 mayBlock fo act -- output possible
1220 -7 -> do -- (possibly blocking) write on connected handle
1221 fd <- CCALL(getConnFileFd) fo
1223 CCALL(clearConnNonBlockingIOFlag__) fo -- force write to happen this time.
1224 mayBlock fo act -- output possible
1226 CCALL(setNonBlockingIOFlag__) fo -- reset file object.
1227 CCALL(setConnNonBlockingIOFlag__) fo -- reset (connected) file object.
1234 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
1236 -- Hugs does actually have the primops needed to implement these
1237 -- but, like GHC, the primops don't actually do anything...
1238 threadDelay _ = return ()
1239 threadWaitRead _ = return ()
1240 threadWaitWrite _ = return ()
1249 type Exclusive = Int -- really Bool
1252 type OpenStdFlags = Int
1253 type OpenFlags = Int
1254 type Readable = Int -- really Bool
1255 type Flush = Int -- really Bool
1256 type RC = Int -- standard return code
1258 type IOFileAddr = Addr -- as returned from functions
1259 type CString = PrimByteArray
1260 type Bytes = PrimMutableByteArray RealWorld
1262 #ifndef __PARALLEL_HASKELL__
1263 type FILE_OBJ = ForeignObj -- as passed into functions
1265 type FILE_OBJ = Addr
1268 foreign import ccall "libHS_cbits.so" "setBuf" unsafe prim_setBuf :: FILE_OBJ -> Addr -> Int -> IO ()
1269 foreign import ccall "libHS_cbits.so" "getBufSize" unsafe prim_getBufSize :: FILE_OBJ -> IO Int
1270 foreign import ccall "libHS_cbits.so" "inputReady" unsafe prim_inputReady :: FILE_OBJ -> Int -> IO RC
1271 foreign import ccall "libHS_cbits.so" "fileGetc" unsafe prim_fileGetc :: FILE_OBJ -> IO Int
1272 foreign import ccall "libHS_cbits.so" "fileLookAhead" unsafe prim_fileLookAhead :: FILE_OBJ -> IO Int
1273 foreign import ccall "libHS_cbits.so" "readBlock" unsafe prim_readBlock :: FILE_OBJ -> IO Int
1274 foreign import ccall "libHS_cbits.so" "readLine" unsafe prim_readLine :: FILE_OBJ -> IO Int
1275 foreign import ccall "libHS_cbits.so" "readChar" unsafe prim_readChar :: FILE_OBJ -> IO Int
1276 foreign import ccall "libHS_cbits.so" "writeFileObject" unsafe prim_writeFileObject :: FILE_OBJ -> Int -> IO RC
1277 foreign import ccall "libHS_cbits.so" "filePutc" unsafe prim_filePutc :: FILE_OBJ -> Char -> IO RC
1278 foreign import ccall "libHS_cbits.so" "getBufStart" unsafe prim_getBufStart :: FILE_OBJ -> Int -> IO Addr
1279 foreign import ccall "libHS_cbits.so" "getWriteableBuf" unsafe prim_getWriteableBuf :: FILE_OBJ -> IO Addr
1280 foreign import ccall "libHS_cbits.so" "getBufWPtr" unsafe prim_getBufWPtr :: FILE_OBJ -> IO Int
1281 foreign import ccall "libHS_cbits.so" "setBufWPtr" unsafe prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
1282 foreign import ccall "libHS_cbits.so" "closeFile" unsafe prim_closeFile :: FILE_OBJ -> Flush -> IO RC
1283 foreign import ccall "libHS_cbits.so" "fileEOF" unsafe prim_fileEOF :: FILE_OBJ -> IO RC
1284 foreign import ccall "libHS_cbits.so" "setBuffering" unsafe prim_setBuffering :: FILE_OBJ -> Int -> IO RC
1285 foreign import ccall "libHS_cbits.so" "flushFile" unsafe prim_flushFile :: FILE_OBJ -> IO RC
1286 foreign import ccall "libHS_cbits.so" "flushConnectedBuf" unsafe prim_flushConnectedBuf :: FILE_OBJ -> IO RC
1287 foreign import ccall "libHS_cbits.so" "getBufferMode" unsafe prim_getBufferMode :: FILE_OBJ -> IO RC
1288 foreign import ccall "libHS_cbits.so" "seekFile_int64" unsafe prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
1289 foreign import ccall "libHS_cbits.so" "seekFileP" unsafe prim_seekFileP :: FILE_OBJ -> IO RC
1290 foreign import ccall "libHS_cbits.so" "setTerminalEcho" unsafe prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
1291 foreign import ccall "libHS_cbits.so" "getTerminalEcho" unsafe prim_getTerminalEcho :: FILE_OBJ -> IO RC
1292 foreign import ccall "libHS_cbits.so" "isTerminalDevice" unsafe prim_isTerminalDevice :: FILE_OBJ -> IO RC
1293 foreign import ccall "libHS_cbits.so" "setConnectedTo" unsafe prim_setConnectedTo :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
1294 foreign import ccall "libHS_cbits.so" "ungetChar" unsafe prim_ungetChar :: FILE_OBJ -> Char -> IO RC
1295 foreign import ccall "libHS_cbits.so" "readChunk" unsafe prim_readChunk :: FILE_OBJ -> Addr -> Int -> IO RC
1296 foreign import ccall "libHS_cbits.so" "writeBuf" unsafe prim_writeBuf :: FILE_OBJ -> Addr -> Int -> IO RC
1297 foreign import ccall "libHS_cbits.so" "getFileFd" unsafe prim_getFileFd :: FILE_OBJ -> IO FD
1298 foreign import ccall "libHS_cbits.so" "fileSize_int64" unsafe prim_fileSize_int64 :: FILE_OBJ -> Bytes -> IO RC
1299 foreign import ccall "libHS_cbits.so" "getFilePosn" unsafe prim_getFilePosn :: FILE_OBJ -> IO Int
1300 foreign import ccall "libHS_cbits.so" "setFilePosn" unsafe prim_setFilePosn :: FILE_OBJ -> Int -> IO Int
1301 foreign import ccall "libHS_cbits.so" "getConnFileFd" unsafe prim_getConnFileFd :: FILE_OBJ -> IO FD
1302 foreign import ccall "libHS_cbits.so" "allocMemory__" unsafe prim_allocMemory__ :: Int -> IO Addr
1303 foreign import ccall "libHS_cbits.so" "getLock" unsafe prim_getLock :: FD -> Exclusive -> IO RC
1304 foreign import ccall "libHS_cbits.so" "openStdFile" unsafe prim_openStdFile :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
1305 foreign import ccall "libHS_cbits.so" "openFile" unsafe prim_openFile :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
1306 foreign import ccall "libHS_cbits.so" "freeFileObject" unsafe prim_freeFileObject :: FILE_OBJ -> IO ()
1307 foreign import ccall "libHS_cbits.so" "freeStdFileObject" unsafe prim_freeStdFileObject :: FILE_OBJ -> IO ()
1308 foreign import ccall "libHS_cbits.so" "const_BUFSIZ" unsafe const_BUFSIZ :: Int
1310 foreign import ccall "libHS_cbits.so" "setConnNonBlockingIOFlag__" unsafe prim_setConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1311 foreign import ccall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" unsafe prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1312 foreign import ccall "libHS_cbits.so" "setNonBlockingIOFlag__" unsafe prim_setNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1313 foreign import ccall "libHS_cbits.so" "clearNonBlockingIOFlag__" unsafe prim_clearNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1315 foreign import ccall "libHS_cbits.so" "getErrStr__" unsafe prim_getErrStr__ :: IO Addr
1316 foreign import ccall "libHS_cbits.so" "getErrNo__" unsafe prim_getErrNo__ :: IO Int
1317 foreign import ccall "libHS_cbits.so" "getErrType__" unsafe prim_getErrType__ :: IO Int