aboutsummaryrefslogtreecommitdiff
path: root/judge
diff options
context:
space:
mode:
Diffstat (limited to 'judge')
-rw-r--r--judge/core.ml19
-rw-r--r--judge/dummy_game.ml18
-rw-r--r--judge/dummy_judge.ml6
-rw-r--r--judge/dummy_player.ml49
-rw-r--r--judge/morpion_rec.ml65
-rw-r--r--judge/morpion_rec_judge.ml6
-rw-r--r--judge/player.ml61
7 files changed, 125 insertions, 99 deletions
diff --git a/judge/core.ml b/judge/core.ml
index 8ffdc47..dd6c31c 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -4,6 +4,8 @@ open Protocol
(* Description of data structures *)
+exception Eliminated_ex of string
+
type player = P1 | P2
let other_player = function P1 -> P2 | P2 -> P1
@@ -28,7 +30,7 @@ module type GAME = sig
val new_game : game
- val play : game -> player -> string -> game
+ val play : game -> string -> game
val s : game -> game_status
val display_game : game -> (string * string) -> unit
@@ -65,8 +67,6 @@ end
module Core (G: GAME) : CORE = struct
module G : GAME = G
- exception Eliminated_ex of string
-
type player = {
name: string;
binary: string;
@@ -84,7 +84,9 @@ module Core (G: GAME) : CORE = struct
mutable s: player_proc_status;
}
let send_m pp m =
- output_string pp.o (encode m ^ "\n");
+ let m = encode m in
+ Format.printf ">%s< %s@." pp.p.name m;
+ output_string pp.o (m ^ "\n");
flush pp.o
type game = {
@@ -282,12 +284,17 @@ module Core (G: GAME) : CORE = struct
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
+ begin try
+ let l = input_line p.i in
+ 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
- let new_g = G.play (List.hd g.hist) pi act 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);
diff --git a/judge/dummy_game.ml b/judge/dummy_game.ml
index 1e72682..4ac4eac 100644
--- a/judge/dummy_game.ml
+++ b/judge/dummy_game.ml
@@ -1,16 +1,15 @@
open Core
open Main
-module Dummy : GAME = struct
+module G : GAME = struct
type game = int * (player * string) list * game_status
let new_game = (10, [], TurnOf P1)
- let play (g, l, s0) p xx =
- if s0 <> TurnOf p || g <= 0 then
- (g, l, Eliminated p)
- else
+ let play (g, l, s0) xx =
+ match s0 with
+ | TurnOf p when g > 0 ->
let op = other_player p in
(g-1, l@[p, xx],
if g - 1 = 0 then
@@ -21,6 +20,8 @@ module Dummy : GAME = struct
else
TurnOf op
)
+ | TurnOf x -> (g, l, Eliminated x)
+ | _ -> raise (Eliminated_ex "not someone's turn!")
let s (_, _, s) = s
@@ -46,10 +47,3 @@ module Dummy : GAME = struct
let name = "Dummy game for testing purposes"
end
-
-module C = Core(Dummy)
-module Main = Juge(C)
-
-let () =
- Random.self_init ();
- Main.run ()
diff --git a/judge/dummy_judge.ml b/judge/dummy_judge.ml
new file mode 100644
index 0000000..1f80175
--- /dev/null
+++ b/judge/dummy_judge.ml
@@ -0,0 +1,6 @@
+module C = Core.Core(Dummy_game.G)
+module Main = Main.Juge(C)
+
+let () =
+ Random.self_init ();
+ Main.run ()
diff --git a/judge/dummy_player.ml b/judge/dummy_player.ml
index 44a24ce..1897442 100644
--- a/judge/dummy_player.ml
+++ b/judge/dummy_player.ml
@@ -1,7 +1,6 @@
-
let words = [|
- "banane"; "hippopotame"; "povrion";
+ "banane"; "hippopotame"; "poivron";
"pourquoi???"; "un ange passe"; "television";
"ceci n'est pas..."; "environ 12"; "septante";
"Philipp Glass"; "nyaaa"; "tu crois ?"; "hallo";
@@ -19,44 +18,18 @@ let words = [|
"j'ai une grosse courgette"; "bouilloire"; "morning coffee";
|]
-let expect mgs =
- let l = read_line () in
- begin try
- let (s, f) = List.find
- (fun (s, _) ->
- String.length l >= String.length s
- && String.sub l 0 (String.length s) = s)
- mgs
- in f (String.sub l (String.length s)
- (String.length l - String.length s))
- with
- Not_found ->
- Format.eprintf "Unexpected '%s'.@." l;
- exit 1
- end
+module Dummy_IA : Player.IA = struct
+
+ module G = Dummy_game.G
+
+ let play _ =
+ if Random.int 2 = 0 then Unix.sleep 1;
+ words.(Random.int (Array.length words))
-let finished _ =
- print_string "Fair enough\n"
+end
-let rec turn _ =
- expect [
- "Your turn",
- (fun _ ->
- if Random.int 2 = 0 then Unix.sleep 1;
- Format.printf "Play %s@."
- words.(Random.int (Array.length words));
- expect [ "OK", turn ]);
- "Play ", turn;
- "Tie", finished;
- "You win", finished;
- "You lose", finished;
- "Eliminated", finished
- ]
+module Dummy = Player.P(Dummy_IA)
let () =
Random.self_init ();
- expect [
- "Hello dummy_game",
- (fun _ -> print_string "Hello dummy_game\n";
- turn "")
- ];
+ Dummy.run()
diff --git a/judge/morpion_rec.ml b/judge/morpion_rec.ml
index 15af169..d2b1c14 100644
--- a/judge/morpion_rec.ml
+++ b/judge/morpion_rec.ml
@@ -3,22 +3,7 @@ open Main
let ( |> ) x f = f x
-module Morpion_rec : sig
-
- type game (* immutable structure *)
-
- val name : string
- val id : string
-
- val new_game : game
-
- val possibilities : game -> string list
- val play : game -> player -> string -> game
- val s : game -> game_status
-
- val display_game : game -> (string * string) -> unit
-
-end = struct
+module G = struct
exception Invalid_pos
@@ -126,28 +111,28 @@ end = struct
| l when List.exists ((=) Empty) l -> Empty
| _ -> T
- let play (gs, m, pgo) player act =
- let elim = (Eliminated player, m, pgo) in
- let op = other_player player in
+ let play (gs, m, pgo) act =
let (pg, pp) = decode act in
- if
- gs = TurnOf player
- && (match pgo with
- | None -> true
- | Some x when full_pm (getp1 m x) -> true
- | Some x when pg = x -> true
- | _ -> false)
- && getp m (pg, pp) = Empty
- then
- let new_m = setp m (pg, pp) (match player with P1 -> X | P2 -> O) in
- let new_s = match reduce_m (reduce_m (fun x -> x)) new_m with
- | Empty -> TurnOf op
- | X -> Won P1
- | O -> Won P2
- | T -> Tie
- in
- (new_s, new_m, Some pp)
- else elim
+ match gs with
+ | TurnOf player when
+ (match pgo with
+ | None -> true
+ | Some x when full_pm (getp1 m x) -> true
+ | Some x when pg = x -> true
+ | _ -> false)
+ && getp m (pg, pp) = Empty
+ ->
+ let op = other_player player in
+ let new_m = setp m (pg, pp) (match player with P1 -> X | P2 -> O) in
+ let new_s = match reduce_m (reduce_m (fun x -> x)) new_m with
+ | Empty -> TurnOf op
+ | X -> Won P1
+ | O -> Won P2
+ | T -> Tie
+ in
+ (new_s, new_m, Some pp)
+ | TurnOf x -> (Eliminated x, m, pgo)
+ | _ -> raise (Eliminated_ex "not someone's turn!")
let s (s, _, _) = s
@@ -158,9 +143,3 @@ end = struct
end
-module C = Core(Morpion_rec)
-module Main = Juge(C)
-
-let () = Main.run ()
-
-
diff --git a/judge/morpion_rec_judge.ml b/judge/morpion_rec_judge.ml
new file mode 100644
index 0000000..77308f8
--- /dev/null
+++ b/judge/morpion_rec_judge.ml
@@ -0,0 +1,6 @@
+module C = Core.Core(Morpion_rec.G)
+module Main = Main.Juge(C)
+
+let () = Main.run ()
+
+
diff --git a/judge/player.ml b/judge/player.ml
new file mode 100644
index 0000000..8f74fe7
--- /dev/null
+++ b/judge/player.ml
@@ -0,0 +1,61 @@
+open Core
+
+module type IA = sig
+
+ module G : GAME
+
+ val play : G.game -> string
+
+end
+
+module P (W : IA) : sig
+
+ val run : unit -> unit
+
+end = struct
+
+ module G = W.G
+
+ let expect mgs =
+ let l = read_line () in
+ begin try
+ let (s, f) = List.find
+ (fun (s, _) ->
+ String.length l >= String.length s
+ && String.sub l 0 (String.length s) = s)
+ mgs
+ in f (String.sub l (String.length s)
+ (String.length l - String.length s))
+ with
+ Not_found ->
+ Format.eprintf "Unexpected '%s'.@." l;
+ exit 1
+ end
+
+ let finished _ =
+ print_string "Fair enough\n"
+
+ let rec turn g _ =
+ expect [
+ "Your turn",
+ (fun _ ->
+ let act = W.play g in
+ Format.printf "Play %s@." act;
+ let g' = G.play g act in
+ expect [ "OK", turn g' ]);
+ "Play ", (fun act -> turn (G.play g act) "");
+ "Tie", finished;
+ "You win", finished;
+ "You lose", finished;
+ "Eliminated", finished
+ ]
+
+ let run () =
+ Random.self_init ();
+ expect [
+ "Hello " ^ G.id,
+ (fun _ -> Format.printf "Hello %s@." G.id;
+ turn (G.new_game) "")
+ ];
+
+end
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 17:36:12 +0000