1 files changed, 34 insertions, 18 deletions

diff --git a/kvx/InstructionScheduler.ml b/kvx/InstructionScheduler.ml
index e4dc3f97..eab0b21a 100644
--- a/kvx/InstructionScheduler.ml
+++ b/kvx/InstructionScheduler.ml
@@ -12,6 +12,16 @@
 (*                                                             *)
 (* *************************************************************)
 
+let with_destructor dtor stuff f =
+  try let ret = f stuff in
+      dtor stuff;
+      ret
+  with exn -> dtor stuff;
+              raise exn;;
+
+let with_out_channel chan f = with_destructor close_out chan f;;
+let with_in_channel chan f = with_destructor close_in chan f;;
+
 (** Schedule instructions on a synchronized pipeline
 @author David Monniaux, CNRS, VERIMAG *)
 
@@ -844,16 +854,15 @@ let pseudo_boolean_solver = ref "pb_solver"
 
 let pseudo_boolean_scheduler pb_type problem =
   try
-    let filename_in = "problem.opb"
-    (* needed only if not using stdout and filename_out = "problem.sol" *) in
-    let opb_problem = open_out filename_in in
-    let mapper = pseudo_boolean_print_problem opb_problem problem pb_type in
-    close_out opb_problem;
-    
-    let opb_solution = Unix.open_process_in (!pseudo_boolean_solver ^ " " ^ filename_in) in
-    let ret = adjust_check_solution mapper (pseudo_boolean_read_solution mapper opb_solution) in
-    close_in opb_solution;
-    Some ret
+    let filename_in = "problem.opb" in
+    (* needed only if not using stdout and filename_out = "problem.sol" *)
+    let mapper =
+      with_out_channel (open_out filename_in)
+        (fun opb_problem ->
+          pseudo_boolean_print_problem opb_problem problem pb_type) in
+    Some (with_in_channel
+      (Unix.open_process_in (!pseudo_boolean_solver ^ " " ^ filename_in))
+      (fun opb_solution -> adjust_check_solution mapper (pseudo_boolean_read_solution mapper opb_solution)))
   with
   | Unschedulable -> None;;
 				 
@@ -1193,23 +1202,23 @@ let ilp_read_solution mapper channel =
 let ilp_solver = ref "ilp_solver"
 
 let problem_nr = ref 0
-                             
+
 let ilp_scheduler pb_type problem =
   try
     let filename_in = Printf.sprintf  "problem%05d.lp" !problem_nr
     and filename_out = Printf.sprintf "problem%05d.sol" !problem_nr in
     incr problem_nr;
-    let opb_problem = open_out filename_in in
-    let mapper = ilp_print_problem opb_problem problem pb_type in
-    close_out opb_problem;
+    let mapper = with_out_channel (open_out filename_in)
+      (fun opb_problem -> ilp_print_problem opb_problem problem pb_type) in
 
     begin
       match Unix.system (!ilp_solver ^ " " ^ filename_in ^ " " ^ filename_out) with
       | Unix.WEXITED 0 ->
-         let opb_solution = open_in filename_out in
-         let ret = adjust_check_solution mapper (ilp_read_solution mapper opb_solution) in
-         close_in opb_solution;
-         Some ret
+         Some (with_in_channel
+                 (open_in filename_out)
+                 (fun opb_solution ->
+                   adjust_check_solution mapper
+                     (ilp_read_solution mapper opb_solution)))
       | Unix.WEXITED _ -> failwith "failed to start ilp solver"
       | _ -> None
     end
@@ -1245,3 +1254,10 @@ let cascaded_scheduler (problem : problem) =
      end;
      Some solution;;
 
+let scheduler_by_name name =
+  match name with
+  | "ilp" -> validated_scheduler cascaded_scheduler
+  | "list" -> validated_scheduler list_scheduler
+  | "revlist" -> validated_scheduler reverse_list_scheduler
+  | "greedy" -> greedy_scheduler
+  | s -> failwith ("unknown scheduler: " ^ s);;