exo3.ml

(* This type represents some kind of binary decision diagrams. *)
type ('a,'b) decision =
  | Result of 'b
  | Test of ('a -> bool) * ('a, 'b) decision * ('a, 'b) decision

let decision1 = Test ( (fun x -> x > 10),
                       Result "Greater than 10",
                       Result "Smaller or equal to 10" )

let decision2 = Test ( (fun x -> x < 100),
                       decision1,
                       Result "Big")

let decision3 = Test ( (fun x -> x < 0),
                       Result "Negative",
                       decision2 )

let rec apply_decision x = function
  | Result r -> r
  | Test (pred, left, right) -> if pred x then apply_decision x left else apply_decision x right

let rec map_decision f = function
  | Result r -> Result (f r)
  | Test (pred, left, right) -> Test (pred, map_decision f left, map_decision f right)

let get_results tree =
  let rec loop acu = function
    | Result r -> r :: acu
    | Test (_, left, right) -> loop (loop acu left) right
  in
  loop [] tree

let rec invert = function
  | Result r -> Result r
  | Test (pred, left, right) ->
    let new_pred x = not (pred x) in
    Test (new_pred, invert right, invert left)


(*** Exceptions ***)

type ('a,'b) edecision =
  | Result of 'b
  | Test of ('a -> bool) * ('a, 'b) edecision * ('a, 'b) edecision
  | Error of exn
  | Catch of ('a, 'b) edecision * (exn -> bool) * ('a, 'b) edecision

let edecision1 = Test ( (fun x -> x > 10),
                        Result "Greater than 10",
                        Result "Smaller or equal to 10" )

let edecision2 = Test ( (fun x -> x < 100),
                        edecision1,
                        Error Not_found )

let edecision3 = Test ( (fun x -> x < 0),
                        Error (Invalid_argument "Negative"),
                        edecision2 )

let edecision4 = Catch ( edecision3,
                         (function Not_found -> true | _ -> false),
                         Result "Too big" )

let rec apply_edecision x = function
  | Result r -> r
  | Test (pred, left, right) -> if pred x then apply_edecision x left else apply_edecision x right
  | Error e -> raise e
  | Catch (sub, epred, branch) ->
    try apply_edecision x sub
    with e ->
      if epred e then apply_edecision x branch
      else raise e