Compatibility for ocaml 3.12

1 files changed, 61 insertions, 54 deletions

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;