aboutsummaryrefslogtreecommitdiff
path: root/judge
diff options
context:
space:
mode:
authorAlex AUVOLAT <alex.auvolat@ens.fr>2014-11-10 09:56:13 +0100
committerAlex AUVOLAT <alex.auvolat@ens.fr>2014-11-10 09:56:13 +0100
commitd343fcb803e955504b0d6b5c9c852620886c2994 (patch)
tree0b60abd9a3c9036ccf45da491b10d7d64ce71321 /judge
parent5fecbfb6532487efc711eb1a9763535db720a291 (diff)
downloadCompetIA-d343fcb803e955504b0d6b5c9c852620886c2994.tar.gz
CompetIA-d343fcb803e955504b0d6b5c9c852620886c2994.zip
RETAB!
Diffstat (limited to 'judge')
-rw-r--r--judge/core.ml632
-rw-r--r--judge/morpion_rec.ml14
-rw-r--r--judge/protocol.ml62
3 files changed, 354 insertions, 354 deletions
diff --git a/judge/core.ml b/judge/core.ml
index 259bc1e..8ffdc47 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -8,53 +8,53 @@ type player = P1 | P2
let other_player = function P1 -> P2 | P2 -> P1
type game_status =
- | TurnOf of player
- | Won of player
- | Tie
- | Eliminated of player
+ | TurnOf of player
+ | Won of player
+ | Tie
+ | Eliminated of player
type player_proc_status =
- | Loading
- | StandBy of float (* temps restant sur toute la partie *)
- | Thinking of (float * float) (* temps restant ; heure de début de réflexion *)
- | Saving
- | Dead
+ | Loading
+ | StandBy of float (* temps restant sur toute la partie *)
+ | Thinking of (float * float) (* temps restant ; heure de début de réflexion *)
+ | Saving
+ | Dead
module type GAME = sig
- type game (* immutable structure *)
+ type game (* immutable structure *)
- val name : string (* ex: Morpion récursif *)
- val id : string (* ex: morpion_rec *)
+ val name : string (* ex: Morpion récursif *)
+ val id : string (* ex: morpion_rec *)
- val new_game : game
+ val new_game : game
- val play : game -> player -> string -> game
- val s : game -> game_status
+ val play : game -> player -> string -> game
+ val s : game -> game_status
- val display_game : game -> (string * string) -> unit
+ val display_game : game -> (string * string) -> unit
end
module type CORE = sig
- module G : GAME
+ module G : GAME
- type game
- val p1 : game -> player_proc_status
- val p2 : game -> player_proc_status
- val pn : game -> string * string
- val s : game -> game_status
- val g : game -> G.game
- val hist : game -> G.game list (* head: same as g g *)
+ type game
+ val p1 : game -> player_proc_status
+ val p2 : game -> player_proc_status
+ val pn : game -> string * string
+ val s : game -> game_status
+ val g : game -> G.game
+ val hist : game -> G.game list (* head: same as g g *)
- val init : unit -> unit
- val finish : unit -> unit
+ val init : unit -> unit
+ val finish : unit -> unit
- val handle_events : unit -> unit (* is anything happening ? *)
+ val handle_events : unit -> unit (* is anything happening ? *)
- val add_rounds : unit -> unit (* adds one game of everyone against everyone *)
+ val add_rounds : unit -> unit (* adds one game of everyone against everyone *)
- val ql : unit -> int
- val scores : unit -> (string * int) list
- val games : unit -> game list
+ val ql : unit -> int
+ val scores : unit -> (string * int) list
+ val games : unit -> game list
end
@@ -63,289 +63,289 @@ end
(* ****************************************** *)
module Core (G: GAME) : CORE = struct
- module G : GAME = G
-
- exception Eliminated_ex of string
-
- type player = {
- name: string;
- binary: string;
- dir: string;
- log_out: file_descr;
- mutable score: int;
- mutable running: player_proc option;
- }
-
- and player_proc = {
- pid: int;
- p: player;
- i: in_channel;
- o: out_channel;
- mutable s: player_proc_status;
- }
- let send_m pp m =
- output_string pp.o (encode m ^ "\n");
- flush pp.o
-
- type game = {
- mutable hist: G.game list;
- p1: player_proc;
- p2: player_proc;
- mutable s: 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 g g = List.hd g.hist
- let hist g = g.hist
-
- let players = Hashtbl.create 12
- let planned_games = ref []
- let r_games = ref []
-
- let ql () = List.length !planned_games
-
- (* program paremeters *)
- let par_games = ref 2 (* default: launch two simultaneous games *)
- let game_time = ref 30.0 (* default: 30 sec for each player *)
- let pt_win = ref 3 (* default: on win, score += 3 *)
- let pt_tie = ref 1 (* default: on tie, score += 1 *)
- let pt_lose = ref 0 (* default: on lose, score does not change *)
- let pt_elim = ref (-1) (* default: on eliminated, score -= 1 *)
-
- let scores () =
- Hashtbl.fold (fun _ p l -> (p.name, p.score)::l) players []
- let games () = !r_games
-
- let init () =
- (* 1. PARSE ARGUMENTS *)
- let game_dir = ref "" in
- let args = [
- "-p", Arg.Set_int par_games, "How many games to run in parallel (2)";
- "-s", Arg.Set_float game_time,
- "Time (seconds) allotted to each player for a game (30)";
- "-w", Arg.Set_int pt_win, "Points granted on win (+3)";
- "-t", Arg.Set_int pt_tie, "Points granted on tie (+1)";
- "-l", Arg.Set_int pt_lose, "Points granted on lose (0)";
- "-e", Arg.Set_int pt_elim, "Points granted on eliminated (-1)";
-
- ] in
- Arg.parse args (fun s -> game_dir := s)
- "Usage: judge <game_directory>";
- if !game_dir = "" then begin
- Format.eprintf "Error: no game directory specified.@.";
- exit 1
- end;
- if Filename.is_relative !game_dir then
- game_dir := Filename.concat (Unix.getcwd()) !game_dir;
- let date =
- let d = Unix.gmtime (Unix.gettimeofday ()) in
- Format.sprintf "%04d%02d%02d%02d%02d" (d.tm_year+1900) (d.tm_mon+1) d.tm_mday d.tm_hour d.tm_min
- in
-
- (* 2. REDIRECT STDOUT TO LOG FILE *)
- let log_file = Filename.concat !game_dir (date^".log") in
- Format.printf "Juge for '%s' starting up...@." G.name;
- Format.printf "Redirecting standard output to '%s'.@." log_file;
- flush Pervasives.stdout;
- begin try
- let log_out = Unix.openfile log_file [O_APPEND; O_CREAT; O_WRONLY] 0o644 in
- dup2 log_out Unix.stdout
- with _ ->
- Format.eprintf "Could not open log output file.@.";
- exit 1
- end;
- Format.printf "Juge for '%s' starting up...@." G.name;
- Format.printf "Session: %s@." date;
-
- (* 3. LOAD PLAYER LIST *)
- Format.printf "Loading player list...@.";
- let fd = try opendir !game_dir with _ ->
- Format.printf "Could not open directory %s for listing.@." !game_dir;
- exit 1
- in
- let rec rd () =
- try let s = readdir fd in
- begin try
- let dir = Filename.concat !game_dir s in
- let b = Filename.concat dir "player" in
- let st = Unix.stat b in
- if (st.st_kind = S_REG || st.st_kind = S_LNK)
- && (st.st_perm land 0o100 <> 0) then begin
- Format.printf "- %s@." s;
- (* open log output for player *)
- let p_log_file = Filename.concat dir "stderr.log" in
- let p_log_out = Unix.openfile p_log_file [O_APPEND; O_CREAT; O_WRONLY] 0o644 in
- let f = Format.formatter_of_out_channel (out_channel_of_descr p_log_out) in
- Format.fprintf f "---- Begin session %s@." date;
- Hashtbl.add players s
- { name = s;
- binary = b;
- dir;
- log_out = p_log_out;
- score = 0;
- running = None; }
- end
- with _ -> () end;
- rd()
- with End_of_file -> ()
- in rd (); closedir fd
-
- let finish () =
- (* TODO :
- - save scores
- - kill all child processes and wait for them
- *)
- ()
-
- let add_rounds () =
- Hashtbl.iter
- (fun p _ -> Hashtbl.iter
- (fun q _ -> if p <> q then planned_games := (p, q)::!planned_games)
- players)
- players
-
- let handle_events () =
- (* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
- let matches_in_progress = List.length
- (List.filter
- (fun g -> match g.p1.s, g.p2.s with Dead, Dead -> false | _ -> true)
- !r_games)
- in
- let launch_match p1 p2 =
- Format.printf "Launching match: %s vs. %s@." p1 p2;
-
- let open_c p =
- let f = Format.formatter_of_out_channel (out_channel_of_descr p.log_out) in
- Format.fprintf f "--- Begin game (%s vs. %s)@." p1 p2;
- let (j2p_i, j2p_o) = pipe () in
- let (p2j_i, p2j_o) = pipe () in
- let pid = fork() in
- if pid = 0 then begin
- chdir p.dir;
- dup2 j2p_i stdin;
- dup2 p2j_o stdout;
- dup2 p.log_out stderr;
- execvp p.binary [| p.binary |];
- end;
- Format.printf "- %s: pid %d@." p.name pid;
- let pl = { pid; p;
- i = in_channel_of_descr p2j_i;
- o = out_channel_of_descr j2p_o;
- s = Loading } in
- p.running <- Some pl;
- send_m pl (Hello G.id);
- pl
- in
- 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
- r_games := g::(!r_games)
- in
- let can_launch, cannot_launch = List.partition
- (fun (p1, p2) ->
- (Hashtbl.find players p1).running = None
- && (Hashtbl.find players p2).running = None)
- !planned_games
- in
- begin match can_launch with
- | (p1, p2)::q when matches_in_progress < !par_games ->
- launch_match p1 p2;
- planned_games := q @ cannot_launch
- | _ -> ()
- end;
- (* 2. LOOK IF ANYBODY IS TELLING US SOMETHING - IF SO, REACT
- (wait max. 0.01 sec) *)
- let in_fd = List.fold_left
- (fun l g ->
- let l = match g.p1.s with
- | Dead -> l
- | _ -> (Unix.descr_of_in_channel g.p1.i)::l
- in match g.p2.s with
- | Dead -> l
- | _ -> (Unix.descr_of_in_channel g.p2.i)::l)
- [] !r_games
- in
- let in_fd, _, _ =
- try select in_fd [] [] 0.01
- with
- Unix_error (EINTR, _, _) -> [], [], []
- in
- let do_fd fd =
- let g = List.find
- (fun g -> fd = Unix.descr_of_in_channel g.p1.i
- || fd = Unix.descr_of_in_channel g.p2.i)
- !r_games
- in
- let pi = if Unix.descr_of_in_channel g.p1.i = fd then P1 else P2 in
- 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;
- | Play act, Thinking (time, beg_r) ->
- let end_r = Unix.gettimeofday () in
- let new_g = G.play (List.hd g.hist) pi 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 _ -> 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
- 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
-
+ module G : GAME = G
+
+ exception Eliminated_ex of string
+
+ type player = {
+ name: string;
+ binary: string;
+ dir: string;
+ log_out: file_descr;
+ mutable score: int;
+ mutable running: player_proc option;
+ }
+
+ and player_proc = {
+ pid: int;
+ p: player;
+ i: in_channel;
+ o: out_channel;
+ mutable s: player_proc_status;
+ }
+ let send_m pp m =
+ output_string pp.o (encode m ^ "\n");
+ flush pp.o
+
+ type game = {
+ mutable hist: G.game list;
+ p1: player_proc;
+ p2: player_proc;
+ mutable s: 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 g g = List.hd g.hist
+ let hist g = g.hist
+
+ let players = Hashtbl.create 12
+ let planned_games = ref []
+ let r_games = ref []
+
+ let ql () = List.length !planned_games
+
+ (* program paremeters *)
+ let par_games = ref 2 (* default: launch two simultaneous games *)
+ let game_time = ref 30.0 (* default: 30 sec for each player *)
+ let pt_win = ref 3 (* default: on win, score += 3 *)
+ let pt_tie = ref 1 (* default: on tie, score += 1 *)
+ let pt_lose = ref 0 (* default: on lose, score does not change *)
+ let pt_elim = ref (-1) (* default: on eliminated, score -= 1 *)
+
+ let scores () =
+ Hashtbl.fold (fun _ p l -> (p.name, p.score)::l) players []
+ let games () = !r_games
+
+ let init () =
+ (* 1. PARSE ARGUMENTS *)
+ let game_dir = ref "" in
+ let args = [
+ "-p", Arg.Set_int par_games, "How many games to run in parallel (2)";
+ "-s", Arg.Set_float game_time,
+ "Time (seconds) allotted to each player for a game (30)";
+ "-w", Arg.Set_int pt_win, "Points granted on win (+3)";
+ "-t", Arg.Set_int pt_tie, "Points granted on tie (+1)";
+ "-l", Arg.Set_int pt_lose, "Points granted on lose (0)";
+ "-e", Arg.Set_int pt_elim, "Points granted on eliminated (-1)";
+
+ ] in
+ Arg.parse args (fun s -> game_dir := s)
+ "Usage: judge <game_directory>";
+ if !game_dir = "" then begin
+ Format.eprintf "Error: no game directory specified.@.";
+ exit 1
+ end;
+ if Filename.is_relative !game_dir then
+ game_dir := Filename.concat (Unix.getcwd()) !game_dir;
+ let date =
+ let d = Unix.gmtime (Unix.gettimeofday ()) in
+ Format.sprintf "%04d%02d%02d%02d%02d" (d.tm_year+1900) (d.tm_mon+1) d.tm_mday d.tm_hour d.tm_min
+ in
+
+ (* 2. REDIRECT STDOUT TO LOG FILE *)
+ let log_file = Filename.concat !game_dir (date^".log") in
+ Format.printf "Juge for '%s' starting up...@." G.name;
+ Format.printf "Redirecting standard output to '%s'.@." log_file;
+ flush Pervasives.stdout;
+ begin try
+ let log_out = Unix.openfile log_file [O_APPEND; O_CREAT; O_WRONLY] 0o644 in
+ dup2 log_out Unix.stdout
+ with _ ->
+ Format.eprintf "Could not open log output file.@.";
+ exit 1
+ end;
+ Format.printf "Juge for '%s' starting up...@." G.name;
+ Format.printf "Session: %s@." date;
+
+ (* 3. LOAD PLAYER LIST *)
+ Format.printf "Loading player list...@.";
+ let fd = try opendir !game_dir with _ ->
+ Format.printf "Could not open directory %s for listing.@." !game_dir;
+ exit 1
+ in
+ let rec rd () =
+ try let s = readdir fd in
+ begin try
+ let dir = Filename.concat !game_dir s in
+ let b = Filename.concat dir "player" in
+ let st = Unix.stat b in
+ if (st.st_kind = S_REG || st.st_kind = S_LNK)
+ && (st.st_perm land 0o100 <> 0) then begin
+ Format.printf "- %s@." s;
+ (* open log output for player *)
+ let p_log_file = Filename.concat dir "stderr.log" in
+ let p_log_out = Unix.openfile p_log_file [O_APPEND; O_CREAT; O_WRONLY] 0o644 in
+ let f = Format.formatter_of_out_channel (out_channel_of_descr p_log_out) in
+ Format.fprintf f "---- Begin session %s@." date;
+ Hashtbl.add players s
+ { name = s;
+ binary = b;
+ dir;
+ log_out = p_log_out;
+ score = 0;
+ running = None; }
+ end
+ with _ -> () end;
+ rd()
+ with End_of_file -> ()
+ in rd (); closedir fd
+
+ let finish () =
+ (* TODO :
+ - save scores
+ - kill all child processes and wait for them
+ *)
+ ()
+
+ let add_rounds () =
+ Hashtbl.iter
+ (fun p _ -> Hashtbl.iter
+ (fun q _ -> if p <> q then planned_games := (p, q)::!planned_games)
+ players)
+ players
+
+ let handle_events () =
+ (* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
+ let matches_in_progress = List.length
+ (List.filter
+ (fun g -> match g.p1.s, g.p2.s with Dead, Dead -> false | _ -> true)
+ !r_games)
+ in
+ let launch_match p1 p2 =
+ Format.printf "Launching match: %s vs. %s@." p1 p2;
+
+ let open_c p =
+ let f = Format.formatter_of_out_channel (out_channel_of_descr p.log_out) in
+ Format.fprintf f "--- Begin game (%s vs. %s)@." p1 p2;
+ let (j2p_i, j2p_o) = pipe () in
+ let (p2j_i, p2j_o) = pipe () in
+ let pid = fork() in
+ if pid = 0 then begin
+ chdir p.dir;
+ dup2 j2p_i stdin;
+ dup2 p2j_o stdout;
+ dup2 p.log_out stderr;
+ execvp p.binary [| p.binary |];
+ end;
+ Format.printf "- %s: pid %d@." p.name pid;
+ let pl = { pid; p;
+ i = in_channel_of_descr p2j_i;
+ o = out_channel_of_descr j2p_o;
+ s = Loading } in
+ p.running <- Some pl;
+ send_m pl (Hello G.id);
+ pl
+ in
+ 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
+ r_games := g::(!r_games)
+ in
+ let can_launch, cannot_launch = List.partition
+ (fun (p1, p2) ->
+ (Hashtbl.find players p1).running = None
+ && (Hashtbl.find players p2).running = None)
+ !planned_games
+ in
+ begin match can_launch with
+ | (p1, p2)::q when matches_in_progress < !par_games ->
+ launch_match p1 p2;
+ planned_games := q @ cannot_launch
+ | _ -> ()
+ end;
+ (* 2. LOOK IF ANYBODY IS TELLING US SOMETHING - IF SO, REACT
+ (wait max. 0.01 sec) *)
+ let in_fd = List.fold_left
+ (fun l g ->
+ let l = match g.p1.s with
+ | Dead -> l
+ | _ -> (Unix.descr_of_in_channel g.p1.i)::l
+ in match g.p2.s with
+ | Dead -> l
+ | _ -> (Unix.descr_of_in_channel g.p2.i)::l)
+ [] !r_games
+ in
+ let in_fd, _, _ =
+ try select in_fd [] [] 0.01
+ with
+ Unix_error (EINTR, _, _) -> [], [], []
+ in
+ let do_fd fd =
+ let g = List.find
+ (fun g -> fd = Unix.descr_of_in_channel g.p1.i
+ || fd = Unix.descr_of_in_channel g.p2.i)
+ !r_games
+ in
+ let pi = if Unix.descr_of_in_channel g.p1.i = fd then P1 else P2 in
+ 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;
+ | Play act, Thinking (time, beg_r) ->
+ let end_r = Unix.gettimeofday () in
+ let new_g = G.play (List.hd g.hist) pi 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 _ -> 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
+ 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/morpion_rec.ml b/judge/morpion_rec.ml
index 337116a..15af169 100644
--- a/judge/morpion_rec.ml
+++ b/judge/morpion_rec.ml
@@ -5,18 +5,18 @@ let ( |> ) x f = f x
module Morpion_rec : sig
- type game (* immutable structure *)
+ type game (* immutable structure *)
- val name : string
- val id : string
+ val name : string
+ val id : string
- val new_game : game
+ val new_game : game
val possibilities : game -> string list
- val play : game -> player -> string -> game
- val s : game -> game_status
+ val play : game -> player -> string -> game
+ val s : game -> game_status
- val display_game : game -> (string * string) -> unit
+ val display_game : game -> (string * string) -> unit
end = struct
diff --git a/judge/protocol.ml b/judge/protocol.ml
index 3f6d548..89248f2 100644
--- a/judge/protocol.ml
+++ b/judge/protocol.ml
@@ -2,40 +2,40 @@
exception Invalid_message of string
type msg =
- | Hello of string (* nom du jeu *)
- | YourTurn of float (* nombre secondes pour jouer *)
- | Play of string (* description textuelle du coup *)
- | OK (* coup accepté *)
- | YouWin
- | YouLose
- | Tie
- | Eliminated
- | FairEnough
+ | Hello of string (* nom du jeu *)
+ | YourTurn of float (* nombre secondes pour jouer *)
+ | Play of string (* description textuelle du coup *)
+ | OK (* coup accepté *)
+ | YouWin
+ | YouLose
+ | Tie
+ | Eliminated
+ | FairEnough
let decode = function
- | "OK" -> OK
- | "You win" -> YouWin
- | "You lose" -> YouLose
- | "Tie" -> Tie
- | "Eliminated" -> Eliminated
- | "Fair enough" -> FairEnough
- | s when String.sub s 0 6 = "Hello " ->
- Hello (String.sub s 6 (String.length s - 6))
- | s when String.sub s 0 10 = "Your turn " ->
- YourTurn (float_of_string (String.sub s 10 (String.length s - 10)))
- | s when String.sub s 0 5 = "Play " ->
- Play (String.sub s 5 (String.length s - 5))
- | s -> raise (Invalid_message s)
+ | "OK" -> OK
+ | "You win" -> YouWin
+ | "You lose" -> YouLose
+ | "Tie" -> Tie
+ | "Eliminated" -> Eliminated
+ | "Fair enough" -> FairEnough
+ | s when String.sub s 0 6 = "Hello " ->
+ Hello (String.sub s 6 (String.length s - 6))
+ | s when String.sub s 0 10 = "Your turn " ->
+ YourTurn (float_of_string (String.sub s 10 (String.length s - 10)))
+ | s when String.sub s 0 5 = "Play " ->
+ Play (String.sub s 5 (String.length s - 5))
+ | s -> raise (Invalid_message s)
let encode = function
- | Hello x -> "Hello " ^ x
- | YourTurn n -> "Your turn " ^ (string_of_float n)
- | Play x -> "Play " ^ x
- | OK -> "OK"
- | YouWin -> "You win"
- | YouLose -> "You lose"
- | Tie -> "Tie"
- | Eliminated -> "Eliminated"
- | FairEnough -> "Fair enough"
+ | Hello x -> "Hello " ^ x
+ | YourTurn n -> "Your turn " ^ (string_of_float n)
+ | Play x -> "Play " ^ x
+ | OK -> "OK"
+ | YouWin -> "You win"
+ | YouLose -> "You lose"
+ | Tie -> "Tie"
+ | Eliminated -> "Eliminated"
+ | FairEnough -> "Fair enough"