Programming using exceptions

The goal of this lecture note is to illustrate how to declare and to catch exceptions.

Resources

Catching exceptions in OCaml

By default, once it is raised, an exception bubbles all the way up to the toplevel. OCaml, however, offers a way to catch an exception on its way up, using a match-style expression with the keyword try:

<expression> ::= ...
               | try <expression> with
                 | name {name}* -> <expression>
                 | ...

When evaluating, e.g., try e with | Division_by_zero -> e', three things may happen:

  • evaluating e yields a value; then this value is the result of evaluating this try-expression;
  • evaluating e raises the Division_by_zero exception; then the result of evaluating this try-expression is the result of evaluating e';
  • evaluating e raises another exception; then evaluating this try-expression does not yield any result; instead, the other exception continues to be raised.

For example, the following predicate tests whether applying a given zero-ary function raises an exception:

let raises_an_exception f =
  try let _ = f ()
      in false
  with
  | _ ->
    true;;

Given a zero-ary function f, this function applies it to the unit value:

  • if no exception is raised, the result of applying f is ignored and false is returned;
  • if an exception is raised, it is intercepted by the catch-all clause in the try-expression and true is returned.

To wit:

# raises_an_exception (fun () -> 42);;
- : bool = false
# raises_an_exception (fun () -> 42 / 0);;
- : bool = true
#

Interlude

Harald: How about we write a unit-test function for raises_an_exception?

Alfrothul: Uh oh.

Harald: Got cold feet?

Alfrothul (sighing): No, no. But at what type?

Harald: At what type?

Alfrothul: OCaml is not infinitely polymorphic. It will only let us test functions that have a monomorphic type. So we will have to write several unit-test functions, one for each type.

Harald (optimistic): Fine. Let’s say that the codomain of the candidate function is bool.

Alfrothul (sitting at the keyboard): Here we go:

let test_raises_an_exception candidate =
 (* test_raises_an_exception : (unit -> bool) -> bool *)

  (* etc. *);;

Alfrothul: Now what?

Harald (grabbing the keyboard): Now we piggy-back on the examples above. Look:

let test_raises_an_exception candidate =
 (* test_raises_an_exception : (unit -> bool) -> bool *)
  let b0 = (candidate (fun () -> true) = false)
  and b1 = (candidate (fun () -> false) = false)
  (* etc. *)
  in b0 && b1;;

Alfrothul: OK. Applying the candidate function to a function that does not raise an exception should yield false. Huh, can we try it?

Harald (generously): Of course. C-c C-e:

# let test_raises_an_exception candidate =
 (* test_raises_an_exception : (unit -> bool) -> bool *)
  let b0 = (candidate (fun () -> true) = false)
  and b1 = (candidate (fun () -> false) = false)
  (* etc. *)
  in b0 && b1;;
val test_raises_an_exception : ((unit -> bool) -> bool) -> bool = <fun>
#

Alfrothul: Wait a second.

Harald (surprised): Why?

Alfrothul: Did you see the type of test_raises_an_exception?

Harald: Oh.

Alfrothul: It is not (unit -> bool) -> bool at all.

Harald (after a moment of thought): And it shouldn’t be. The type of the candidate function is not unit -> bool: the candidate function is a function that expects a function and returns a Boolean.

Alfrothul: Right. And it is the expected function that has the type unit -> bool. That is why the domain of the candidate function is unit -> bool.

Harald: Yes. And then we test its result, which is why the codomain of the candidate function is bool. Let me fix the comment:

let test_raises_an_exception candidate =
 (* test_raises_an_exception : ((unit -> bool) -> bool) -> bool *)
  let b0 = (candidate (fun () -> true) = false)
  and b1 = (candidate (fun () -> false) = false)
  (* etc. *)
  in b0 && b1;;

Alfrothul: Thanks.

Harald: Now let’s try it:

# test_raises_an_exception raises_an_exception;;
- : bool = true
#

Harald (beatifically): To see is to boolieve.

Alfrothul: That behooves, I guess. Anyway, whether the given function returns true or false, the test succeeds?

