diff options
Diffstat (limited to 'judge')
| -rw-r--r-- | judge/core.ml | 128 | ||||
| -rw-r--r-- | judge/dummy_game.ml | 2 |
2 files changed, 61 insertions, 69 deletions
diff --git a/judge/core.ml b/judge/core.ml index 4411937..8b437d3 100644 --- a/judge/core.ml +++ b/judge/core.ml @@ -280,76 +280,68 @@ module Core (G: GAME) : CORE = struct let p = match pi with P1 -> g.p1 | P2 -> g.p2 in let op = match pi with P1 -> g.p2 | P2 -> g.p1 in begin try match decode (input_line p.i), p.s with - | Hello x, Loading when x = G.id -> - p.s <- StandBy !game_time; - begin match g.s, 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); - p.s <- Thinking (t, Unix.gettimeofday()); - | _ -> () - end - | Play act, Thinking (time, beg_r) -> - let end_r = Unix.gettimeofday () in - let new_g, new_s = G.turn (List.hd g.hist) pi act in - begin match new_s with - | Eliminated _ -> raise (Eliminated_ex ("invalid move: " ^ act)) | _ -> () - end; - 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 _ -> false - | Eliminated x -> assert false - in - if finished then begin - p.s <- Saving; - op.s <- Saving; - end else begin - p.s <- StandBy (time -. (end_r -. beg_r)); - match op.s with - | StandBy t -> - send_m op (YourTurn t); - op.s <- Thinking (t, Unix.gettimeofday ()) - | _ -> assert false - end - | FairEnough, Saving -> - kill p.pid Sys.sigterm; - p.s <- Dead; - p.p.running <- None; - | 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") + | Hello x, Loading when x = G.id -> + p.s <- StandBy !game_time; + | Play act, Thinking (time, beg_r) -> + let end_r = Unix.gettimeofday () in + let new_g, new_s = G.turn (List.hd g.hist) pi act 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 _ -> false + | Eliminated _ -> raise (Eliminated_ex ("invalid move: " ^ act)) + in + if finished then begin + p.s <- Saving; + op.s <- Saving; + end else begin + p.s <- StandBy (time -. (end_r -. beg_r)); + end + | FairEnough, Saving -> + kill p.pid Sys.sigterm; + p.s <- Dead; + p.p.running <- None; + | 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") with - | Eliminated_ex r -> - send_m p Eliminated; - send_m op YouWin; - (* since process is not respecting the protocol, we cannot assume - it is doing anything reasonable, so we kill it... *) - kill p.pid Sys.sigterm; - Format.printf "%s vs. %s: %s eliminated (%s)!@." g.p1.p.name g.p2.p.name p.p.name r; - p.s <- Dead; - p.p.running <- None; - p.p.score <- p.p.score + !pt_elim; - op.s <- Saving; - g.s <- Eliminated pi + | Eliminated_ex r -> + send_m p Eliminated; + send_m op YouWin; + (* since process is not respecting the protocol, we cannot assume + it is doing anything reasonable, so we kill it... *) + kill p.pid Sys.sigterm; + Format.printf "%s vs. %s: %s eliminated (%s)!@." g.p1.p.name g.p2.p.name p.p.name r; + p.s <- Dead; + p.p.running <- None; + p.p.score <- p.p.score + !pt_elim; + op.s <- Saving; + g.s <- Eliminated pi end; + begin match g.s, 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); + p.s <- Thinking (t, Unix.gettimeofday()); + | _ -> () + end in List.iter do_fd in_fd end diff --git a/judge/dummy_game.ml b/judge/dummy_game.ml index 869513a..0fac26b 100644 --- a/judge/dummy_game.ml +++ b/judge/dummy_game.ml @@ -23,7 +23,7 @@ module Dummy : GAME = struct ) let id = "dummy_game" - let name = "Dumm game for testing purposes" + let name = "Dummy game for testing purposes" end |