aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--README.md5
-rw-r--r--judge/core.ml115
-rw-r--r--judge/dummy_game.ml2
-rw-r--r--judge/main.ml6
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 22:40:16 +0000