Harald: Yes. The point is that this function does not raise an exception.

Alfrothul: OK.

Harald (getting back to business): And applying the candidate function to a function that does raise an exception should yield true:

let test_raises_an_exception candidate =
 (* test_raises_an_exception : ((unit -> bool) -> bool) -> bool *)
  let b0 = (candidate (fun () -> true) = false)
  and b1 = (candidate (fun () -> false) = false)
  and b2 = (candidate (fun () -> raise (Failure "is not an option")) = true)
  (* etc. *)
  in b0 && b1 && b2;;

Harald: Look:

# test_raises_an_exception raises_an_exception;;
- : bool = true
#

Alfrothul: Right. And applying the candidate function to a function that calls another function that raises an exception should also yield true.

Harald (typing busily): Yup:

let test_raises_an_exception candidate =
 (* test_raises_an_exception : ((unit -> bool) -> bool) -> bool *)
  let b0 = (candidate (fun () -> true) = false)
  and b1 = (candidate (fun () -> false) = false)
  and b2 = (candidate (fun () -> raise (Failure "is not an option")) = true)
  and b3 = (candidate (fun () -> 1/0) = true)
  (* etc. *)
  in b0 && b1 && b2 && b3;;

Alfrothul: That one won’t work.

Harald: It won’t?

Alfrothul (soberly): Not the right type. The domain of the supplied function needs to be bool, and here it is int. OCaml is not infinitely polymorphic.

Harald (easy): Sure thing:

let test_raises_an_exception candidate =
 (* test_raises_an_exception : ((unit -> bool) -> bool) -> bool *)
  let b0 = (candidate (fun () -> true) = false)
  and b1 = (candidate (fun () -> false) = false)
  and b2 = (candidate (fun () -> raise (Failure "is not an option")) = true)
  and b3 = (candidate (fun () -> 1/0 = 0/1) = true)
  (* etc. *)
  in b0 && b1 && b2 && b3;;

Harald: Happy now?

Alfrothul: Such as one can be, yes. Can we test it?

Harald: Of course:

# test_raises_an_exception raises_an_exception;;
- : bool = true
#

Harald: See? That wasn’t so hard.

Alfrothul: But what if the candidate function itself raises an exception?

Harald: Uh oh.

Alfrothul (whisking the keyboard): Let me try:

# test_raises_an_exception (fun f -> raise (Failure "is not an option"));;
Exception: Failure "is not an option".
#

Harald: Oops.

Alfrothul: We just need to make the unit-test function robust. If the candidate function raises an exception, then the test should fail. Look:

let robust_test_raises_an_exception candidate =
 (* robust_test_raises_an_exception : ((unit -> bool) -> bool) -> bool *)
  let b0 = (try candidate (fun () -> true) = false with
            | _ ->
               false)
  and b1 = (try candidate (fun () -> false) = false with
            | _ ->
               false)
  and b2 = (try candidate (fun () -> raise (Failure "is not an option")) = true with
            | _ ->
               false)
  and b3 = (try candidate (fun () -> 1/0 = 0/1) = true with
            | _ ->
               false)
  (* etc. *)
  in b0 && b1 && b2 && b3;;

Harald: Right. We intercept any exception raised by the candidate function and then return false because the unit test should fail.

Alfrothul: Yes. And otherwise it is business as usual: if the candidate function yields a result, we verify whether it is the expected result:

# robust_test_raises_an_exception raises_an_exception;;
- : bool = true
# robust_test_raises_an_exception (fun f -> raise (Failure "is not an option"));;
- : bool = false
#

Jacques Clouseau: Ahh... That. Felt. Good.

Declaring new exceptions in OCaml

Just as we can define our own types in OCaml, we can define our own exceptions with the following declaration:

<declaration> ::= let <name> = <expression>
                | type <name> = ...
                | exception <name> of <type>

There is a global data type of exceptions, and each new declaration of an exception adds a constructor to this global data type.

Application: multiplying all the integers in a binary tree

