Exception.hs 14.4 KB
Newer Older
1
{-# LANGUAGE Trustworthy #-}
2
{-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash,
3
             ExistentialQuantification, ImplicitParams #-}
4
{-# OPTIONS_GHC -funbox-strict-fields #-}
5
{-# OPTIONS_HADDOCK hide #-}
dterei's avatar
dterei committed
6

7
8
9
10
11
-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Exception
-- Copyright   :  (c) The University of Glasgow, 2009
-- License     :  see libraries/base/LICENSE
Jan Stolarek's avatar
Jan Stolarek committed
12
--
13
14
15
16
17
18
19
20
21
-- Maintainer  :  libraries@haskell.org
-- Stability   :  internal
-- Portability :  non-portable
--
-- IO-related Exception types and functions
--
-----------------------------------------------------------------------------

module GHC.IO.Exception (
Simon Marlow's avatar
Simon Marlow committed
22
23
  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
24
  Deadlock(..),
25
  AllocationLimitExceeded(..), allocationLimitExceeded,
26
  AssertionFailed(..),
27
28
  CompactionFailed(..),
  cannotCompactFunction, cannotCompactPinned, cannotCompactMutable,
29
30
31

  SomeAsyncException(..),
  asyncExceptionToException, asyncExceptionFromException,
32
  AsyncException(..), stackOverflow, heapOverflow,
33

34
35
  ArrayException(..),
  ExitCode(..),
David Feuer's avatar
David Feuer committed
36
  FixIOException (..),
37
38
39
40
41
42
43
44
45
46
47
48
49

  ioException,
  ioError,
  IOError,
  IOException(..),
  IOErrorType(..),
  userError,
  assertError,
  unsupportedOperation,
  untangle,
 ) where

import GHC.Base
50
import GHC.Generics
51
52
53
54
55
56
import GHC.List
import GHC.IO
import GHC.Show
import GHC.Read
import GHC.Exception
import GHC.IO.Handle.Types
Simon Marlow's avatar
Simon Marlow committed
57
58
import GHC.OldList ( intercalate )
import {-# SOURCE #-} GHC.Stack.CCS
59
60
import Foreign.C.Types

61
import Data.Typeable ( cast )
62
63
64
65
66
67

-- ------------------------------------------------------------------------
-- Exception datatypes and operations

-- |The thread is blocked on an @MVar@, but there are no other references
-- to the @MVar@ so it can't ever continue.
Simon Marlow's avatar
Simon Marlow committed
68
data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
69

70
-- | @since 4.1.0.0
Simon Marlow's avatar
Simon Marlow committed
71
instance Exception BlockedIndefinitelyOnMVar
72

73
-- | @since 4.1.0.0
Simon Marlow's avatar
Simon Marlow committed
74
75
instance Show BlockedIndefinitelyOnMVar where
    showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
76

Simon Marlow's avatar
Simon Marlow committed
77
78
blockedIndefinitelyOnMVar :: SomeException -- for the RTS
blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
79
80
81

-----

Ian Lynagh's avatar
Ian Lynagh committed
82
-- |The thread is waiting to retry an STM transaction, but there are no
83
-- other references to any @TVar@s involved, so it can't ever continue.
Simon Marlow's avatar
Simon Marlow committed
84
data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
85

86
-- | @since 4.1.0.0
Simon Marlow's avatar
Simon Marlow committed
87
instance Exception BlockedIndefinitelyOnSTM
88

89
-- | @since 4.1.0.0
Simon Marlow's avatar
Simon Marlow committed
90
91
instance Show BlockedIndefinitelyOnSTM where
    showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
92

Simon Marlow's avatar
Simon Marlow committed
93
94
blockedIndefinitelyOnSTM :: SomeException -- for the RTS
blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
95
96
97
98
99
100
101

-----

-- |There are no runnable threads, so the program is deadlocked.
-- The @Deadlock@ exception is raised in the main thread only.
data Deadlock = Deadlock

102
-- | @since 4.1.0.0
103
104
instance Exception Deadlock

105
-- | @since 4.1.0.0
106
107
108
109
110
instance Show Deadlock where
    showsPrec _ Deadlock = showString "<<deadlock>>"

-----

111
-- |This thread has exceeded its allocation limit.  See
112
113
-- 'System.Mem.setAllocationCounter' and
-- 'System.Mem.enableAllocationLimit'.
114
--
115
-- @since 4.8.0.0
116
117
data AllocationLimitExceeded = AllocationLimitExceeded

118
-- | @since 4.8.0.0
119
120
121
instance Exception AllocationLimitExceeded where
  toException = asyncExceptionToException
  fromException = asyncExceptionFromException
122

123
-- | @since 4.7.1.0
124
125
126
127
128
129
130
131
132
instance Show AllocationLimitExceeded where
    showsPrec _ AllocationLimitExceeded =
      showString "allocation limit exceeded"

allocationLimitExceeded :: SomeException -- for the RTS
allocationLimitExceeded = toException AllocationLimitExceeded

-----

Ryan Scott's avatar
Ryan Scott committed
133
-- | Compaction found an object that cannot be compacted.  Functions
134
-- cannot be compacted, nor can mutable objects or pinned objects.
Takenobu Tani's avatar
Takenobu Tani committed
135
-- See 'GHC.Compact.compact'.
136
137
--
-- @since 4.10.0.0
Ryan Scott's avatar
Ryan Scott committed
138
newtype CompactionFailed = CompactionFailed String
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

-- | @since 4.10.0.0
instance Exception CompactionFailed where

-- | @since 4.10.0.0
instance Show CompactionFailed where
    showsPrec _ (CompactionFailed why) =
      showString ("compaction failed: " ++ why)

cannotCompactFunction :: SomeException -- for the RTS
cannotCompactFunction =
  toException (CompactionFailed "cannot compact functions")

cannotCompactPinned :: SomeException -- for the RTS
cannotCompactPinned =
  toException (CompactionFailed "cannot compact pinned objects")

cannotCompactMutable :: SomeException -- for the RTS
cannotCompactMutable =
  toException (CompactionFailed "cannot compact mutable objects")

-----

162
-- |'assert' was applied to 'False'.
163
newtype AssertionFailed = AssertionFailed String
164

165
-- | @since 4.1.0.0
166
167
instance Exception AssertionFailed

168
-- | @since 4.1.0.0
169
170
171
172
173
instance Show AssertionFailed where
    showsPrec _ (AssertionFailed err) = showString err

-----

174
175
-- |Superclass for asynchronous exceptions.
--
176
-- @since 4.7.0.0
177
178
data SomeAsyncException = forall e . Exception e => SomeAsyncException e

179
-- | @since 4.7.0.0
180
181
182
instance Show SomeAsyncException where
    show (SomeAsyncException e) = show e

183
-- | @since 4.7.0.0
184
185
instance Exception SomeAsyncException

186
-- |@since 4.7.0.0
187
188
189
asyncExceptionToException :: Exception e => e -> SomeException
asyncExceptionToException = toException . SomeAsyncException

190
-- |@since 4.7.0.0
191
192
193
194
195
196
asyncExceptionFromException :: Exception e => SomeException -> Maybe e
asyncExceptionFromException x = do
    SomeAsyncException a <- fromException x
    cast a


197
198
199
200
201
202
203
204
205
206
207
208
209
-- |Asynchronous exceptions.
data AsyncException
  = StackOverflow
        -- ^The current thread\'s stack exceeded its limit.
        -- Since an exception has been raised, the thread\'s stack
        -- will certainly be below its limit again, but the
        -- programmer should take remedial action
        -- immediately.
  | HeapOverflow
        -- ^The program\'s heap is reaching its limit, and
        -- the program should take action to reduce the amount of
        -- live data it has. Notes:
        --
210
        --   * It is undefined which thread receives this exception.
dobenour's avatar
dobenour committed
211
212
213
        --     GHC currently throws this to the same thread that
        --     receives 'UserInterrupt', but this may change in the
        --     future.
214
        --
dobenour's avatar
dobenour committed
215
216
217
218
219
        --   * The GHC RTS currently can only recover from heap overflow
        --     if it detects that an explicit memory limit (set via RTS flags).
        --     has been exceeded.  Currently, failure to allocate memory from
        --     the operating system results in immediate termination of the
        --     program.
220
221
222
223
224
225
226
227
228
  | ThreadKilled
        -- ^This exception is raised by another thread
        -- calling 'Control.Concurrent.killThread', or by the system
        -- if it needs to terminate the thread for some
        -- reason.
  | UserInterrupt
        -- ^This exception is raised by default in the main thread of
        -- the program when the user requests to terminate the program
        -- via the usual mechanism(s) (e.g. Control-C in the console).
229
  deriving (Eq, Ord)
230

231
-- | @since 4.7.0.0
232
233
234
instance Exception AsyncException where
  toException = asyncExceptionToException
  fromException = asyncExceptionFromException
235
236
237
238
239
240
241
242
243

-- | Exceptions generated by array operations
data ArrayException
  = IndexOutOfBounds    String
        -- ^An attempt was made to index an array outside
        -- its declared bounds.
  | UndefinedElement    String
        -- ^An attempt was made to evaluate an element of an
        -- array that had not been initialized.
244
  deriving (Eq, Ord)
245

246
-- | @since 4.1.0.0
247
248
instance Exception ArrayException

249
250
-- for the RTS
stackOverflow, heapOverflow :: SomeException
251
252
253
stackOverflow = toException StackOverflow
heapOverflow  = toException HeapOverflow

254
-- | @since 4.1.0.0
255
256
257
258
259
260
instance Show AsyncException where
  showsPrec _ StackOverflow   = showString "stack overflow"
  showsPrec _ HeapOverflow    = showString "heap overflow"
  showsPrec _ ThreadKilled    = showString "thread killed"
  showsPrec _ UserInterrupt   = showString "user interrupt"

261
-- | @since 4.1.0.0
262
263
264
265
266
267
268
269
270
271
instance Show ArrayException where
  showsPrec _ (IndexOutOfBounds s)
        = showString "array index out of range"
        . (if not (null s) then showString ": " . showString s
                           else id)
  showsPrec _ (UndefinedElement s)
        = showString "undefined array element"
        . (if not (null s) then showString ": " . showString s
                           else id)

David Feuer's avatar
David Feuer committed
272
273
274
275
276
277
278
279
280
-- | @since TODO
data FixIOException = FixIOException

-- | @since TODO
instance Exception FixIOException

instance Show FixIOException where
  showsPrec _ FixIOException = showString "cyclic evaluation in fixIO"

281
282
283
284
285
286
-- -----------------------------------------------------------------------------
-- The ExitCode type

-- We need it here because it is used in ExitException in the
-- Exception datatype (above).

Simon Marlow's avatar
Simon Marlow committed
287
-- | Defines the exit codes that a program can return.
288
289
290
291
292
293
294
data ExitCode
  = ExitSuccess -- ^ indicates successful termination;
  | ExitFailure Int
                -- ^ indicates program failure with an exit code.
                -- The exact interpretation of the code is
                -- operating-system dependent.  In particular, some values
                -- may be prohibited (e.g. 0 on a POSIX-compliant system).
295
  deriving (Eq, Ord, Read, Show, Generic)
296

297
-- | @since 4.1.0.0
298
299
300
301
302
303
instance Exception ExitCode

ioException     :: IOException -> IO a
ioException err = throwIO err

-- | Raise an 'IOError' in the 'IO' monad.
Jan Stolarek's avatar
Jan Stolarek committed
304
ioError         :: IOError -> IO a
305
306
307
308
309
ioError         =  ioException

-- ---------------------------------------------------------------------------
-- IOError type

310
-- | The Haskell 2010 type for exceptions in the 'IO' monad.
311
312
-- Any I\/O operation may raise an 'IOError' instead of returning a result.
-- For a more general type of exception, including also those that arise
313
-- in pure code, see 'Control.Exception.Exception'.
314
--
315
-- In Haskell 2010, this is an opaque type.
316
317
318
319
320
321
322
323
type IOError = IOException

-- |Exceptions that occur in the @IO@ monad.
-- An @IOException@ records a more specific error type, a descriptive
-- string and maybe the handle that was used when the error was
-- flagged.
data IOException
 = IOError {
Jan Stolarek's avatar
Jan Stolarek committed
324
     ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
325
326
327
328
329
330
331
332
                                     -- the error.
     ioe_type     :: IOErrorType,    -- what it was.
     ioe_location :: String,         -- location.
     ioe_description :: String,      -- error type specific information.
     ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.
     ioe_filename :: Maybe FilePath  -- filename the error is related to.
   }

333
-- | @since 4.1.0.0
334
335
instance Exception IOException

336
-- | @since 4.1.0.0
337
instance Eq IOException where
Jan Stolarek's avatar
Jan Stolarek committed
338
  (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
339
340
341
342
    e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2

-- | An abstract type that contains a value for each variant of 'IOError'.
data IOErrorType
343
  -- Haskell 2010:
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
  = AlreadyExists
  | NoSuchThing
  | ResourceBusy
  | ResourceExhausted
  | EOF
  | IllegalOperation
  | PermissionDenied
  | UserError
  -- GHC only:
  | UnsatisfiedConstraints
  | SystemError
  | ProtocolError
  | OtherError
  | InvalidArgument
  | InappropriateType
  | HardwareFault
  | UnsupportedOperation
  | TimeExpired
  | ResourceVanished
  | Interrupted

365
-- | @since 4.1.0.0
366
instance Eq IOErrorType where
367
368
   x == y = isTrue# (getTag x ==# getTag y)

369
-- | @since 4.1.0.0
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
instance Show IOErrorType where
  showsPrec _ e =
    showString $
    case e of
      AlreadyExists     -> "already exists"
      NoSuchThing       -> "does not exist"
      ResourceBusy      -> "resource busy"
      ResourceExhausted -> "resource exhausted"
      EOF               -> "end of file"
      IllegalOperation  -> "illegal operation"
      PermissionDenied  -> "permission denied"
      UserError         -> "user error"
      HardwareFault     -> "hardware fault"
      InappropriateType -> "inappropriate type"
      Interrupted       -> "interrupted"
      InvalidArgument   -> "invalid argument"
      OtherError        -> "failed"
      ProtocolError     -> "protocol error"
      ResourceVanished  -> "resource vanished"
      SystemError       -> "system error"
      TimeExpired       -> "timeout"
Gabor Greif's avatar
Gabor Greif committed
391
      UnsatisfiedConstraints -> "unsatisfied constraints" -- ultra-precise!
392
393
394
395
396
397
      UnsupportedOperation -> "unsupported operation"

-- | Construct an 'IOError' value with a string describing the error.
-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a
-- 'userError', thus:
--
Jan Stolarek's avatar
Jan Stolarek committed
398
-- > instance Monad IO where
399
400
401
402
403
404
405
406
407
-- >   ...
-- >   fail s = ioError (userError s)
--
userError       :: String  -> IOError
userError str   =  IOError Nothing UserError "" str Nothing Nothing

-- ---------------------------------------------------------------------------
-- Showing IOErrors

408
-- | @since 4.1.0.0
409
410
411
412
413
414
415
416
417
418
instance Show IOException where
    showsPrec p (IOError hdl iot loc s _ fn) =
      (case fn of
         Nothing -> case hdl of
                        Nothing -> id
                        Just h  -> showsPrec p h . showString ": "
         Just name -> showString name . showString ": ") .
      (case loc of
         "" -> id
         _  -> showString loc . showString ": ") .
Jan Stolarek's avatar
Jan Stolarek committed
419
      showsPrec p iot .
420
421
422
423
      (case s of
         "" -> id
         _  -> showString " (" . showString s . showString ")")

424
425
426
-- Note the use of "lazy". This means that
--     assert False (throw e)
-- will throw the assertion failure rather than e. See trac #5561.
427
428
assertError :: (?callStack :: CallStack) => Bool -> a -> a
assertError predicate v
429
  | predicate = lazy v
Simon Marlow's avatar
Simon Marlow committed
430
431
432
433
434
435
436
  | otherwise = unsafeDupablePerformIO $ do
    ccsStack <- currentCallStack
    let
      implicitParamCallStack = prettyCallStackLines ?callStack
      ccsCallStack = showCCSStack ccsStack
      stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
    throwIO (AssertionFailed ("Assertion failed\n" ++ stack))
437
438

unsupportedOperation :: IOError
Jan Stolarek's avatar
Jan Stolarek committed
439
unsupportedOperation =
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
   (IOError Nothing UnsupportedOperation ""
        "Operation is not supported" Nothing Nothing)

{-
(untangle coded message) expects "coded" to be of the form
        "location|details"
It prints
        location message details
-}
untangle :: Addr# -> String -> String
untangle coded message
  =  location
  ++ ": "
  ++ message
  ++ details
  ++ "\n"
  where
    coded_str = unpackCStringUtf8# coded

    (location, details)
      = case (span not_bar coded_str) of { (loc, rest) ->
        case rest of
          ('|':det) -> (loc, ' ' : det)
          _         -> (loc, "")
        }
    not_bar c = c /= '|'
dterei's avatar
dterei committed
466