Compatibility for ocaml 3.12

4 files changed, 66 insertions, 62 deletions

diff --git a/README.md b/README.md
index b670be7..7ffe22b 100644
--- a/README.md
+++ b/README.md
@@ -118,10 +118,7 @@ Tout le monde connait les règles ;-)
 Comment lancer le juge
 ----------------------
 
-Prérequis : OCaml 4.02 avec ocamlbuild, bibliothèque graphique, etc.  Ne compile
-pas avec les versions précédentes (en particulier le code utilise un `match with
-exception`, construction introduite dans cette version), mais à pas grand chose
-près cela devrait devenir possible.
+Prérequis : OCaml 3.12 à 4.02.
 
 Instructions pour le cas du morpion récursif.
 
diff --git a/judge/core.ml b/judge/core.ml
index ec73639..1c8ad05 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -3,6 +3,11 @@ open Unix
 open Protocol
 
 let ( |> ) x f = f x
+let iteri f l =
+  let rec aux i = function
+    | p::q -> f i p; aux (i+1) q
+    | [] -> ()
+  in aux 0 l
 
 (* Description of data structures *)
 
@@ -91,12 +96,12 @@ module Core (G: GAME) : CORE = struct
     mutable hist: G.game list;
     p1: player_proc;
     p2: player_proc;
-    mutable s: game_status;
+    mutable gs: game_status;
   }
   let p1 g = g.p1.s
   let p2 g = g.p2.s
   let pn g = (g.p1.p.name, g.p2.p.name)
-  let s g = g.s
+  let s g = g.gs
   let g g = List.hd g.hist
   let hist g = g.hist
 
@@ -263,7 +268,7 @@ module Core (G: GAME) : CORE = struct
       let p1 = open_c (Hashtbl.find players p1) in
       let p2 = open_c (Hashtbl.find players p2) in
       let g = G.new_game in
-      let g = { p1; p2; hist = [g]; s = G.s g } in
+      let g = { p1; p2; hist = [g]; gs = G.s g } in
       r_games := g::(!r_games)
     in
     let can_launch, cannot_launch = List.partition
@@ -297,56 +302,58 @@ module Core (G: GAME) : CORE = struct
       let pi = if p == g.p1 then P1 else P2 in
       let op = match pi with P1 -> g.p2 | P2 -> g.p1 in
       begin try