Let us revisit the data type of binary trees where the payloads are stored in the leaves:

type 'a binary_tree =
  | Leaf of 'a
  | Node of 'a binary_tree * 'a binary_tree;;

let fold_binary_tree leaf_case node_case t_init =
  let rec visit t =
    match t with
    | Leaf v ->
       leaf_case v
    | Node (t1, t2) ->
       node_case (visit t1) (visit t2)
  in visit t_init;;

The goal of this section is to implement a function that multiplies all the payloads in a binary tree of integers:

let test_mult candidate =
  let b0 = (candidate (Leaf 0)
            = 0)
  and b1 = (candidate (Leaf 1)
            = 1)
  and b2 = (candidate (Node (Leaf 1,
                             Leaf 2))
            = 2)
  and b3 = (candidate (Node (Leaf 1,
                             Node (Leaf 2,
                                   Leaf 3)))
            = 6)
  and b4 = (candidate (Node (Leaf 1,
                             Node (Leaf 2,
                                   Node (Leaf 3,
                                         Leaf 4))))
            = 24)
  and b5 = (candidate (Node (Leaf 1,
                             Node (Leaf 2,
                                   Node (Leaf 3,
                                         Node (Leaf 4,
                                               Leaf 5)))))
            = 120)
  and b6 = (candidate (Node (Leaf 1,
                             Node (Leaf 2,
                                   Node (Leaf 0,
                                         Node (Leaf 4,
                                               Leaf 5)))))
            = 0)
  (* etc. *)
  in b0 && b1 && b2 && b3 && b4 && b5 && b6;;

The implementation is that of a routine recursive descent in the given binary tree of integers:

let mult_v0 t =
  let rec visit t =
    match t with
    | Leaf n ->
       n
    | Node (t1, t2) ->
       visit t1 * visit t2
  in visit t;;

let mult_v1 t =
  fold_binary_tree (fun n -> n) ( * ) t;;

Both implementations pass the unit tests:

# test_mult mult_v0;;
- : bool = true
# test_mult mult_v1;;
- : bool = true
#

The straightforward recursive descent is visualized as follows, using the traced version of mult_v0 found in the accompanying file:

# traced_mult_v0 show_int (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5)));;
mult_v0 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) ->
visit (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) ->
  visit (Node (Leaf 4, Leaf 5)) ->
    visit (Leaf 5) ->
    visit (Leaf 5) <- 5
    visit (Leaf 4) ->
    visit (Leaf 4) <- 4
  visit (Node (Leaf 4, Leaf 5)) <- 20
  visit (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0))) ->
    visit (Node (Leaf 3, Leaf 0)) ->
      visit (Leaf 0) ->
      visit (Leaf 0) <- 0
      visit (Leaf 3) ->
      visit (Leaf 3) <- 3
    visit (Node (Leaf 3, Leaf 0)) <- 0
    visit (Node (Leaf 1, Leaf 2)) ->
      visit (Leaf 2) ->
      visit (Leaf 2) <- 2
      visit (Leaf 1) ->
      visit (Leaf 1) <- 1
    visit (Node (Leaf 1, Leaf 2)) <- 2
  visit (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0))) <- 0
visit (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) <- 0
mult_v0 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) <- 0
- : int = 0
#

However, since 0 is absorbing for multiplication, if visit encounters 0 in a leaf—as is the case just above—there is no need to pursue the computation, and that is a job for the option type:

let mult_v2 t =
  let rec visit t =
    match t with
    | Leaf n ->
       if n = 0
       then None
       else Some n
    | Node (t1, t2) ->
       match visit t2 with
       | None ->
          None
       | Some p2 ->
          match visit t1 with
          | None ->
             None
          | Some p1 ->
             Some (p1 * p2)
  in match visit t with
     | None ->
        0
     | Some p ->
        p;;

