import Foreign
import PackedString ( unpackCString )
import PrelBase
+import PrelRead
import GHC
+import ArrBase ( ByteArray(..), MutableVar(..) )
infixr 1 `thenIO_Prim`
\end{code}
map f x = x >>= (return . f)
instance Monad IO where
-{- No inlining for now... until we can inline some of the
- imports, like $, these functions are pretty big.
{-# INLINE return #-}
{-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
--}
m >> k = m >>= \ _ -> k
return x = IO $ ST $ \ s@(S# _) -> (Right x, s)
fail err = IO $ ST $ \ s -> (Left err, s)
userError :: String -> IOError
-userError str = UserError str
+userError str = IOError Nothing UserError str
catch :: IO a -> (IOError -> IO a) -> IO a
catch (IO (ST m)) k = IO $ ST $ \ s ->
%* *
%*********************************************************
+A value @IOError@ encode errors occurred in the @IO@ monad.
+An @IOError@ records a more specific error type, a descriptive
+string and maybe the handle that was used when the error was
+flagged.
+
\begin{code}
-data IOError
- = AlreadyExists String
- | HardwareFault String
- | IllegalOperation String
- | InappropriateType String
- | Interrupted String
- | InvalidArgument String
- | NoSuchThing String
- | OtherError String
- | PermissionDenied String
- | ProtocolError String
- | ResourceBusy String
- | ResourceExhausted String
- | ResourceVanished String
- | SystemError String
- | TimeExpired String
- | UnsatisfiedConstraints String
- | UnsupportedOperation String
- | UserError String
- | EOF
+data IOError
+ = IOError
+ (Maybe Handle) -- the handle used by the action flagging the
+ -- the error.
+ IOErrorType -- what it was.
+ String -- error type specific information.
instance Eq IOError where
- -- I don't know what the (pointless) idea is here,
- -- presumably just compare them by their tags (WDP)
- a == b = tag a == tag b
- where
- tag (AlreadyExists _) = (1::Int)
- tag (HardwareFault _) = 2
- tag (IllegalOperation _) = 3
- tag (InappropriateType _) = 4
- tag (Interrupted _) = 5
- tag (InvalidArgument _) = 6
- tag (NoSuchThing _) = 7
- tag (OtherError _) = 8
- tag (PermissionDenied _) = 9
- tag (ProtocolError _) = 10
- tag (ResourceBusy _) = 11
- tag (ResourceExhausted _) = 12
- tag (ResourceVanished _) = 13
- tag (SystemError _) = 14
- tag (TimeExpired _) = 15
- tag (UnsatisfiedConstraints _) = 16
- tag (UnsupportedOperation _) = 17
- tag (UserError _) = 18
- tag EOF = 19
+ (IOError h1 e1 str1) == (IOError h2 e2 str2) =
+ e1==e2 && str1==str2 && h1==h2
+
+data IOErrorType
+ = AlreadyExists | HardwareFault
+ | IllegalOperation | InappropriateType
+ | Interrupted | InvalidArgument
+ | NoSuchThing | OtherError
+ | PermissionDenied | ProtocolError
+ | ResourceBusy | ResourceExhausted
+ | ResourceVanished | SystemError
+ | TimeExpired | UnsatisfiedConstraints
+ | UnsupportedOperation | UserError
+ | EOF
+ deriving (Eq, Show)
+
\end{code}
-Predicates on IOError; almost no effort made on these so far...
+Predicates on IOError; little effort made on these so far...
\begin{code}
-isAlreadyExistsError (AlreadyExists _) = True
-isAlreadyExistsError _ = False
+isAlreadyExistsError (IOError _ AlreadyExists _) = True
+isAlreadyExistsError _ = False
+
+isAlreadyInUseError (IOError _ ResourceBusy _) = True
+isAlreadyInUseError _ = False
-isAlreadyInUseError (ResourceBusy _) = True
-isAlreadyInUseError _ = False
+isFullError (IOError _ ResourceExhausted _) = True
+isFullError _ = False
-isFullError (ResourceExhausted _) = True
-isFullError _ = False
+isEOFError (IOError _ EOF _) = True
+isEOFError _ = True
-isEOFError EOF = True
-isEOFError _ = True
+isIllegalOperation (IOError _ IllegalOperation _) = True
+isIllegalOperation _ = False
-isIllegalOperation (IllegalOperation _) = True
-isIllegalOperation _ = False
+isPermissionError (IOError _ PermissionDenied _) = True
+isPermissionError _ = False
-isPermissionError (PermissionDenied _) = True
-isPermissionError _ = False
+isDoesNotExistError (IOError _ NoSuchThing _) = True
+isDoesNotExistError _ = False
-isUserError (UserError s) = Just s
-isUserError _ = Nothing
+isUserError (IOError _ UserError s) = Just s
+isUserError _ = Nothing
\end{code}
Showing @IOError@s
\begin{code}
instance Show IOError where
- showsPrec p (AlreadyExists s) = show2 "AlreadyExists: " s
- showsPrec p (HardwareFault s) = show2 "HardwareFault: " s
- showsPrec p (IllegalOperation s) = show2 "IllegalOperation: " s
- showsPrec p (InappropriateType s) = show2 "InappropriateType: " s
- showsPrec p (Interrupted s) = show2 "Interrupted: " s
- showsPrec p (InvalidArgument s) = show2 "InvalidArgument: " s
- showsPrec p (NoSuchThing s) = show2 "NoSuchThing: " s
- showsPrec p (OtherError s) = show2 "OtherError: " s
- showsPrec p (PermissionDenied s) = show2 "PermissionDenied: " s
- showsPrec p (ProtocolError s) = show2 "ProtocolError: " s
- showsPrec p (ResourceBusy s) = show2 "ResourceBusy: " s
- showsPrec p (ResourceExhausted s) = show2 "ResourceExhausted: " s
- showsPrec p (ResourceVanished s) = show2 "ResourceVanished: " s
- showsPrec p (SystemError s) = show2 "SystemError: " s
- showsPrec p (TimeExpired s) = show2 "TimeExpired: " s
- showsPrec p (UnsatisfiedConstraints s) = show2 "UnsatisfiedConstraints: " s
- showsPrec p (UnsupportedOperation s)= show2 "UnsupportedOperation: " s
- showsPrec p (UserError s) = showString s
- showsPrec p EOF = showString "EOF"
-
-show2 x y = showString x . showString y
+ showsPrec p (IOError _ UserError s) rs =
+ showString s rs
+ showsPrec p (IOError _ EOF _) rs =
+ showsPrec p EOF rs
+ showsPrec p (IOError _ iot s) rs =
+ showsPrec p
+ iot
+ (case s of {
+ "" -> rs;
+ _ -> showString ": " $
+ showString s rs})
-{-
+\end{code}
The @String@ part of an @IOError@ is platform-dependent. However, to
provide a uniform mechanism for distinguishing among errors within
explicitly mentioned in the standard, any descriptive string may be
used.
- SOF 4/96 - added argument to indicate function that flagged error
--}
-constructErrorAndFail :: String -> IO a
-constructError :: String -> PrimIO IOError
+\begin{change}
+SOF & 4/96 & added argument to indicate function that flagged error
+\end{change}
+% Hmm..does these envs work?!...SOF
+\begin{code}
+constructErrorAndFail :: String -> IO a
constructErrorAndFail call_site
= stToIO (constructError call_site) >>= \ io_error ->
fail io_error
-constructError call_site
- = _casm_ ``%r = ghc_errtype;'' >>= \ (I# errtype#) ->
- _casm_ ``%r = ghc_errstr;'' >>= \ str ->
- let
- msg = call_site ++ ':' : ' ' : unpackCString str
- in
- return (case errtype# of
- ERR_ALREADYEXISTS# -> AlreadyExists msg
- ERR_HARDWAREFAULT# -> HardwareFault msg
- ERR_ILLEGALOPERATION# -> IllegalOperation msg
- ERR_INAPPROPRIATETYPE# -> InappropriateType msg
- ERR_INTERRUPTED# -> Interrupted msg
- ERR_INVALIDARGUMENT# -> InvalidArgument msg
- ERR_NOSUCHTHING# -> NoSuchThing msg
- ERR_OTHERERROR# -> OtherError msg
- ERR_PERMISSIONDENIED# -> PermissionDenied msg
- ERR_PROTOCOLERROR# -> ProtocolError msg
- ERR_RESOURCEBUSY# -> ResourceBusy msg
- ERR_RESOURCEEXHAUSTED# -> ResourceExhausted msg
- ERR_RESOURCEVANISHED# -> ResourceVanished msg
- ERR_SYSTEMERROR# -> SystemError msg
- ERR_TIMEEXPIRED# -> TimeExpired msg
- ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints msg
- ERR_UNSUPPORTEDOPERATION# -> UnsupportedOperation msg
- ERR_EOF# -> EOF
- _ -> OtherError "bad error construct"
- )
\end{code}
+This doesn't seem to be documented/spelled out anywhere,
+so here goes: (SOF)
+
+The implementation of the IO prelude uses various C stubs
+to do the actual interaction with the OS. The bandwidth
+\tr{C<->Haskell} is somewhat limited, so the general strategy
+for flaggging any errors (apart from possibly using the
+return code of the external call), is to set the @ghc_errtype@
+to a value that is one of the \tr{#define}s in @includes/error.h@.
+@ghc_errstr@ holds a character string providing error-specific
+information.
+
+\begin{code}
+constructError :: String -> PrimIO IOError
+constructError call_site =
+ _casm_ ``%r = ghc_errtype;'' >>= \ (I# errtype#) ->
+ _casm_ ``%r = ghc_errstr;'' >>= \ str ->
+ let
+ iot =
+ case errtype# of
+ ERR_ALREADYEXISTS# -> AlreadyExists
+ ERR_HARDWAREFAULT# -> HardwareFault
+ ERR_ILLEGALOPERATION# -> IllegalOperation
+ ERR_INAPPROPRIATETYPE# -> InappropriateType
+ ERR_INTERRUPTED# -> Interrupted
+ ERR_INVALIDARGUMENT# -> InvalidArgument
+ ERR_NOSUCHTHING# -> NoSuchThing
+ ERR_OTHERERROR# -> OtherError
+ ERR_PERMISSIONDENIED# -> PermissionDenied
+ ERR_PROTOCOLERROR# -> ProtocolError
+ ERR_RESOURCEBUSY# -> ResourceBusy
+ ERR_RESOURCEEXHAUSTED# -> ResourceExhausted
+ ERR_RESOURCEVANISHED# -> ResourceVanished
+ ERR_SYSTEMERROR# -> SystemError
+ ERR_TIMEEXPIRED# -> TimeExpired
+ ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
+ ERR_UNSUPPORTEDOPERATION# -> UnsupportedOperation
+ ERR_EOF# -> EOF
+ _ -> OtherError
+
+ msg =
+ case iot of
+ EOF -> ""
+ OtherError -> "bad error construct"
+ _ -> call_site ++ ':' : ' ' : unpackCString str
+ in
+ return (IOError Nothing iot msg)
+\end{code}
+%*********************************************************
+%* *
+\subsection{Types @Handle@, @Handle__@}
+%* *
+%*********************************************************
+
+The type for @Handle@ is defined rather than in @IOHandle@
+module, as the @IOError@ type uses it..all operations over
+a handles reside in @IOHandle@.
+
+\begin{code}
+
+{-
+ Sigh, the MVar ops in ConcBase depend on IO, the IO
+ representation here depend on MVars for handles (when
+ compiling a concurrent way). Break the cycle by having
+ the definition of MVars go here:
+
+-}
+data MVar a = MVar (SynchVar# RealWorld a)
+
+#if defined(__CONCURRENT_HASKELL__)
+type Handle = MVar Handle__
+#else
+type Handle = MutableVar RealWorld Handle__
+#endif
+
+data Handle__
+ = ErrorHandle IOError
+ | ClosedHandle
+ | SemiClosedHandle ForeignObj (Addr, Int)
+ | ReadHandle ForeignObj (Maybe BufferMode) Bool
+ | WriteHandle ForeignObj (Maybe BufferMode) Bool
+ | AppendHandle ForeignObj (Maybe BufferMode) Bool
+ | ReadWriteHandle ForeignObj (Maybe BufferMode) Bool
+
+-- Standard Instances as defined by the Report..
+
+instance Eq Handle {-partain:????-}
+instance Show Handle where {showsPrec p h = showString "<<Handle>>"}
+
+\end{code}
+
+%*********************************************************
+%* *
+\subsection[BufferMode]{Buffering modes}
+%* *
+%*********************************************************
+
+Three kinds of buffering are supported: line-buffering,
+block-buffering or no-buffering. These modes have the following
+effects. For output, items are written out from the internal
+buffer according to the buffer mode:
+
+\begin{itemize}
+\item[line-buffering] the entire output buffer is written
+out whenever a newline is output, the output buffer overflows,
+a flush is issued, or the handle is closed.
+
+\item[block-buffering] the entire output buffer is written out whenever
+it overflows, a flush is issued, or the handle
+is closed.
+
+\item[no-buffering] output is written immediately, and never stored
+in the output buffer.
+\end{itemize}
+
+The output buffer is emptied as soon as it has been written out.
+
+Similarly, input occurs according to the buffer mode for handle {\em hdl}.
+\begin{itemize}
+\item[line-buffering] when the input buffer for {\em hdl} is not empty,
+the next item is obtained from the buffer;
+otherwise, when the input buffer is empty,
+characters up to and including the next newline
+character are read into the buffer. No characters
+are available until the newline character is
+available.
+\item[block-buffering] when the input buffer for {\em hdl} becomes empty,
+the next block of data is read into this buffer.
+\item[no-buffering] the next input item is read and returned.
+\end{itemize}
+For most implementations, physical files will normally be block-buffered
+and terminals will normally be line-buffered.
+
+\begin{code}
+data BufferMode
+ = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
+ deriving (Eq, Ord, Read, Show)
+\end{code}
projects / ghc-hetmet.git / blobdiff