Start work on players!

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