let mult_v3 t =
  match fold_binary_tree (fun n ->
                           if n = 0
                           then None
                           else Some n)
                         (fun ih1 ih2 ->
                           match ih1 with
                           | None ->
                              None
                           | Some p1 ->
                              match ih2 with
                              | None ->
                                 None
                              | Some p2 ->
                                 Some (p1 * p2))
                         t
  with
  |  None ->
      0
  | Some p ->
     p;;

Both implementations pass the unit tests:

# test_mult mult_v2;;
- : bool = true
# test_mult mult_v3;;
- : bool = true
#

That the traversal is interrupted once 0 is encountered is visualized as follows, using the traced version of mult_v2 found in the accompanying file:

# traced_mult_v2 show_int (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5)));;
mult_v1 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) ->
  visit (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) ->
    visit (Node (Leaf 4, Leaf 5)) ->
      visit (Leaf 5) ->
      visit (Leaf 5) <- Some 5
      visit (Leaf 4) ->
      visit (Leaf 4) <- Some 4
    visit (Node (Leaf 4, Leaf 5)) <- Some 20
    visit (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0))) ->
      visit (Node (Leaf 3, Leaf 0)) ->
        visit (Leaf 0) ->
        visit (Leaf 0) <- None
      visit (Node (Leaf 3, Leaf 0)) <- None
    visit (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0))) <- None
  visit (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) <- None
mult_v2 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) <- 0
- : int = 0
#

However, the option type gets in the way at every stage of the recursive computation. It can be bypassed by using a continuation – a function representing the rest of the computation – instead:

let mult_v4 t =
  let rec visit t k =
    match t with
    | Leaf n ->
       if n = 0
       then 0
       else k n
    | Node (t1, t2) ->
       visit t2 (fun p2 ->
                  visit t1 (fun p1 ->
                             k (p1 * p2)))
  in visit t (fun p -> p);;

The invariant is that when for any given tree denoted by t and for any continuation denoted by k, when visit is applied to t and k, k is only applied if t does not contain 0. Conforming to OCaml’s right-to-left evaluation of subexpressions, each right subtree is traversed before the corresponding left subtree.

This implementation passes the unit tests:

# test_mult mult_v4;;
- : bool = true
#

That the traversal is carried out iteratively is visualized as follows, using the traced version of mult_v4 found in the accompanying file:

# traced_mult_v4 show_int (Node (Node (Leaf 2, Leaf 3), Leaf 4));;
mult_v4 (Node (Node (Leaf 2, Leaf 3), Leaf 4)) ->
visit (Node (Node (Leaf 2, Leaf 3), Leaf 4)) (fun p -> ...) ->
visit (Leaf 4) (fun p -> ...) ->
continuing with 4 after Leaf 4 ->
visit (Node (Leaf 2, Leaf 3)) (fun p -> ...) ->
visit (Leaf 3) (fun p -> ...) ->
continuing with 3 after Leaf 3 ->
visit (Leaf 2) (fun p -> ...) ->
continuing with 2 after Leaf 2 ->
continuing with 6 after Node (Leaf 2, Leaf 3) ->
and completing with 24 after Node (Node (Leaf 2, Leaf 3), Leaf 4) ->
mult_v4 (Node (Node (Leaf 2, Leaf 3), Leaf 4)) <- 24
- : int = 24
#

And that the iterative traversal is interrupted once 0 is encountered is visualized as follows:

# traced_mult_v4 show_int (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5)));;
mult_v4 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) ->
visit (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) (fun p -> ...) ->
visit (Node (Leaf 4, Leaf 5)) (fun p -> ...) ->
visit (Leaf 5) (fun p -> ...) ->
continuing with 5 after Leaf 5 ->
visit (Leaf 4) (fun p -> ...) ->
continuing with 4 after Leaf 4 ->
continuing with 20 after Node (Leaf 4, Leaf 5) ->
visit (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0))) (fun p -> ...) ->
visit (Node (Leaf 3, Leaf 0)) (fun p -> ...) ->
visit (Leaf 0) (fun p -> ...) ->
and stopping with 0
mult_v4 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) <- 0
- : int = 0
#

Alternatively we can remain in direct style (i.e., not use a continuation) and use an exception instead:

