ghc/lib/std/PrelCError.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelCError.lhs,v 1.3 2001/01/15 20:55:14 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}