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 ( Exception(..), throw, catch, fail, 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, writeForeignObj )
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
49 #ifndef __PARALLEL_HASKELL__
50 #define FILE_OBJECT ForeignObj
52 #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)
109 nullFile__ is only used for closed handles, plugging it in as a null
110 file object reference.
113 nullFile__ :: FILE_OBJECT
115 #ifndef __PARALLEL_HASKELL__
116 unsafePerformIO (makeForeignObj nullAddr)
122 mkClosedHandle__ :: Handle__
130 mkErrorHandle__ :: IOError -> Handle__
131 mkErrorHandle__ ioe =
139 %*********************************************************
141 \subsection{Handle Finalisers}
143 %*********************************************************
147 freeStdFileObject :: ForeignObj -> IO ()
148 freeStdFileObject fo = CCALL(freeStdFileObject) fo
150 freeFileObject :: ForeignObj -> IO ()
151 freeFileObject fo = CCALL(freeFileObject) fo
153 foreign import stdcall "./libHS_cbits.dll" "freeStdFileObject" freeStdFileObject :: ForeignObj -> IO ()
154 foreign import stdcall "./libHS_cbits.dll" "freeFileObject" freeFileObject :: ForeignObj -> IO ()
158 %*********************************************************
160 \subsection[StdHandles]{Standard handles}
162 %*********************************************************
164 Three handles are allocated during program initialisation. The first
165 two manage input or output from the Haskell program's standard input
166 or output channel respectively. The third manages output to the
167 standard error channel. These handles are initially open.
170 stdin, stdout, stderr :: Handle
172 stdout = unsafePerformIO (do
173 rc <- CCALL(getLock) 1 1 -- ConcHask: SAFE, won't block
175 0 -> newHandle (mkClosedHandle__)
177 #ifndef __CONCURRENT_HASKELL__
178 fo <- CCALL(openStdFile) 1 1{-flush on close-} 0{-writeable-} -- ConcHask: SAFE, won't block
180 fo <- CCALL(openStdFile) 1 (1{-flush on close-} + 128{-don't block on I/O-})
181 0{-writeable-} -- ConcHask: SAFE, won't block
184 #ifndef __PARALLEL_HASKELL__
185 fo <- makeForeignObj fo
186 addForeignFinaliser fo (freeStdFileObject fo)
190 /* I dont care what the Haskell report says, in an interactive system,
191 * stdout should be unbuffered by default.
195 (bm, bf_size) <- getBMode__ fo
196 mkBuffer__ fo bf_size
198 newHandle (Handle__ fo WriteHandle bm "stdout")
199 _ -> do ioError <- constructError "stdout"
200 newHandle (mkErrorHandle__ ioError)
203 stdin = unsafePerformIO (do
204 rc <- CCALL(getLock) 0 0 -- ConcHask: SAFE, won't block
206 0 -> newHandle (mkClosedHandle__)
208 #ifndef __CONCURRENT_HASKELL__
209 fo <- CCALL(openStdFile) 0 0{-don't flush on close -} 1{-readable-} -- ConcHask: SAFE, won't block
211 fo <- CCALL(openStdFile) 0 (0{-flush on close-} + 128{-don't block on I/O-})
212 1{-readable-} -- ConcHask: SAFE, won't block
215 #ifndef __PARALLEL_HASKELL__
216 fo <- makeForeignObj fo
217 addForeignFinaliser fo (freeStdFileObject fo)
219 (bm, bf_size) <- getBMode__ fo
220 mkBuffer__ fo bf_size
221 hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
222 -- when stdin and stdout are both connected to a terminal, ensure
223 -- that anything buffered on stdout is flushed prior to reading from stdin.
225 hConnectTerms stdout hdl
227 _ -> do ioError <- constructError "stdin"
228 newHandle (mkErrorHandle__ ioError)
232 stderr = unsafePerformIO (do
233 rc <- CCALL(getLock) 2 1 -- ConcHask: SAFE, won't block
235 0 -> newHandle (mkClosedHandle__)
237 #ifndef __CONCURRENT_HASKELL__
238 fo <- CCALL(openStdFile) 2 1{-flush on close-} 0{-writeable-} -- ConcHask: SAFE, won't block
240 fo <- CCALL(openStdFile) 2 (1{-flush on close-} + 128{-don't block on I/O-})
241 0{-writeable-} -- ConcHask: SAFE, won't block
244 #ifndef __PARALLEL_HASKELL__
245 fo <- makeForeignObj fo
246 addForeignFinaliser fo (freeStdFileObject fo)
248 newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
249 _ -> do ioError <- constructError "stderr"
250 newHandle (mkErrorHandle__ ioError)
254 %*********************************************************
256 \subsection[OpeningClosing]{Opening and Closing Files}
258 %*********************************************************
261 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
262 deriving (Eq, Ord, Ix, Enum, Read, Show)
267 deriving (Eq, Read, Show)
269 openFile :: FilePath -> IOMode -> IO Handle
270 openFile fp im = openFileEx fp (TextMode im)
272 openFileEx :: FilePath -> IOModeEx -> IO Handle
275 fo <- CCALL(openFile) (primPackString f) file_mode binary file_flags -- ConcHask: SAFE, won't block
276 if fo /= nullAddr then do
277 #ifndef __PARALLEL_HASKELL__
278 fo <- makeForeignObj fo
279 addForeignFinaliser fo (freeFileObject fo)
281 (bm, bf_size) <- getBMode__ fo
282 mkBuffer__ fo bf_size
283 newHandle (Handle__ fo htype bm f)
285 constructErrorAndFailWithInfo "openFile" f
289 BinaryMode imo -> (imo, 1)
290 TextMode imo -> (imo, 0)
292 #ifndef __CONCURRENT_HASKELL__
293 file_flags = file_flags'
295 file_flags = file_flags' + 128{-Don't block on I/O-}
298 (file_flags', file_mode) =
303 ReadWriteMode -> (1, 3)
306 ReadMode -> ReadHandle
307 WriteMode -> WriteHandle
308 AppendMode -> AppendHandle
309 ReadWriteMode -> ReadWriteHandle
312 Computation $openFile file mode$ allocates and returns a new, open
313 handle to manage the file {\em file}. It manages input if {\em mode}
314 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
315 and both input and output if mode is $ReadWriteMode$.
317 If the file does not exist and it is opened for output, it should be
318 created as a new file. If {\em mode} is $WriteMode$ and the file
319 already exists, then it should be truncated to zero length. The
320 handle is positioned at the end of the file if {\em mode} is
321 $AppendMode$, and otherwise at the beginning (in which case its
322 internal position is 0).
324 Implementations should enforce, locally to the Haskell process,
325 multiple-reader single-writer locking on files, which is to say that
326 there may either be many handles on the same file which manage input,
327 or just one handle on the file which manages output. If any open or
328 semi-closed handle is managing a file for output, no new handle can be
329 allocated for that file. If any open or semi-closed handle is
330 managing a file for input, new handles can only be allocated if they
331 do not manage output.
333 Two files are the same if they have the same absolute name. An
334 implementation is free to impose stricter conditions.
337 hClose :: Handle -> IO ()
340 withHandle handle $ \ handle_ -> do
341 case haType__ handle_ of
342 ErrorHandle ioError -> do
343 writeHandle handle handle_
346 writeHandle handle handle_
347 ioe_closedHandle "hClose" handle
349 rc <- CCALL(closeFile) (haFO__ handle_) 1{-flush if you can-} -- ConcHask: SAFE, won't block
350 {- We explicitly close a file object so that we can be told
351 if there were any errors. Note that after @hClose@
352 has been performed, the ForeignObj embedded in the Handle
353 is still lying around in the heap, so care is taken
354 to avoid closing the file object when the ForeignObj
355 is finalised. (we overwrite the file ptr in the underlying
356 FileObject with a NULL as part of closeFile())
360 writeHandle handle (handle_{ haType__ = ClosedHandle,
361 haFO__ = nullFile__ })
363 writeHandle handle handle_
364 constructErrorAndFail "hClose"
368 Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
369 computation finishes, any items buffered for output and not already
370 sent to the operating system are flushed as for $flush$.
372 %*********************************************************
374 \subsection[EOF]{Detecting the End of Input}
376 %*********************************************************
379 For a handle {\em hdl} which attached to a physical file, $hFileSize
380 hdl$ returns the size of {\em hdl} in terms of the number of items
381 which can be read from {\em hdl}.
384 hFileSize :: Handle -> IO Integer
386 withHandle handle $ \ handle_ -> do
387 case haType__ handle_ of
388 ErrorHandle ioError -> do
389 writeHandle handle handle_
392 writeHandle handle handle_
393 ioe_closedHandle "hFileSize" handle
394 SemiClosedHandle -> do
395 writeHandle handle handle_
396 ioe_closedHandle "hFileSize" handle
399 mem <- primNewByteArray sizeof_int64
400 rc <- CCALL(fileSize_int64) (haFO__ handle_) mem -- ConcHask: SAFE, won't block
401 writeHandle handle handle_
403 result <- primReadInt64Array mem 0
404 return (primInt64ToInteger result)
406 constructErrorAndFail "hFileSize"
409 -- HACK! We build a unique MP_INT of the right shape to hold
410 -- a single unsigned word, and we let the C routine
411 -- change the data bits
413 -- For some reason, this fails to typecheck if converted to a do
415 _casm_ ``%r = 1;'' >>= \(I# hack#) ->
416 case int2Integer hack# of
417 result@(J# _ _ d#) -> do
418 rc <- CCALL(fileSize) (haFO__ handle_) d# -- ConcHask: SAFE, won't block
419 writeHandle handle handle_
423 constructErrorAndFail "hFileSize"
427 For a readable handle {\em hdl}, @hIsEOF hdl@ returns
428 @True@ if no further input can be taken from @hdl@ or for a
429 physical file, if the current I/O position is equal to the length of
430 the file. Otherwise, it returns @False@.
433 hIsEOF :: Handle -> IO Bool
435 wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
436 let fo = haFO__ handle_
437 rc <- mayBlock fo (CCALL(fileEOF) fo) -- ConcHask: UNSAFE, may block
438 writeHandle handle handle_
442 _ -> constructErrorAndFail "hIsEOF"
448 %*********************************************************
450 \subsection[Buffering]{Buffering Operations}
452 %*********************************************************
454 Three kinds of buffering are supported: line-buffering,
455 block-buffering or no-buffering. See @IOBase@ for definition
456 and further explanation of what the type represent.
458 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
459 handle {\em hdl} on subsequent reads and writes.
463 If {\em mode} is @LineBuffering@, line-buffering should be
466 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
467 should be enabled if possible. The size of the buffer is {\em n} items
468 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
470 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
473 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
474 to @NoBuffering@, then any items in the output buffer are written to
475 the device, and any items in the input buffer are discarded. The
476 default buffering mode when a handle is opened is
477 implementation-dependent and may depend on the object which is
478 attached to that handle.
481 hSetBuffering :: Handle -> BufferMode -> IO ()
483 hSetBuffering handle mode =
485 BlockBuffering (Just n)
486 | n <= 0 -> fail (IOError (Just handle)
489 ("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
491 withHandle handle $ \ handle_ -> do
492 case haType__ handle_ of
493 ErrorHandle ioError -> do
494 writeHandle handle handle_
497 writeHandle handle handle_
498 ioe_closedHandle "hSetBuffering" handle
501 - we flush the old buffer regardless of whether
502 the new buffer could fit the contents of the old buffer
504 - allow a handle's buffering to change even if IO has
505 occurred (ANSI C spec. does not allow this, nor did
506 the previous implementation of IO.hSetBuffering).
507 - a non-standard extension is to allow the buffering
508 of semi-closed handles to change [sof 6/98]
510 let fo = haFO__ handle_
511 rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
514 writeHandle handle (handle_{ haBufferMode__ = mode })
516 -- Note: failure to change the buffer size will cause old buffer to be flushed.
517 writeHandle handle handle_
518 constructErrorAndFail "hSetBuffering"
524 BlockBuffering Nothing -> -2
525 BlockBuffering (Just n) -> n
528 The action @hFlush hdl@ causes any items buffered for output
529 in handle {\em hdl} to be sent immediately to the operating
533 hFlush :: Handle -> IO ()
535 wantWriteableHandle "hFlush" handle $ \ handle_ -> do
536 let fo = haFO__ handle_
537 rc <- mayBlock fo (CCALL(flushFile) fo) -- ConcHask: UNSAFE, may block
538 writeHandle handle handle_
542 constructErrorAndFail "hFlush"
547 %*********************************************************
549 \subsection[Seeking]{Repositioning Handles}
551 %*********************************************************
556 Handle -- Q: should this be a weak or strong ref. to the handle?
559 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
560 deriving (Eq, Ord, Ix, Enum, Read, Show)
563 Computation @hGetPosn hdl@ returns the current I/O
564 position of {\em hdl} as an abstract position. Computation
565 $hSetPosn p$ sets the position of {\em hdl}
566 to a previously obtained position {\em p}.
569 hGetPosn :: Handle -> IO HandlePosn
571 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
572 posn <- CCALL(getFilePosn) (haFO__ handle_) -- ConcHask: SAFE, won't block
573 writeHandle handle handle_
575 return (HandlePosn handle posn)
577 constructErrorAndFail "hGetPosn"
579 hSetPosn :: HandlePosn -> IO ()
580 hSetPosn (HandlePosn handle posn) =
581 wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
582 let fo = haFO__ handle_
583 rc <- mayBlock fo (CCALL(setFilePosn) fo posn) -- ConcHask: UNSAFE, may block
584 writeHandle handle handle_
588 constructErrorAndFail "hSetPosn"
591 The action @hSeek hdl mode i@ sets the position of handle
592 @hdl@ depending on @mode@. If @mode@ is
594 \item[{\bf AbsoluteSeek}] The position of @hdl@ is set to @i@.
595 \item[{\bf RelativeSeek}] The position of @hdl@ is set to offset @i@ from
596 the current position.
597 \item[{\bf SeekFromEnd}] The position of @hdl@ is set to offset @i@ from
601 Some handles may not be seekable (see @hIsSeekable@), or only support a
602 subset of the possible positioning operations (e.g. it may only be
603 possible to seek to the end of a tape, or to a positive offset from
604 the beginning or current position).
606 It is not possible to set a negative I/O position, or for a physical
607 file, an I/O position beyond the current end-of-file.
610 - when seeking using @SeekFromEnd@, positive offsets (>=0) means seeking
612 - relative seeking on buffered handles can lead to non-obvious results.
615 hSeek :: Handle -> SeekMode -> Integer -> IO ()
617 hSeek handle mode offset =
618 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
619 let fo = haFO__ handle_
620 rc <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
622 hSeek handle mode offset@(J# _ s# d#) =
623 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
624 let fo = haFO__ handle_
625 rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
627 writeHandle handle handle_
631 constructErrorAndFail "hSeek"
634 whence = case mode of
640 %*********************************************************
642 \subsection[Query]{Handle Properties}
644 %*********************************************************
646 A number of operations return information about the properties of a
647 handle. Each of these operations returns $True$ if the
648 handle has the specified property, and $False$
651 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
652 {\em hdl} is not block-buffered. Otherwise it returns
653 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
654 $( Just n )$ for block-buffering of {\em n} bytes.
657 hIsOpen :: Handle -> IO Bool
659 withHandle handle $ \ handle_ -> do
660 case haType__ handle_ of
661 ErrorHandle ioError -> do
662 writeHandle handle handle_
665 writeHandle handle handle_
667 SemiClosedHandle -> do
668 writeHandle handle handle_
671 writeHandle handle handle_
674 hIsClosed :: Handle -> IO Bool
676 withHandle handle $ \ handle_ -> do
677 case haType__ handle_ of
678 ErrorHandle ioError -> do
679 writeHandle handle handle_
682 writeHandle handle handle_
685 writeHandle handle handle_
688 {- not defined, nor exported, but mentioned
689 here for documentation purposes:
691 hSemiClosed :: Handle -> IO Bool
695 return (not (ho || hc))
698 hIsReadable :: Handle -> IO Bool
700 withHandle handle $ \ handle_ -> do
701 case haType__ handle_ of
702 ErrorHandle ioError -> do
703 writeHandle handle handle_
706 writeHandle handle handle_
707 ioe_closedHandle "hIsReadable" handle
708 SemiClosedHandle -> do
709 writeHandle handle handle_
710 ioe_closedHandle "hIsReadable" handle
712 writeHandle handle handle_
713 return (isReadable htype)
715 isReadable ReadHandle = True
716 isReadable ReadWriteHandle = True
719 hIsWritable :: Handle -> IO Bool
721 withHandle handle $ \ handle_ -> do
722 case haType__ handle_ of
723 ErrorHandle ioError -> do
724 writeHandle handle handle_
727 writeHandle handle handle_
728 ioe_closedHandle "hIsWritable" handle
729 SemiClosedHandle -> do
730 writeHandle handle handle_
731 ioe_closedHandle "hIsWritable" handle
733 writeHandle handle handle_
734 return (isWritable htype)
736 isWritable AppendHandle = True
737 isWritable WriteHandle = True
738 isWritable ReadWriteHandle = True
742 #ifndef __PARALLEL_HASKELL__
743 getBMode__ :: ForeignObj -> IO (BufferMode, Int)
745 getBMode__ :: Addr -> IO (BufferMode, Int)
748 rc <- CCALL(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 - 1)
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 ErrorHandle ioError -> do
768 writeHandle handle handle_
771 writeHandle handle handle_
772 ioe_closedHandle "hGetBuffering" handle
775 We're being non-standard here, and allow the buffering
776 of a semi-closed handle to be queried. -- sof 6/98
778 let v = haBufferMode__ handle_
779 writeHandle handle handle_
780 return v -- could be stricter..
785 hIsSeekable :: Handle -> IO Bool
787 withHandle handle $ \ handle_ -> do
788 case haType__ handle_ of
789 ErrorHandle ioError -> do
790 writeHandle handle handle_
793 writeHandle handle handle_
794 ioe_closedHandle "hIsSeekable" handle
795 SemiClosedHandle -> do
796 writeHandle handle handle_
797 ioe_closedHandle "hIsSeekable" handle
799 writeHandle handle handle_
802 rc <- CCALL(seekFileP) (haFO__ handle_) -- ConcHask: SAFE, won't block
803 writeHandle handle handle_
807 _ -> constructErrorAndFail "hIsSeekable"
811 %*********************************************************
813 \subsection{Changing echo status}
815 %*********************************************************
817 Non-standard GHC extension is to allow the echoing status
818 of a handles connected to terminals to be reconfigured:
821 hSetEcho :: Handle -> Bool -> IO ()
822 hSetEcho handle on = do
823 isT <- hIsTerminalDevice handle
827 withHandle handle $ \ handle_ -> do
828 case haType__ handle_ of
829 ErrorHandle ioError -> do
830 writeHandle handle handle_
833 writeHandle handle handle_
834 ioe_closedHandle "hSetEcho" handle
836 rc <- CCALL(setTerminalEcho) (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
837 writeHandle handle handle_
840 else constructErrorAndFail "hSetEcho"
842 hGetEcho :: Handle -> IO Bool
844 isT <- hIsTerminalDevice handle
848 withHandle handle $ \ handle_ -> do
849 case haType__ handle_ of
850 ErrorHandle ioError -> do
851 writeHandle handle handle_
854 writeHandle handle handle_
855 ioe_closedHandle "hGetEcho" handle
857 rc <- CCALL(getTerminalEcho) (haFO__ handle_) -- ConcHask: SAFE, won't block
858 writeHandle handle handle_
862 _ -> constructErrorAndFail "hSetEcho"
864 hIsTerminalDevice :: Handle -> IO Bool
865 hIsTerminalDevice handle = do
866 withHandle handle $ \ handle_ -> do
867 case haType__ handle_ of
868 ErrorHandle ioError -> do
869 writeHandle handle handle_
872 writeHandle handle handle_
873 ioe_closedHandle "hIsTerminalDevice" handle
875 rc <- CCALL(isTerminalDevice) (haFO__ handle_) -- ConcHask: SAFE, won't block
876 writeHandle handle handle_
880 _ -> constructErrorAndFail "hIsTerminalDevice"
884 hConnectTerms :: Handle -> Handle -> IO ()
885 hConnectTerms hW hR = hConnectHdl_ hW hR 1{-check if they're both coming connected to ttys-}
887 hConnectTo :: Handle -> Handle -> IO ()
888 hConnectTo hW hR = hConnectHdl_ hW hR 0{-connect regardless-}
890 hConnectHdl_ :: Handle -> Handle -> Int -> IO ()
891 hConnectHdl_ hW hR is_tty =
892 wantWriteableHandle "hConnectTo" hW $ \ hW_ -> do
893 wantReadableHandle "hConnectTo" hR $ \ hR_ -> do
894 CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
900 As an extension, we also allow characters to be pushed back.
901 Like ANSI C stdio, we guarantee no more than one character of
902 pushback. (For unbuffered channels, the (default) push-back limit is
906 hUngetChar :: Handle -> Char -> IO ()
907 hUngetChar handle c =
908 wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
909 rc <- CCALL(ungetChar) (haFO__ handle_) c -- ConcHask: SAFE, won't block
910 writeHandle handle handle_
912 then constructErrorAndFail "hUngetChar"
918 Hoisting files in in one go is sometimes useful, so we support
919 this as an extension:
922 -- in one go, read file into an externally allocated buffer.
923 slurpFile :: FilePath -> IO (Addr, Int)
925 handle <- openFile fname ReadMode
926 sz <- hFileSize handle
927 if sz > toInteger (maxBound::Int) then
928 fail (userError "slurpFile: file too big")
930 let sz_i = fromInteger sz
931 chunk <- CCALL(allocMemory__) (sz_i::Int)
935 constructErrorAndFail "slurpFile"
937 withHandle handle $ \ handle_ -> do
938 let fo = haFO__ handle_
939 rc <- mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
940 writeHandle handle handle_
943 then constructErrorAndFail "slurpFile"
944 else return (chunk, rc)
946 #ifndef __HUGS__ /* Hugs' Prelude doesn't need this */
947 hFillBufBA :: Handle -> ByteArray Int -> Int -> IO Int
948 hFillBufBA handle buf sz
949 | sz <= 0 = fail (IOError (Just handle)
952 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
954 wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
955 let fo = haFO__ handle_
957 rc <- mayBlock fo (CCALL(readChunkBA) fo buf sz) -- ConcHask: UNSAFE, may block.
959 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
961 writeHandle handle handle_
964 else constructErrorAndFail "hFillBufBA"
967 hFillBuf :: Handle -> Addr -> Int -> IO Int
968 hFillBuf handle buf sz
969 | sz <= 0 = fail (IOError (Just handle)
972 ("illegal buffer size " ++ showsPrec 9 sz [])) -- 9 => should be parens'ified.
974 wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
975 let fo = haFO__ handle_
976 rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
977 writeHandle handle handle_
980 else constructErrorAndFail "hFillBuf"
984 The @hPutBuf hdl buf len@ action writes an already packed sequence of
985 bytes to the file/channel managed by @hdl@ - non-standard.
988 hPutBuf :: Handle -> Addr -> Int -> IO ()
989 hPutBuf handle buf len =
990 wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
991 let fo = haFO__ handle_
992 rc <- mayBlock fo (CCALL(writeBuf) fo buf len) -- ConcHask: UNSAFE, may block.
993 writeHandle handle handle_
996 else constructErrorAndFail "hPutBuf"
998 #ifndef __HUGS__ /* Another one Hugs doesn't provide */
999 hPutBufBA :: Handle -> ByteArray Int -> Int -> IO ()
1000 hPutBufBA handle buf len =
1001 wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
1002 let fo = haFO__ handle_
1003 rc <- mayBlock fo (CCALL(writeBufBA) fo buf len) -- ConcHask: UNSAFE, may block.
1004 writeHandle handle handle_
1007 else constructErrorAndFail "hPutBuf"
1011 Sometimes it's useful to get at the file descriptor that
1012 the Handle contains..
1015 getHandleFd :: Handle -> IO Int
1016 getHandleFd handle = do
1017 withHandle handle $ \ handle_ -> do
1018 case (haType__ handle_) of
1019 ErrorHandle ioError -> do
1020 writeHandle handle handle_
1023 writeHandle handle handle_
1024 ioe_closedHandle "getHandleFd" handle
1026 fd <- CCALL(getFileFd) (haFO__ handle_)
1027 writeHandle handle handle_
1032 %*********************************************************
1034 \subsection{Miscellaneous}
1036 %*********************************************************
1038 These three functions are meant to get things out of @IOErrors@.
1043 ioeGetFileName :: IOError -> Maybe FilePath
1044 ioeGetErrorString :: IOError -> String
1045 ioeGetHandle :: IOError -> Maybe Handle
1047 ioeGetHandle (IOError h _ _ _) = h
1048 ioeGetErrorString (IOError _ iot _ str) =
1050 EOF -> "end of file"
1053 ioeGetFileName (IOError _ _ _ str) =
1054 case span (/=':') str of
1060 A number of operations want to get at a readable or writeable handle, and fail
1064 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1065 wantReadableHandle fun handle act =
1066 withHandle handle $ \ handle_ -> do
1067 case haType__ handle_ of
1068 ErrorHandle ioError -> do
1069 writeHandle handle handle_
1072 writeHandle handle handle_
1073 ioe_closedHandle fun handle
1074 SemiClosedHandle -> do
1075 writeHandle handle handle_
1076 ioe_closedHandle fun handle
1078 writeHandle handle handle_
1079 fail not_readable_error
1081 writeHandle handle handle_
1082 fail not_readable_error
1083 other -> act handle_
1085 not_readable_error =
1086 IOError (Just handle) IllegalOperation fun
1087 ("handle is not open for reading")
1089 wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1090 wantWriteableHandle fun handle act =
1091 withHandle handle $ \ handle_ -> do
1092 case haType__ handle_ of
1093 ErrorHandle ioError -> do
1094 writeHandle handle handle_
1097 writeHandle handle handle_
1098 ioe_closedHandle fun handle
1099 SemiClosedHandle -> do
1100 writeHandle handle handle_
1101 ioe_closedHandle fun handle
1103 writeHandle handle handle_
1104 fail not_writeable_error
1105 other -> act handle_
1107 not_writeable_error =
1108 IOError (Just handle) IllegalOperation fun
1109 ("handle is not open for writing")
1111 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
1112 wantSeekableHandle fun handle act =
1113 withHandle handle $ \ handle_ -> do
1114 case haType__ handle_ of
1115 ErrorHandle ioError -> do
1116 writeHandle handle handle_
1119 writeHandle handle handle_
1120 ioe_closedHandle fun handle
1121 SemiClosedHandle -> do
1122 writeHandle handle handle_
1123 ioe_closedHandle fun handle
1125 writeHandle handle handle_
1126 fail not_seekable_error
1129 not_seekable_error =
1130 IOError (Just handle)
1131 IllegalOperation fun
1132 ("handle is not seekable")
1136 Internal function for creating an @IOError@ representing the
1137 access to a closed file.
1140 ioe_closedHandle :: String -> Handle -> IO a
1141 ioe_closedHandle fun h = fail (IOError (Just h) IllegalOperation fun "handle is closed")
1144 Internal helper functions for Concurrent Haskell implementation
1148 #ifndef __PARALLEL_HASKELL__
1149 mayBlock :: ForeignObj -> IO Int -> IO Int
1151 mayBlock :: Addr -> IO Int -> IO Int
1154 #ifndef notyet /*__CONCURRENT_HASKELL__*/
1155 mayBlock _ act = act
1157 mayBlock fo act = do
1160 -5 -> do -- (possibly blocking) read
1161 fd <- CCALL(getFileFd) fo
1163 CCALL(clearNonBlockingIOFlag__) fo -- force read to happen this time.
1164 mayBlock fo act -- input available, re-try
1165 -6 -> do -- (possibly blocking) write
1166 fd <- CCALL(getFileFd) fo
1168 CCALL(clearNonBlockingIOFlag__) fo -- force write to happen this time.
1169 mayBlock fo act -- output possible
1170 -7 -> do -- (possibly blocking) write on connected handle
1171 fd <- CCALL(getConnFileFd) fo
1173 CCALL(clearConnNonBlockingIOFlag__) fo -- force write to happen this time.
1174 mayBlock fo act -- output possible
1176 CCALL(setNonBlockingIOFlag__) fo -- reset file object.
1177 CCALL(setConnNonBlockingIOFlag__) fo -- reset (connected) file object.
1183 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
1185 -- Hugs does actually have the primops needed to implement these
1186 -- but, like GHC, the primops don't actually do anything...
1187 threadDelay _ = return ()
1188 threadWaitRead _ = return ()
1189 threadWaitWrite _ = return ()
1198 type Exclusive = Int -- really Bool
1201 type OpenStdFlags = Int
1202 type OpenFlags = Int
1203 type Readable = Int -- really Bool
1204 type Flush = Int -- really Bool
1205 type RC = Int -- standard return code
1207 type IOFileAddr = Addr -- as returned from functions
1208 type CString = PrimByteArray
1209 type Bytes = PrimMutableByteArray RealWorld
1211 #ifndef __PARALLEL_HASKELL__
1212 type FILE_OBJ = ForeignObj -- as passed into functions
1214 type FILE_OBJ = Addr
1217 foreign import stdcall "libHS_cbits.so" "setBuf" prim_setBuf :: FILE_OBJ -> Addr -> Int -> IO ()
1218 foreign import stdcall "libHS_cbits.so" "getBufSize" prim_getBufSize :: FILE_OBJ -> IO Int
1219 foreign import stdcall "libHS_cbits.so" "inputReady" prim_inputReady :: FILE_OBJ -> Int -> IO RC
1220 foreign import stdcall "libHS_cbits.so" "fileGetc" prim_fileGetc :: FILE_OBJ -> IO Int
1221 foreign import stdcall "libHS_cbits.so" "fileLookAhead" prim_fileLookAhead :: FILE_OBJ -> IO Int
1222 foreign import stdcall "libHS_cbits.so" "readBlock" prim_readBlock :: FILE_OBJ -> IO Int
1223 foreign import stdcall "libHS_cbits.so" "readLine" prim_readLine :: FILE_OBJ -> IO Int
1224 foreign import stdcall "libHS_cbits.so" "readChar" prim_readChar :: FILE_OBJ -> IO Int
1225 foreign import stdcall "libHS_cbits.so" "writeFileObject" prim_writeFileObject :: FILE_OBJ -> Int -> IO RC
1226 foreign import stdcall "libHS_cbits.so" "filePutc" prim_filePutc :: FILE_OBJ -> Char -> IO RC
1227 foreign import stdcall "libHS_cbits.so" "getBufStart" prim_getBufStart :: FILE_OBJ -> Int -> IO Addr
1228 foreign import stdcall "libHS_cbits.so" "getWriteableBuf" prim_getWriteableBuf :: FILE_OBJ -> IO Addr
1229 foreign import stdcall "libHS_cbits.so" "getBufWPtr" prim_getBufWPtr :: FILE_OBJ -> IO Int
1230 foreign import stdcall "libHS_cbits.so" "setBufWPtr" prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
1231 foreign import stdcall "libHS_cbits.so" "closeFile" prim_closeFile :: FILE_OBJ -> Flush -> IO RC
1232 foreign import stdcall "libHS_cbits.so" "fileEOF" prim_fileEOF :: FILE_OBJ -> IO RC
1233 foreign import stdcall "libHS_cbits.so" "setBuffering" prim_setBuffering :: FILE_OBJ -> Int -> IO RC
1234 foreign import stdcall "libHS_cbits.so" "flushFile" prim_flushFile :: FILE_OBJ -> IO RC
1235 foreign import stdcall "libHS_cbits.so" "getBufferMode" prim_getBufferMode :: FILE_OBJ -> IO RC
1236 foreign import stdcall "libHS_cbits.so" "seekFile_int64" prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
1237 foreign import stdcall "libHS_cbits.so" "seekFileP" prim_seekFileP :: FILE_OBJ -> IO RC
1238 foreign import stdcall "libHS_cbits.so" "setTerminalEcho" prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
1239 foreign import stdcall "libHS_cbits.so" "getTerminalEcho" prim_getTerminalEcho :: FILE_OBJ -> IO RC
1240 foreign import stdcall "libHS_cbits.so" "isTerminalDevice" prim_isTerminalDevice :: FILE_OBJ -> IO RC
1241 foreign import stdcall "libHS_cbits.so" "setConnectedTo" prim_setConnectedTo :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
1242 foreign import stdcall "libHS_cbits.so" "ungetChar" prim_ungetChar :: FILE_OBJ -> Char -> IO RC
1243 foreign import stdcall "libHS_cbits.so" "readChunk" prim_readChunk :: FILE_OBJ -> Addr -> Int -> IO RC
1244 foreign import stdcall "libHS_cbits.so" "writeBuf" prim_writeBuf :: FILE_OBJ -> Addr -> Int -> IO RC
1245 foreign import stdcall "libHS_cbits.so" "getFileFd" prim_getFileFd :: FILE_OBJ -> IO FD
1246 foreign import stdcall "libHS_cbits.so" "fileSize_int64" prim_fileSize_int64 :: FILE_OBJ -> Bytes -> IO RC
1247 foreign import stdcall "libHS_cbits.so" "getFilePosn" prim_getFilePosn :: FILE_OBJ -> IO Int
1248 foreign import stdcall "libHS_cbits.so" "setFilePosn" prim_setFilePosn :: FILE_OBJ -> Int -> IO Int
1249 foreign import stdcall "libHS_cbits.so" "getConnFileFd" prim_getConnFileFd :: FILE_OBJ -> IO FD
1250 foreign import stdcall "libHS_cbits.so" "allocMemory__" prim_allocMemory__ :: Int -> IO Addr
1251 foreign import stdcall "libHS_cbits.so" "getLock" prim_getLock :: FD -> Exclusive -> IO RC
1252 foreign import stdcall "libHS_cbits.so" "openStdFile" prim_openStdFile :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
1253 foreign import stdcall "libHS_cbits.so" "openFile" prim_openFile :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
1254 foreign import stdcall "libHS_cbits.so" "freeFileObject" prim_freeFileObject :: FILE_OBJ -> IO ()
1255 foreign import stdcall "libHS_cbits.so" "freeStdFileObject" prim_freeStdFileObject :: FILE_OBJ -> IO ()
1256 foreign import stdcall "libHS_cbits.so" "const_BUFSIZ" const_BUFSIZ :: Int
1258 foreign import stdcall "libHS_cbits.so" "setConnNonBlockingIOFlag__" prim_setConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1259 foreign import stdcall "libHS_cbits.so" "clearConnNonBlockingIOFlag__" prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1260 foreign import stdcall "libHS_cbits.so" "setNonBlockingIOFlag__" prim_setNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1261 foreign import stdcall "libHS_cbits.so" "clearNonBlockingIOFlag__" prim_clearNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
1263 foreign import stdcall "libHS_cbits.so" "getErrStr__" prim_getErrStr__ :: IO Addr
1264 foreign import stdcall "libHS_cbits.so" "getErrNo__" prim_getErrNo__ :: IO Int
1265 foreign import stdcall "libHS_cbits.so" "getErrType__" prim_getErrType__ :: IO Int