exception Zero;;

let mult_v5 t =
  let rec visit t =
    match t with
    | Leaf n ->
       if n = 0
       then raise Zero
       else n
    | Node (t1, t2) ->
       visit t1 * visit t2
  in try visit t with
     | Zero ->
        0;;

let mult_v6 t =
  try fold_binary_tree (fun n ->
                         if n = 0
                         then raise Zero
                         else n)
                       ( * )
                       t
  with
     | Zero ->
        0;;

The invariant is that for any given tree denoted by t, evaluating visit t completes (and yields an integer) if this tree does not contain 0. If this tree contains 0, the exception Zero is raised, caught at the initial call to visit, and then 0 is returned.

Both implementations pass the unit tests:

# test_mult mult_v5;;
- : bool = true
# test_mult mult_v6;;
- : bool = true
#

That the recursive traversal is interrupted once 0 is encountered is visualized as follows, using the traced version of mult_v5 found in the accompanying file:

# traced_mult_v5 show_int (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5)));;
mult_v5 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) ->
  visit (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) ->
    visit (Node (Leaf 4, Leaf 5)) ->
      visit (Leaf 5) ->
      visit (Leaf 5) <- 5
      visit (Leaf 4) ->
      visit (Leaf 4) <- 4
    visit (Node (Leaf 4, Leaf 5)) <- 20
    visit (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0))) ->
      visit (Node (Leaf 3, Leaf 0)) ->
        visit (Leaf 0) ->
mult_v5 (Node (Node (Node (Leaf 1, Leaf 2), Node (Leaf 3, Leaf 0)), Node (Leaf 4, Leaf 5))) <- 0
- : int = 0
#

Exercise 2

  1. Implement one more version of the multiplication function over binary trees, mult_v7, using an accumulator.
  2. Express your new version using fold_binary_tree.

Application: testing whether a leaf satisfies a given predicate in a binary tree

The goal of this section is to implement a function that, given a predicate (i.e., a Boolean-valued function) and a binary tree, tests whether the payload of one of the leaves satisfies this predicate.

For example, the following unit-test function checks whether a given integer occurs in a given binary tree of integers:

let test_occurs_int candidate =
  let b0 = (candidate (fun i -> i = 0)
                      (Leaf 0)
            = true)
  and b1 = (candidate (fun i -> i = 0)
                      (Leaf 1)
            = false)
  and b2 = (candidate (fun i -> i = 0)
                      (Node (Leaf 1,
                             Leaf 2))
            = false)
  and b3 = (candidate (fun i -> i = 1)
                      (Node (Leaf 1,
                             Leaf 2))
            = true)
  and b4 = (candidate (fun i -> i = 2)
                      (Node (Leaf 1,
                             Leaf 2))
            = true)
  and b5 = (candidate (fun i -> i = 0)
                      (Node (Leaf 1,
                             Node (Leaf 2,
                                   Leaf 3)))
            = false)
  and b6 = (candidate (fun i -> i = 1)
                      (Node (Leaf 1,
                             Node (Leaf 2,
                                   Leaf 3)))
            = true)
  and b7 = (candidate (fun i -> i = 2)
                      (Node (Leaf 1,
                             Node (Leaf 2,
                                   Leaf 3)))
            = true)
  and b8 = (candidate (fun i -> i = 3)
                      (Node (Leaf 1,
                             Node (Leaf 2,
                                   Leaf 3)))
            = true)
  (* etc. *)
  in b0 && b1 && b2 && b3 && b4 && b5 && b6 && b7 && b8;;

The implementation is that of a routine recursive descent in the given binary tree:

let occurs_v0 p t =
  let rec visit t =
    match t with
    | Leaf n ->
       p n
    | Node (t1, t2) ->
       let b2 = visit t2
       and b1 = visit t1
       in b1 || b2
  in visit t;;

let occurs_v1 p t =
  fold_binary_tree p (||) t;;

Both implementations pass the unit tests:

# test_occurs_int occurs_v0;;
- : bool = true
# test_occurs_int occurs_v1;;
- : bool = true
#

