ghc/lib/std/PrelCError.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelCError.lhs,v 1.4 2001/01/16 06:02:29 qrczak Exp $
   3 %
   4 % (c) The FFI task force, 2000
   5 %
   6
   7 C-specific Marshalling support: Handling of C "errno" error codes
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 -- this is were we get the CCONST_XXX definitions from that configure
  13 -- calculated for us
  14 --
  15 #include "config.h"
  16
  17 module PrelCError (
  18
  19   -- Haskell representation for "errno" values
  20   --
  21   Errno(..),            -- instance: Eq
  22   eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
  23   eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
  24   eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
  25   eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
  26   eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
  27   eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
  28   eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
  29   eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
  30   eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
  31   eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
  32   ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
  33   eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
  34   eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
  35   eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV,
  36                         -- :: Errno
  37   isValidErrno,         -- :: Errno -> Bool
  38
  39   -- access to the current thread's "errno" value
  40   --
  41   getErrno,             -- :: IO Errno
  42   resetErrno,           -- :: IO ()
  43
  44   -- conversion of an "errno" value into IO error
  45   --
  46   errnoToIOError,       -- :: String       -- location
  47                         -- -> Errno        -- errno
  48                         -- -> Maybe Handle -- handle
  49                         -- -> Maybe String -- filename
  50                         -- -> IOError
  51
  52   -- throw current "errno" value
  53   --
  54   throwErrno,           -- ::                String               -> IO a
  55
  56   -- guards for IO operations that may fail
  57   --
  58   throwErrnoIf,         -- :: (a -> Bool) -> String -> IO a       -> IO a
  59   throwErrnoIf_,        -- :: (a -> Bool) -> String -> IO a       -> IO ()
  60   throwErrnoIfRetry,    -- :: (a -> Bool) -> String -> IO a       -> IO a
  61   throwErrnoIfRetry_,   -- :: (a -> Bool) -> String -> IO a       -> IO ()
  62   throwErrnoIfMinus1,   -- :: Num a
  63                         -- =>                String -> IO a       -> IO a
  64   throwErrnoIfMinus1_,  -- :: Num a
  65                         -- =>                String -> IO a       -> IO ()
  66   throwErrnoIfMinus1Retry,
  67                         -- :: Num a
  68                         -- =>                String -> IO a       -> IO a
  69   throwErrnoIfMinus1Retry_,
  70                         -- :: Num a
  71                         -- =>                String -> IO a       -> IO ()
  72   throwErrnoIfNull,     -- ::                String -> IO (Ptr a) -> IO (Ptr a)
  73   throwErrnoIfNullRetry -- ::                String -> IO (Ptr a) -> IO (Ptr a)
  74 ) where
  75
  76
  77 -- system dependent imports
  78 -- ------------------------
  79
  80 -- GHC allows us to get at the guts inside IO errors/exceptions
  81 --
  82 #if __GLASGOW_HASKELL__
  83 #if __GLASGOW_HASKELL__ < 409
  84 import PrelIOBase (IOError(..), IOErrorType(..))
  85 #else
  86 import PrelIOBase (Exception(..), IOException(..), IOErrorType(..))
  87 #endif
  88 #endif /* __GLASGOW_HASKELL__ */
  89
  90
  91 -- regular imports
  92 -- ---------------
  93
  94 import Monad        (liftM)
  95
  96 #if __GLASGOW_HASKELL__
  97 import PrelStorable
  98 import PrelMarshalError
  99 import PrelCTypes
 100 import PrelIOBase
 101 import PrelPtr
 102 import PrelNum
 103 import PrelShow
 104 import PrelMaybe
 105 import PrelBase
 106 #else
 107 import Ptr          (Ptr, nullPtr)
 108 import CTypes       (CInt)
 109 import MarshalError (void)
 110
 111 import IO           (IOError, Handle, ioError)
 112 #endif
 113
 114 -- system dependent re-definitions
 115 -- -------------------------------
 116
 117 -- we bring GHC's `IOErrorType' in scope in other compilers to simplify the
 118 -- routine `errnoToIOError' below
 119 --
 120 #if !__GLASGOW_HASKELL__
 121 data IOErrorType
 122   = AlreadyExists        | HardwareFault
 123   | IllegalOperation     | InappropriateType
 124   | Interrupted          | InvalidArgument
 125   | NoSuchThing          | OtherError
 126   | PermissionDenied     | ProtocolError
 127   | ResourceBusy         | ResourceExhausted
 128   | ResourceVanished     | SystemError
 129   | TimeExpired          | UnsatisfiedConstraints
 130   | UnsupportedOperation
 131   | EOF
 132 #endif
 133
 134
 135 -- "errno" type
 136 -- ------------
 137
 138 -- Haskell representation for "errno" values
 139 --
 140 newtype Errno = Errno CInt
 141
 142 instance Eq Errno where
 143   errno1@(Errno no1) == errno2@(Errno no2)
 144     | isValidErrno errno1 && isValidErrno errno2 = no1 == no2
 145     | otherwise                                  = False
 146
 147 -- common "errno" symbols
 148 --
 149 eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
 150   eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
 151   eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
 152   eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
 153   eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
 154   eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
 155   eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
 156   eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
 157   eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
 158   eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
 159   ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
 160   eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
 161   eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
 162   eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV                    :: Errno
 163 --
 164 -- the CCONST_XXX identifiers are cpp symbols whose value is computed by
 165 -- configure
 166 --
 167 eOK             = Errno 0
 168 e2BIG           = Errno (CCONST_E2BIG)
 169 eACCES          = Errno (CCONST_EACCES)
 170 eADDRINUSE      = Errno (CCONST_EADDRINUSE)
 171 eADDRNOTAVAIL   = Errno (CCONST_EADDRNOTAVAIL)
 172 eADV            = Errno (CCONST_EADV)
 173 eAFNOSUPPORT    = Errno (CCONST_EAFNOSUPPORT)
 174 eAGAIN          = Errno (CCONST_EAGAIN)
 175 eALREADY        = Errno (CCONST_EALREADY)
 176 eBADF           = Errno (CCONST_EBADF)
 177 eBADMSG         = Errno (CCONST_EBADMSG)
 178 eBADRPC         = Errno (CCONST_EBADRPC)
 179 eBUSY           = Errno (CCONST_EBUSY)
 180 eCHILD          = Errno (CCONST_ECHILD)
 181 eCOMM           = Errno (CCONST_ECOMM)
 182 eCONNABORTED    = Errno (CCONST_ECONNABORTED)
 183 eCONNREFUSED    = Errno (CCONST_ECONNREFUSED)
 184 eCONNRESET      = Errno (CCONST_ECONNRESET)
 185 eDEADLK         = Errno (CCONST_EDEADLK)
 186 eDESTADDRREQ    = Errno (CCONST_EDESTADDRREQ)
 187 eDIRTY          = Errno (CCONST_EDIRTY)
 188 eDOM            = Errno (CCONST_EDOM)
 189 eDQUOT          = Errno (CCONST_EDQUOT)
 190 eEXIST          = Errno (CCONST_EEXIST)
 191 eFAULT          = Errno (CCONST_EFAULT)
 192 eFBIG           = Errno (CCONST_EFBIG)
 193 eFTYPE          = Errno (CCONST_EFTYPE)
 194 eHOSTDOWN       = Errno (CCONST_EHOSTDOWN)
 195 eHOSTUNREACH    = Errno (CCONST_EHOSTUNREACH)
 196 eIDRM           = Errno (CCONST_EIDRM)
 197 eILSEQ          = Errno (CCONST_EILSEQ)
 198 eINPROGRESS     = Errno (CCONST_EINPROGRESS)
 199 eINTR           = Errno (CCONST_EINTR)
 200 eINVAL          = Errno (CCONST_EINVAL)
 201 eIO             = Errno (CCONST_EIO)
 202 eISCONN         = Errno (CCONST_EISCONN)
 203 eISDIR          = Errno (CCONST_EISDIR)
 204 eLOOP           = Errno (CCONST_ELOOP)
 205 eMFILE          = Errno (CCONST_EMFILE)
 206 eMLINK          = Errno (CCONST_EMLINK)
 207 eMSGSIZE        = Errno (CCONST_EMSGSIZE)
 208 eMULTIHOP       = Errno (CCONST_EMULTIHOP)
 209 eNAMETOOLONG    = Errno (CCONST_ENAMETOOLONG)
 210 eNETDOWN        = Errno (CCONST_ENETDOWN)
 211 eNETRESET       = Errno (CCONST_ENETRESET)
 212 eNETUNREACH     = Errno (CCONST_ENETUNREACH)
 213 eNFILE          = Errno (CCONST_ENFILE)
 214 eNOBUFS         = Errno (CCONST_ENOBUFS)
 215 eNODATA         = Errno (CCONST_ENODATA)
 216 eNODEV          = Errno (CCONST_ENODEV)
 217 eNOENT          = Errno (CCONST_ENOENT)
 218 eNOEXEC         = Errno (CCONST_ENOEXEC)
 219 eNOLCK          = Errno (CCONST_ENOLCK)
 220 eNOLINK         = Errno (CCONST_ENOLINK)
 221 eNOMEM          = Errno (CCONST_ENOMEM)
 222 eNOMSG          = Errno (CCONST_ENOMSG)
 223 eNONET          = Errno (CCONST_ENONET)
 224 eNOPROTOOPT     = Errno (CCONST_ENOPROTOOPT)
 225 eNOSPC          = Errno (CCONST_ENOSPC)
 226 eNOSR           = Errno (CCONST_ENOSR)
 227 eNOSTR          = Errno (CCONST_ENOSTR)
 228 eNOSYS          = Errno (CCONST_ENOSYS)
 229 eNOTBLK         = Errno (CCONST_ENOTBLK)
 230 eNOTCONN        = Errno (CCONST_ENOTCONN)
 231 eNOTDIR         = Errno (CCONST_ENOTDIR)
 232 eNOTEMPTY       = Errno (CCONST_ENOTEMPTY)
 233 eNOTSOCK        = Errno (CCONST_ENOTSOCK)
 234 eNOTTY          = Errno (CCONST_ENOTTY)
 235 eNXIO           = Errno (CCONST_ENXIO)
 236 eOPNOTSUPP      = Errno (CCONST_EOPNOTSUPP)
 237 ePERM           = Errno (CCONST_EPERM)
 238 ePFNOSUPPORT    = Errno (CCONST_EPFNOSUPPORT)
 239 ePIPE           = Errno (CCONST_EPIPE)
 240 ePROCLIM        = Errno (CCONST_EPROCLIM)
 241 ePROCUNAVAIL    = Errno (CCONST_EPROCUNAVAIL)
 242 ePROGMISMATCH   = Errno (CCONST_EPROGMISMATCH)
 243 ePROGUNAVAIL    = Errno (CCONST_EPROGUNAVAIL)
 244 ePROTO          = Errno (CCONST_EPROTO)
 245 ePROTONOSUPPORT = Errno (CCONST_EPROTONOSUPPORT)
 246 ePROTOTYPE      = Errno (CCONST_EPROTOTYPE)
 247 eRANGE          = Errno (CCONST_ERANGE)
 248 eREMCHG         = Errno (CCONST_EREMCHG)
 249 eREMOTE         = Errno (CCONST_EREMOTE)
 250 eROFS           = Errno (CCONST_EROFS)
 251 eRPCMISMATCH    = Errno (CCONST_ERPCMISMATCH)
 252 eRREMOTE        = Errno (CCONST_ERREMOTE)
 253 eSHUTDOWN       = Errno (CCONST_ESHUTDOWN)
 254 eSOCKTNOSUPPORT = Errno (CCONST_ESOCKTNOSUPPORT)
 255 eSPIPE          = Errno (CCONST_ESPIPE)
 256 eSRCH           = Errno (CCONST_ESRCH)
 257 eSRMNT          = Errno (CCONST_ESRMNT)
 258 eSTALE          = Errno (CCONST_ESTALE)
 259 eTIME           = Errno (CCONST_ETIME)
 260 eTIMEDOUT       = Errno (CCONST_ETIMEDOUT)
 261 eTOOMANYREFS    = Errno (CCONST_ETOOMANYREFS)
 262 eTXTBSY         = Errno (CCONST_ETXTBSY)
 263 eUSERS          = Errno (CCONST_EUSERS)
 264 eWOULDBLOCK     = Errno (CCONST_EWOULDBLOCK)
 265 eXDEV           = Errno (CCONST_EXDEV)
 266
 267 -- checks whether the given errno value is supported on the current
 268 -- architecture
 269 --
 270 isValidErrno               :: Errno -> Bool
 271 --
 272 -- the configure script sets all invalid "errno"s to -1
 273 --
 274 isValidErrno (Errno errno)  = errno /= -1
 275
 276
 277 -- access to the current thread's "errno" value
 278 -- --------------------------------------------
 279
 280 -- yield the current thread's "errno" value
 281 --
 282 getErrno :: IO Errno
 283 getErrno  = liftM Errno (peek _errno)
 284
 285
 286 -- set the current thread's "errno" value to 0
 287 --
 288 resetErrno :: IO ()
 289 resetErrno  = poke _errno 0
 290
 291
 292 -- throw current "errno" value
 293 -- ---------------------------
 294
 295 -- the common case: throw an IO error based on a textual description
 296 -- of the error location and the current thread's "errno" value
 297 --
 298 throwErrno     :: String -> IO a
 299 throwErrno loc  =
 300   do
 301     errno <- getErrno
 302     ioError (errnoToIOError loc errno Nothing Nothing)
 303
 304
 305 -- guards for IO operations that may fail
 306 -- --------------------------------------
 307
 308 -- guard an IO operation and throw an "errno" based exception of the result
 309 -- value of the IO operation meets the given predicate
 310 --
 311 throwErrnoIf            :: (a -> Bool) -> String -> IO a -> IO a
 312 throwErrnoIf pred loc f  =
 313   do
 314     res <- f
 315     if pred res then throwErrno loc else return res
 316
 317 -- as `throwErrnoIf', but discards the result
 318 --
 319 throwErrnoIf_            :: (a -> Bool) -> String -> IO a -> IO ()
 320 throwErrnoIf_ pred loc f  = void $ throwErrnoIf pred loc f
 321
 322 -- as `throwErrnoIf', but retries interrupted IO operations (ie, those whose
 323 -- flag `EINTR')
 324 --
 325 throwErrnoIfRetry            :: (a -> Bool) -> String -> IO a -> IO a
 326 throwErrnoIfRetry pred loc f  =
 327   do
 328     res <- f
 329     if pred res
 330       then do
 331         err <- getErrno
 332         if err == eINTR
 333           then throwErrnoIfRetry pred loc f
 334           else throwErrno loc
 335       else return res
 336
 337 -- as `throwErrnoIfRetry', but discards the result
 338 --
 339 throwErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()
 340 throwErrnoIfRetry_ pred loc f  = void $ throwErrnoIfRetry pred loc f
 341
 342 -- throws "errno" if a result of "-1" is returned
 343 --
 344 throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a
 345 throwErrnoIfMinus1  = throwErrnoIf (== -1)
 346
 347 -- as `throwErrnoIfMinus1', but discards the result
 348 --
 349 throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()
 350 throwErrnoIfMinus1_  = throwErrnoIf_ (== -1)
 351
 352 -- throws "errno" if a result of "-1" is returned, but retries in case of an
 353 -- interrupted operation
 354 --
 355 throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a
 356 throwErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)
 357
 358 -- as `throwErrnoIfMinus1', but discards the result
 359 --
 360 throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO ()
 361 throwErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)
 362
 363 -- throws "errno" if a result of a NULL pointer is returned
 364 --
 365 throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
 366 throwErrnoIfNull  = throwErrnoIf (== nullPtr)
 367
 368 -- throws "errno" if a result of a NULL pointer is returned, but retries in
 369 -- case of an interrupted operation
 370 --
 371 throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
 372 throwErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)
 373
 374
 375 -- conversion of an "errno" value into IO error
 376 -- --------------------------------------------
 377
 378 -- convert a location string, an "errno" value, an optional handle,
 379 -- and an optional filename into a matching IO error
 380 --
 381 errnoToIOError :: String -> Errno -> Maybe Handle -> Maybe String -> IOError
 382 errnoToIOError loc errno@(Errno no) maybeHdl maybeName =
 383 #if __GLASGOW_HASKELL__
 384   IOException (IOError maybeHdl errType loc str maybeName)
 385 #else
 386   userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName)
 387 #endif
 388   where
 389     (errType, str)
 390       | errno == eOK              = (OtherError,
 391                                      "no error")
 392       | errno == e2BIG            = (ResourceExhausted,
 393                                      "argument list too long")
 394       | errno == eACCES           = (PermissionDenied,
 395                                      "inadequate access permission")
 396       | errno == eADDRINUSE       = (ResourceBusy,
 397                                      "address already in use")
 398       | errno == eADDRNOTAVAIL    = (UnsupportedOperation,
 399                                      "address not available")
 400       | errno == eADV             = (OtherError,
 401                                      "RFS advertise error")
 402       | errno == eAFNOSUPPORT     = (UnsupportedOperation,
 403                                      "address family not supported by " ++
 404                                      "protocol family")
 405                                      -- no multiline strings with cpp
 406       | errno == eAGAIN           = (ResourceExhausted,
 407                                      "insufficient resources")
 408       | errno == eALREADY         = (AlreadyExists,
 409                                      "operation already in progress")
 410       | errno == eBADF            = (OtherError,
 411                                      "internal error (EBADF)")
 412       | errno == eBADMSG          = (InappropriateType,
 413                                      "next message has wrong type")
 414       | errno == eBADRPC          = (OtherError,
 415                                      "invalid RPC request or response")
 416       | errno == eBUSY            = (ResourceBusy,
 417                                      "device busy")
 418       | errno == eCHILD           = (NoSuchThing,
 419                                      "no child processes")
 420       | errno == eCOMM            = (ResourceVanished,
 421                                      "no virtual circuit could be found")
 422       | errno == eCONNABORTED     = (OtherError,
 423                                      "aborted connection")
 424       | errno == eCONNREFUSED     = (NoSuchThing,
 425                                      "no listener on remote host")
 426       | errno == eCONNRESET       = (ResourceVanished,
 427                                      "connection reset by peer")
 428       | errno == eDEADLK          = (ResourceBusy,
 429                                      "resource deadlock avoided")
 430       | errno == eDESTADDRREQ     = (InvalidArgument,
 431                                      "destination address required")
 432       | errno == eDIRTY           = (UnsatisfiedConstraints,
 433                                      "file system dirty")
 434       | errno == eDOM             = (InvalidArgument,
 435                                      "argument too large")
 436       | errno == eDQUOT           = (PermissionDenied,
 437                                      "quota exceeded")
 438       | errno == eEXIST           = (AlreadyExists,
 439                                      "file already exists")
 440       | errno == eFAULT           = (OtherError,
 441                                      "internal error (EFAULT)")
 442       | errno == eFBIG            = (PermissionDenied,
 443                                      "file too large")
 444       | errno == eFTYPE           = (InappropriateType,
 445                                      "inappropriate NFS file type or format")
 446       | errno == eHOSTDOWN        = (NoSuchThing,
 447                                      "destination host down")
 448       | errno == eHOSTUNREACH     = (NoSuchThing,
 449                                      "remote host is unreachable")
 450       | errno == eIDRM            = (ResourceVanished,
 451                                      "IPC identifier removed")
 452       | errno == eILSEQ           = (InvalidArgument,
 453                                      "invalid wide character")
 454       | errno == eINPROGRESS      = (AlreadyExists,
 455                                      "operation now in progress")
 456       | errno == eINTR            = (Interrupted,
 457                                      "interrupted system call")
 458       | errno == eINVAL           = (InvalidArgument,
 459                                      "invalid argument")
 460       | errno == eIO              = (HardwareFault,
 461                                      "unknown I/O fault")
 462       | errno == eISCONN          = (AlreadyExists,
 463                                      "socket is already connected")
 464       | errno == eISDIR           = (InappropriateType,
 465                                      "file is a directory")
 466       | errno == eLOOP            = (InvalidArgument,
 467                                      "too many symbolic links")
 468       | errno == eMFILE           = (ResourceExhausted,
 469                                      "process file table full")
 470       | errno == eMLINK           = (ResourceExhausted,
 471                                      "too many links")
 472       | errno == eMSGSIZE         = (ResourceExhausted,
 473                                      "message too long")
 474       | errno == eMULTIHOP        = (UnsupportedOperation,
 475                                      "multi-hop RFS request")
 476       | errno == eNAMETOOLONG     = (InvalidArgument,
 477                                      "filename too long")
 478       | errno == eNETDOWN         = (ResourceVanished,
 479                                      "network is down")
 480       | errno == eNETRESET        = (ResourceVanished,
 481                                      "remote host rebooted; connection lost")
 482       | errno == eNETUNREACH      = (NoSuchThing,
 483                                      "remote network is unreachable")
 484       | errno == eNFILE           = (ResourceExhausted,
 485                                      "system file table full")
 486       | errno == eNOBUFS          = (ResourceExhausted,
 487                                      "no buffer space available")
 488       | errno == eNODATA          = (NoSuchThing,
 489                                      "no message on the stream head read " ++
 490                                      "queue")
 491                                      -- no multiline strings with cpp
 492       | errno == eNODEV           = (NoSuchThing,
 493                                      "no such device")
 494       | errno == eNOENT           = (NoSuchThing,
 495                                      "no such file or directory")
 496       | errno == eNOEXEC          = (InvalidArgument,
 497                                      "not an executable file")
 498       | errno == eNOLCK           = (ResourceExhausted,
 499                                      "no file locks available")
 500       | errno == eNOLINK          = (ResourceVanished,
 501                                      "RFS link has been severed")
 502       | errno == eNOMEM           = (ResourceExhausted,
 503                                      "not enough virtual memory")
 504       | errno == eNOMSG           = (NoSuchThing,
 505                                      "no message of desired type")
 506       | errno == eNONET           = (NoSuchThing,
 507                                      "host is not on a network")
 508       | errno == eNOPROTOOPT      = (UnsupportedOperation,
 509                                      "operation not supported by protocol")
 510       | errno == eNOSPC           = (ResourceExhausted,
 511                                      "no space left on device")
 512       | errno == eNOSR            = (ResourceExhausted,
 513                                      "out of stream resources")
 514       | errno == eNOSTR           = (InvalidArgument,
 515                                      "not a stream device")
 516       | errno == eNOSYS           = (UnsupportedOperation,
 517                                      "function not implemented")
 518       | errno == eNOTBLK          = (InvalidArgument,
 519                                      "not a block device")
 520       | errno == eNOTCONN         = (InvalidArgument,
 521                                      "socket is not connected")
 522       | errno == eNOTDIR          = (InappropriateType,
 523                                      "not a directory")
 524       | errno == eNOTEMPTY        = (UnsatisfiedConstraints,
 525                                      "directory not empty")
 526       | errno == eNOTSOCK         = (InvalidArgument,
 527                                      "not a socket")
 528       | errno == eNOTTY           = (IllegalOperation,
 529                                      "inappropriate ioctl for device")
 530       | errno == eNXIO            = (NoSuchThing,
 531                                      "no such device or address")
 532       | errno == eOPNOTSUPP       = (UnsupportedOperation,
 533                                      "operation not supported on socket")
 534       | errno == ePERM            = (PermissionDenied,
 535                                      "privileged operation")
 536       | errno == ePFNOSUPPORT     = (UnsupportedOperation,
 537                                      "protocol family not supported")
 538       | errno == ePIPE            = (ResourceVanished,
 539                                      "broken pipe")
 540       | errno == ePROCLIM         = (PermissionDenied,
 541                                      "too many processes")
 542       | errno == ePROCUNAVAIL     = (UnsupportedOperation,
 543                                      "unimplemented RPC procedure")
 544       | errno == ePROGMISMATCH    = (ProtocolError,
 545                                      "unsupported RPC program version")
 546       | errno == ePROGUNAVAIL     = (UnsupportedOperation,
 547                                      "RPC program unavailable")
 548       | errno == ePROTO           = (ProtocolError,
 549                                      "error in streams protocol")
 550       | errno == ePROTONOSUPPORT  = (ProtocolError,
 551                                      "protocol not supported")
 552       | errno == ePROTOTYPE       = (ProtocolError,
 553                                      "wrong protocol for socket")
 554       | errno == eRANGE           = (UnsupportedOperation,
 555                                      "result too large")
 556       | errno == eREMCHG          = (ResourceVanished,
 557                                      "remote address changed")
 558       | errno == eREMOTE          = (IllegalOperation,
 559                                      "too many levels of remote in path")
 560       | errno == eROFS            = (PermissionDenied,
 561                                      "read-only file system")
 562       | errno == eRPCMISMATCH     = (ProtocolError,
 563                                      "RPC version is wrong")
 564       | errno == eRREMOTE         = (IllegalOperation,
 565                                      "object is remote")
 566       | errno == eSHUTDOWN        = (IllegalOperation,
 567                                      "can't send after socket shutdown")
 568       | errno == eSOCKTNOSUPPORT  = (UnsupportedOperation,
 569                                      "socket type not supported")
 570       | errno == eSPIPE           = (UnsupportedOperation,
 571                                      "can't seek on a pipe")
 572       | errno == eSRCH            = (NoSuchThing,
 573                                      "no such process")
 574       | errno == eSRMNT           = (UnsatisfiedConstraints,
 575                                      "RFS resources still mounted by " ++
 576                                      "remote host(s)")
 577                                      -- no multiline strings with cpp
 578       | errno == eSTALE           = (ResourceVanished,
 579                                      "stale NFS file handle")
 580       | errno == eTIME            = (TimeExpired,
 581                                      "timer expired")
 582       | errno == eTIMEDOUT        = (TimeExpired,
 583                                      "connection timed out")
 584       | errno == eTOOMANYREFS     = (ResourceExhausted,
 585                                      "too many references; can't splice")
 586       | errno == eTXTBSY          = (ResourceBusy,
 587                                      "text file in-use")
 588       | errno == eUSERS           = (ResourceExhausted,
 589                                      "quota table full")
 590       | errno == eWOULDBLOCK      = (OtherError,
 591                                      "operation would block")
 592       | errno == eXDEV            = (UnsupportedOperation,
 593                                      "can't make a cross-device link")
 594       | otherwise                 = (OtherError,
 595                                      "unexpected error (error code: "
 596                                      ++ show no ++")")
 597
 598 foreign label "errno" _errno :: Ptr CInt
 599   -- FIXME: this routine should eventually be provided by the Haskell runtime
 600   --        and guarantee that the "errno" of the last operation performed by
 601   --        the current thread is returned
 602 \end{code}