lib/mlton/basic/exn0.sml

   1 (* Copyright (C) 2017 Matthew Fluet.
   2  * Copyright (C) 2005-2006 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 structure Exn0 =
  10 struct
  11
  12 type t = exn
  13
  14 val history = MLton.Exn.history
  15
  16 val name = General.exnName
  17
  18 val message = General.exnMessage
  19
  20 exception Bind = Bind
  21 exception Match = Match
  22 exception Overflow = Overflow
  23 exception Subscript = Subscript
  24
  25 local
  26    (* would like to make the declaration of z in a let inside the try function,
  27     * with 'a as a free type variable.  But SML/NJ doesn't allow it.
  28     *)
  29    datatype 'a z = Ok of 'a | Raise of exn
  30 in
  31    val try: (unit -> 'a) * ('a -> 'b) * (exn -> 'b) -> 'b =
  32       fn (t, k, h) =>
  33       case Ok (t ()) handle e => Raise e of
  34          Ok x => k x
  35        | Raise e => h e
  36 end
  37
  38 fun finally (thunk, cleanup: unit -> unit) =
  39    try (thunk, fn a => (cleanup (); a), fn e => (cleanup (); raise e))
  40
  41 fun windFail (f: unit -> 'a, g: unit -> unit): 'a =
  42    f () handle ex => (g (); raise ex)
  43
  44 fun 'a withEscape (f: ('a -> 'b) -> 'a): 'a =
  45    let
  46       exception E of 'a
  47    in
  48       f (fn x => raise E x) handle E x => x
  49    end
  50
  51 end