The straightforward recursive descent is visualized as follows, using the traced version of occurs_v0 found in the accompanying file:

# traced_occurs_v0 show_int (fun i -> i = 1) (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0)));;
occurs_v0 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
visit (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
  visit (Node (Node (Leaf 2, Leaf 1), Leaf 0)) ->
    visit (Leaf 0) ->
    visit (Leaf 0) <- false
    visit (Node (Leaf 2, Leaf 1)) ->
      visit (Leaf 1) ->
      visit (Leaf 1) <- true
      visit (Leaf 2) ->
      visit (Leaf 2) <- false
    visit (Node (Leaf 2, Leaf 1)) <- true
  visit (Node (Node (Leaf 2, Leaf 1), Leaf 0)) <- true
  visit (Node (Node (Leaf 5, Leaf 4), Leaf 3)) ->
    visit (Leaf 3) ->
    visit (Leaf 3) <- false
    visit (Node (Leaf 5, Leaf 4)) ->
      visit (Leaf 4) ->
      visit (Leaf 4) <- false
      visit (Leaf 5) ->
      visit (Leaf 5) <- false
    visit (Node (Leaf 5, Leaf 4)) <- false
  visit (Node (Node (Leaf 5, Leaf 4), Leaf 3)) <- false
visit (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) <- true
occurs_v0 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) <- true
- : bool = true
#

However, since true is absorbing for disjunction, if visit encounters a leaf that safisfies the predicate—as is the case just above—there is no need to pursue the computation. Is this a job for the option type? Well, actually no, not here, because of OCaml’s short-circuit evaluation for disjunction: all we need is to not name the result of the recursive calls to visit:

let occurs_v2 p t =
  let rec visit t =
    match t with
    | Leaf n ->
       p n
    | Node (t1, t2) ->
       visit t2 || visit t1
  in visit t;;

(The right-to-left depth-first traversal is there to respect the right-to-left evaluation of subexpressions in OCaml.)

This implementation passes the unit tests:

# test_occurs_int occurs_v2;;
- : bool = true
#

More to the point, if a leaf whose payload satisfies the predicate is encountered, the rest of the tree is not traversed, as visualized below, using the traced version of occurs_v2 found in the accompanying file and the same example as above:

# traced_occurs_v2 show_int (fun i -> i = 1) (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0)));;
occurs_v2 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
visit (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
  visit (Node (Node (Leaf 2, Leaf 1), Leaf 0)) ->
    visit (Leaf 0) ->
    visit (Leaf 0) <- false
    visit (Node (Leaf 2, Leaf 1)) ->
      visit (Leaf 1) ->
      visit (Leaf 1) <- true
    visit (Node (Leaf 2, Leaf 1)) <- true
  visit (Node (Node (Leaf 2, Leaf 1), Leaf 0)) <- true
visit (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) <- true
occurs_v2 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) <- true
- : bool = true
#

And indeed once Leaf 1 is reached, the corresponding left subtree and the left subtrees above it are not traversed.

Still the nodes containing these left subtrees are touched upon one after the other as visit returns, and that is because for each right subtree, the call to visit is not a tail call.

How to make all calls to visit tail calls? With a continuation of course:

let occurs_v3 p t =
  let rec visit t k =
    match t with
    | Leaf n ->
       p n || k ()
    | Node (t1, t2) ->
       visit t2 (fun () ->
                  visit t1 k)
  in visit t (fun () -> false);;

The invariant is that when for any given tree denoted by t and for any continuation denoted by k, when visit is applied to t and k, k is only applied if t does not contain a leaf whose payload satisfies the given predicate. And again, conforming to OCaml’s right-to-left evaluation of subexpressions, each right subtree is traversed before the corresponding left subtree.

This implementation passes the unit tests:

# test_occurs_int occurs_v3;;
- : bool = true
#

That the traversal is carried out iteratively and interrupted when encountering a fitting leaf is visualized as follows, using the traced version of occurs_v3 found in the accompanying file:

