From d343fcb803e955504b0d6b5c9c852620886c2994 Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Mon, 10 Nov 2014 09:56:13 +0100 Subject: RETAB! --- judge/core.ml | 632 +++++++++++++++++++++++++-------------------------- judge/morpion_rec.ml | 14 +- judge/protocol.ml | 62 ++--- 3 files changed, 354 insertions(+), 354 deletions(-) (limited to 'judge') 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 "; - 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 "; + 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" -- cgit v1.2.3