Use Fun.protect where possible

debugger/breakpoints.ml

@@ -16,7 +16,6 @@
 
 (******************************* Breakpoints ***************************)
 
-open Primitives
 open Checkpoints
 open Debugcom
 open Instruct
@@ -207,9 +206,4 @@ let exec_with_temporary_breakpoint pc funct =
     in
       Exec.protect (function () -> insert_position pc);
       temporary_breakpoint_position := Some pc;
-      try
-        funct ();
-        Exec.protect remove
-      with
-        x ->
-          cleanup x Exec.protect remove
+      Fun.protect ~finally:(fun () -> Exec.protect remove) funct

debugger/command_line.ml

@@ -567,21 +567,17 @@ let instr_source ppf lexbuf =
       | Not_found -> error "Source file not found."
       | (Unix_error _) as x  -> Unix_tools.report_error x; raise Toplevel
     in
-      try
-        interactif := false;
-        user_channel := io_chan;
-        line_loop ppf (Lexing.from_function read_user_input);
+      interactif := false;
+      user_channel := io_chan;
+      let loop () =
+        line_loop ppf (Lexing.from_function read_user_input)
+      and finally () =
         stop_user_input ();
         close_io io_chan;
         interactif := old_state;
         user_channel := old_channel
-      with
-      | x ->
-          cleanup x (fun () ->
-            stop_user_input ();
-            close_io io_chan;
-            interactif := old_state;
-            user_channel := old_channel) ()
+      in
+      Fun.protect ~finally loop
 
 let instr_set =
   find_variable

debugger/input_handling.ml

@@ -46,13 +46,8 @@ let current_controller file =
 let execute_with_other_controller controller file funct =
   let old_controller = current_controller file in
     change_controller file controller;
-    try
-      let result = funct () in
-        change_controller file old_controller;
-        result
-    with
-      x ->
-        cleanup x (change_controller file) old_controller
+    let finally () = change_controller file old_controller in
+    Fun.protect ~finally funct
 
 (*** The "Main Loop" ***)
 
@@ -64,8 +59,11 @@ let exit_main_loop _ =
 
 (* Handle active files until `continue_main_loop' is false. *)
 let main_loop () =
-  let old_state = !continue_main_loop in
-    try
+  let finally =
+    let old_state = !continue_main_loop in
+    fun () -> continue_main_loop := old_state
+  in
+    Fun.protect ~finally @@ fun () ->
       continue_main_loop := true;
       while !continue_main_loop do
         try
@@ -79,11 +77,7 @@ let main_loop () =
               input
         with
           Unix_error (EINTR, _, _) -> ()
-      done;
-      continue_main_loop := old_state
-    with
-      x ->
-        cleanup x ((:=) continue_main_loop) old_state
+      done
 
 (*** Managing user inputs ***)
 

debugger/question.ml

@@ -20,8 +20,11 @@ module Lexer = Debugger_lexer
 (* Ask user a yes or no question. *)
 let yes_or_no message =
   if !interactif then
-    let old_prompt = !current_prompt in
-      try
+    let finally =
+      let old_prompt = !current_prompt in
+      fun () -> stop_user_input (); current_prompt := old_prompt
+    in
+      Fun.protect ~finally @@ fun () ->
         current_prompt := message ^ " ? (y or n) ";
         let answer =
           let rec ask () =
@@ -29,23 +32,17 @@ let yes_or_no message =
             let line =
               string_trim (Lexer.line (Lexing.from_function read_user_input))
             in
-              stop_user_input ();
               match (if String.length line > 0 then line.[0] else ' ') with
                 'y' -> true
               | 'n' -> false
               | _ ->
+                stop_user_input ();
                 print_string "Please answer y or n.";
                 print_newline ();
                 ask ()
           in
             ask ()
         in
-          current_prompt := old_prompt;
           answer
-      with
-        x ->
-          cleanup x (fun () ->
-            current_prompt := old_prompt;
-            stop_user_input ()) ()
   else
     false

debugger/trap_barrier.ml

@@ -16,7 +16,6 @@
 
 (************************** Trap barrier *******************************)
 
-open Primitives
 open Debugcom
 open Checkpoints
 
@@ -39,10 +38,5 @@ let update_trap_barrier () =
 (* Execute `funct' with a trap barrier. *)
 (* --- Used by `finish'. *)
 let exec_with_trap_barrier trap_barrier funct =
-  try
-    install_trap_barrier trap_barrier;
-    funct ();
-    remove_trap_barrier ()
-  with
-    x ->
-      cleanup x remove_trap_barrier ()
+  install_trap_barrier trap_barrier;
+  Fun.protect ~finally:remove_trap_barrier funct