# traced_occurs_v3 show_int (fun i -> i = 1) (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0)));;
occurs_v3 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
visit (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
visit (Node (Node (Leaf 2, Leaf 1), Leaf 0)) ->
visit (Leaf 0) ->
continuing after Leaf 0 ->
visit (Node (Leaf 2, Leaf 1)) ->
visit (Leaf 1) ->
and stopping with true
occurs_v3 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) <- true
- : bool = true
#

Alternatively we can remain in direct style and use an exception instead:

exception Found_one;;

let occurs_v4 p t =
  let rec visit t =
    match t with
    | Leaf n ->
       if p n
       then raise Found_one
       else false
    | Node (t1, t2) ->
       let b2 = visit t2
       in b2 || visit t1
  in try visit t with
     | Found_one ->
        true;;

(The result of evaluating visit t2 is named to manifest that this call is not a tail call, and the result of evaluating visit t1 is not named to manifest that this call is a tail call.)

The invariant is that for any given tree denoted by t, evaluating visit t completes (and yields false) if this tree does not contain a leaf whose payload satisfies the predicate. If this tree contains such a leaf, the exception Found_one is raised, caught at the initial call to visit, and then true is returned.

This implementation passes the unit tests:

# test_occurs_int occurs_v4;;
- : bool = true
#

That the recursive traversal is interrupted when encountering a fitting leaf is visualized as follows, using the traced version of occurs_v4 found in the accompanying file:

# traced_occurs_v4 show_int (fun i -> i = 1) (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0)));;
occurs_v4 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
visit (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) ->
  visit (Node (Node (Leaf 2, Leaf 1), Leaf 0)) ->
    visit (Leaf 0) ->
    visit (Leaf 0) <- false
    visit (Node (Leaf 2, Leaf 1)) ->
      visit (Leaf 1) ->
occurs_v4 p (Node (Node (Node (Leaf 5, Leaf 4), Leaf 3), Node (Node (Leaf 2, Leaf 1), Leaf 0))) <- true
- : bool = true
#

(The indentation manifests that visit (Leaf 0) was a non-tail call and that visit (Node (Leaf 2, Leaf 1)) is a tail call.)

But now visit only returns false, never true, and therefore it might as well return the unit value:

let occurs_v5 p t =
  let rec visit t =
    match t with
    | Leaf n ->
       if p n
       then raise Found_one
       else ()
    | Node (t1, t2) ->
       let () = visit t2
       in visit t1
  in try let () = visit t in false with
     | Found_one ->
        true;;

This implementation passes the unit tests:

# test_occurs_int occurs_v5;;
- : bool = true
#

It directly corresponds to occurs_v3 in that for both of them,

  • in the Leaf case, the computation only continues if the predicate is not satisfied,
  • in the Node case, the traversal of the current left subtree only takes place if the traversal of the current right subtree completed, and
  • in occurs_v5, applying visit yields () and in occurs_v3, applying visit continues with ().

Moving on, and remembering that e1; e2 is syntactic sugar for let () = e1 in e2, this implementation can be expressed using sequencing:

let occurs_v6 p t =
  let rec visit t =
    match t with
    | Leaf n ->
       if p n
       then raise Found_one
       else ()
    | Node (t1, t2) ->
       visit t2;
       visit t1
  in try visit t; false with
     | Found_one ->
        true;;

This implementation passes the unit tests:

# test_occurs_int occurs_v6;;
- : bool = true
#

It has the hallmarks of imperative programming: sequencing and jumps.

Exercise 3

Revisit Exercise 29 in Week 11 and implement a function that tests whether a given binary tree of integers represents a well-balanced mobile, using an exception instead of an option type or a continuation.

Exercise 4

Revisit Section The logical counterpart of the map function for binary trees and implement andmap_binary_tree in a way that exploits that false is absorbing for conjunction.

Exercise 5

Revisit Section The logical counterpart of the map function for binary trees and implement ormap_binary_tree in a way that exploits that true is absorbing for disjunction.

Resources

Version

Created [24 Mar 2020]