Exceptions in OCaml (chapter 9)

(* Chapter 9  Exceptions *)

open Printf

(* Reporting and handling errors *)

exception No_solution

let quadratic (a: float) (b: float) (c: float) : float * float =
  let d = b *. b -. 4. *. a *. c in
  if d < 0.0 then raise No_solution;
  let d = sqrt d in
  ((-. b +. d) /. (2. *. a), (-. b -. d) /. (2. *. a))

let print_solutions a b c =
  try
    let (x1, x2) = quadratic a b c in printf "solutions: %g %g\n" x1 x2
  with No_solution ->
    printf "no real solutions\n"

let _ =
  printf "x2 + x - 2 = 0 : "; print_solutions 1.0 1.0 (-2.0);
  printf "x2 + 1 = 0 : "; print_solutions 1.0 0.0 1.0

(* Early exits *)

let list_product l =
    let exception Zero in
    let rec product = function
      | [] -> 1
      | 0 :: _ -> raise Zero
      | n :: l -> n * product l
    in
    try product l with Zero -> 0

let _ =
  printf "list_product [1;2;3] = %d\n" (list_product [1;2;3]);
  printf "list_product [4;0;6] = %d\n" (list_product [4;0;6])

(* Sharing combinators *)

exception Unchanged

let run fn arg = try fn arg with Unchanged -> arg

let pair_map (f: 'a -> 'a) (g: 'b -> 'b) (p: 'a * 'b) : 'a * 'b =
  try
    let x = f (fst p) in (x, run g (snd p))
  with Unchanged ->
    let y = g (snd p) in (fst p, y)

let rec list_map (f: 'a -> 'a) (l: 'a list) : 'a list =
  match l with
  | [] -> raise Unchanged
  | x :: l ->
      try
        let x' = f x in x' :: run (list_map f) l
      with Unchanged ->
        x :: list_map f l

let fabs (f: float) : float =
  if f >= 0.0 then raise Unchanged else -. f

let _ =
  printf "fabs 3.5 = %f\n" (run fabs 3.5);
  printf "fabs -4. = %f\n" (run fabs (-4.));
  printf "list_map fabs [-1.;2.;3.;] = [";
  List.iter (fun f -> printf "%f;" f)
            (run (list_map fabs) [-1.;2.;3.;]);
  printf "]\n"