-        let l = input_line p.i in
-        if !log_games then Format.printf "<%s> %s@." p.p.name l;
-        match decode l, p.s with
-        | Hello x, Loading when x = G.id ->
-          p.s <- StandBy !game_time;
-        | Play act, Thinking (time, beg_r) ->
-          let end_r = Unix.gettimeofday () in
-          if G.s (List.hd g.hist) <> TurnOf pi then
-            raise (Eliminated_ex "not your turn (assert failed)");
-          let new_g = G.play (List.hd g.hist) act in
-          let new_s = G.s new_g in
-          send_m p OK;
-          send_m op (Play act);
-          g.s <- new_s;
-          g.hist <- new_g::g.hist;
-          let finished = match new_s with
-            | Tie ->
-              send_m p Tie;
-              send_m op Tie;
-              Format.printf "%s vs. %s: tie!@." g.p1.p.name g.p2.p.name;
-              p.p.score <- p.p.score + !pt_tie;
-              op.p.score <- op.p.score + !pt_tie;
-              true
-            | Won x ->
-              let (w, l) = if x = P1 then (g.p1, g.p2) else (g.p2, g.p1) in
-              send_m w YouWin;
-              send_m l YouLose;
-              Format.printf "%s vs. %s: %s wins!@." g.p1.p.name g.p2.p.name w.p.name;
-              w.p.score <- w.p.score + !pt_win;
-              l.p.score <- l.p.score + !pt_lose;
-              true
-            | TurnOf _ ->
-              p.s <- StandBy (time -. (end_r -. beg_r));
-              false
-            | Eliminated _ -> raise (Eliminated_ex ("invalid move: " ^ act))
-          in
-          if finished then begin
-            p.s <- Saving;
-            if op.s <> Dead then op.s <- Saving;
-          end
-        | FairEnough, Saving ->
-          kill p.pid Sys.sigterm;
-        | _, Saving ->
-          ()  (* player may be anywhere in its protocol state, we don't care*)
-        | bad_m, _ -> raise (Eliminated_ex ("unexpected message: '" ^ encode bad_m ^ "'"))
-        | exception Invalid_message m -> raise (Eliminated_ex ("invalid message: '" ^ m ^"'"))
-        | exception _ -> raise (Eliminated_ex "exception when reading message")
+        try
+          let l = input_line p.i in
+          if !log_games then Format.printf "<%s> %s@." p.p.name l;
+          match decode l, p.s with
+          | Hello x, Loading when x = G.id ->
+            p.s <- StandBy !game_time;
+          | Play act, Thinking (time, beg_r) ->
+            let end_r = Unix.gettimeofday () in
+            if G.s (List.hd g.hist) <> TurnOf pi then
+              raise (Eliminated_ex "not your turn (assert failed)");
+            let new_g = G.play (List.hd g.hist) act in
+            let new_s = G.s new_g in
+            send_m p OK;
+            send_m op (Play act);
+            g.gs <- new_s;
+            g.hist <- new_g::g.hist;
+            let finished = match new_s with
+              | Tie ->
+                send_m p Protocol.Tie;
+                send_m op Protocol.Tie;
+                Format.printf "%s vs. %s: tie!@." g.p1.p.name g.p2.p.name;
+                p.p.score <- p.p.score + !pt_tie;
+                op.p.score <- op.p.score + !pt_tie;
+                true
+              | Won x ->
+                let (w, l) = if x = P1 then (g.p1, g.p2) else (g.p2, g.p1) in
+                send_m w YouWin;
+                send_m l YouLose;
+                Format.printf "%s vs. %s: %s wins!@." g.p1.p.name g.p2.p.name w.p.name;
+                w.p.score <- w.p.score + !pt_win;
+                l.p.score <- l.p.score + !pt_lose;
+                true
+              | TurnOf _ ->
+                p.s <- StandBy (time -. (end_r -. beg_r));
+                false
+              | Eliminated _ -> raise (Eliminated_ex ("invalid move: " ^ act))
+            in
+            if finished then begin
+              p.s <- Saving;
+              if op.s <> Dead then op.s <- Saving;
+            end
+          | FairEnough, Saving ->
+            kill p.pid Sys.sigterm;
+          | _, Saving ->
+            ()  (* player may be anywhere in its protocol state, we don't care*)
+          | bad_m, _ -> raise (Eliminated_ex ("unexpected message: '" ^ encode bad_m ^ "'"))
+        with
+        | Invalid_message m -> raise (Eliminated_ex ("invalid message: '" ^ m ^"'"))
+        | _ -> raise (Eliminated_ex "exception when reading message")
       with
         | Eliminated_ex r ->
-          send_m p Eliminated;
+          send_m p Protocol.Eliminated;
           send_m op YouWin;
           (* since process is not respecting the protocol, we cannot assume
             it is doing anything reasonable, so we kill it now rather than later... *)
@@ -355,9 +362,9 @@ module Core (G: GAME) : CORE = struct
           p.p.score <- p.p.score + !pt_elim;
           if op.s <> Dead then op.s <- Saving;
           p.s <- Saving;
-          g.s <- Eliminated pi
+          g.gs <- Eliminated pi
       end;
-      begin match g.s, g.p1.s, g.p2.s, g.p1, g.p2 with
+      begin match g.gs, g.p1.s, g.p2.s, g.p1, g.p2 with
         | TurnOf P1, StandBy t, StandBy _, p, _
         | TurnOf P2, StandBy _, StandBy t, _, p ->
           send_m p (YourTurn t);
@@ -400,7 +407,7 @@ module Core (G: GAME) : CORE = struct
             Format.printf "%s vs. %s: %s eliminated (died...)!@." g.p1.p.name g.p2.p.name p.p.name;
             p.p.score <- p.p.score + !pt_elim;
             if op.s <> Dead then op.s <- Saving;
-            g.s <- Eliminated pi
+            g.gs <- Eliminated pi
           end;
           p.s <- Dead;
           p.p.running <- None;
diff --git a/judge/dummy_game.ml b/judge/dummy_game.ml
index 4ac4eac..e795ec7 100644
--- a/judge/dummy_game.ml
+++ b/judge/dummy_game.ml
@@ -29,7 +29,7 @@ module G : GAME = struct
     let open Graphics in
     let open G_util in
     let pt = function P1 -> p1n | P2 -> p2n in
-    List.iteri
+    iteri
       (fun i (p, x) ->
         text2 (i+4) black (string_of_int i);
         text3 (i+4) (pc p) x)
diff --git a/judge/main.ml b/judge/main.ml
index 8c74be6..3e14ff2 100644
--- a/judge/main.ml
+++ b/judge/main.ml
@@ -115,7 +115,7 @@ end = struct
       text3 (i+4) black n;
       text4 (i+4) black (string_of_int s)
     in
-    List.iteri show_sc scores
+    iteri show_sc scores
 
   (* Match list view *)
   and matchlist_disp show_only_running =
@@ -155,7 +155,7 @@ end = struct
       text3 (i+4) cp2 p2n;
       let c, m = mp (C.p2 g) in text4 (i+4) c m
     in
-    List.iteri print_g games
+    iteri print_g games
 
   (* Game view *)
   and last_game_disp () =
@@ -200,7 +200,7 @@ end = struct
         G.display_game g (p1n, p2n)
       end
     in
-    List.iteri put_st (List.rev (C.hist g))
+    iteri put_st (List.rev (C.hist g))
 
 end