diff options
-rw-r--r-- | README.md | 5 | ||||
-rw-r--r-- | judge/core.ml | 115 | ||||
-rw-r--r-- | judge/dummy_game.ml | 2 | ||||
-rw-r--r-- | judge/main.ml | 6 |
4 files changed, 66 insertions, 62 deletions
@@ -121,10 +121,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 33329ff..c68a1ad 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 @@ -264,7 +269,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); usefull := true in @@ -299,56 +304,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... *) @@ -357,9 +364,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); @@ -404,7 +411,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 38de615..15d336f 100644 --- a/judge/main.ml +++ b/judge/main.ml @@ -123,7 +123,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 = @@ -163,7 +163,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 () = @@ -208,7 +208,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 |