[MLton-user] Improved Exn.withEscape

[Vesa Karvonen]

This is a brief note about a minor improvement to the technique of setting
up an escape handler, as, for example, in the withEscape function in MLton's
library:

fun 'a withEscape (f: ('a -> 'b) -> 'a): 'a =
   let
      exception E of 'a
   in
      f (fn x => raise E x) handle E x => x
   end

A problem with the above design is that the type of withEscape should really
be (with a well-known extension to the type system)

  ((Forall 'b. 'a -> 'b) -> 'a) -> 'a

That is, one should be able to escape from a context of any type.  Alas,
SML's type system does not support the above type.  In this case, however,
we can recover the universal quantification by redesigning the interface
as follows:

structure Exit :>
   sig
      type 'a t
      val withLabel : ('a t -> 'a) -> 'a
      val exitTo : 'a t -> 'a -> 'b
   end = struct
      type 'a t = 'a -> exn

      fun withLabel f =
          let
             exception Exit of 'a
          in
             f Exit handle Exit v => v
          end

      fun exitTo t v = raise (t v)
   end

Conceptually, withLabel sets up an exit (or escape) label that is passed
to the given function.  During the withLabel invocation one can then
escape from the invocation by invoking exitTo with the label and a value
to return.

Here is a silly example (that doesn't make use of the extra polymorphism):

local
   open Exit
in
   val SOME 6 =
       withLabel
          (fn l =>
              (app (fn x =>
                       if 0 = x mod 2 then
                          exitTo l (SOME x)
                       else
                          print (Int.toString x))
                   [1, 3, 5, 6, 7, 9]
             ; NONE))
end