Correct monstruous error.

3 files changed, 0 insertions, 251 deletions

diff --git a/juge/_tags b/juge/_tags
deleted file mode 100644
index eb13bea..0000000
--- a/juge/_tags
+++ /dev/null
@@ -1 +0,0 @@
-true: use_unix
diff --git a/juge/core.ml b/juge/core.ml
deleted file mode 100644
index e7c44e8..0000000
--- a/juge/core.ml
+++ /dev/null
@@ -1,209 +0,0 @@
-open Unix
-
-open Protocol
-
-(* Description of data structures *)
-
-type player = P1 | P2
-
-type game_status =
-	| TurnOf of player
-	| Won of player
-	| Tie
-	| Eliminated of player
-
-type game_proc_status =
-	| Initializing of game_status
-	| Running of game_status
-	| Finished of game_status
-
-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
-
-module type GAME = sig
-	type game		(* mutable structure *)
-
-	val name : string	(* ex: Morpion récursif *)
-	val id : string		(* ex: morpion_rec *)
-
-	val new_game : unit -> (game * game_status)
-
-	val turn : game -> player -> string -> game_status
-end
-
-module type CORE = sig
-	module G : GAME
-
-	type game
-	val p1 : game -> player_proc_status
-	val p2 : game -> player_proc_status
-	val s : game -> game_proc_status
-	val g : game -> G.game
-
-	val init : unit -> unit
-
-	val handle_events : unit -> unit   (* is anything happening ? *)
-
-	val add_rounds : unit -> unit      (* adds one game of everyone against everyone *)
-
-	val scores : unit -> (string * int) list
-	val games : unit -> game list
-
-end
-
-(* ****************************************** *)
-(*           BEGIN IMPLEMENTATION             *)
-(* ****************************************** *)
-
-module C (G: GAME) : CORE = struct
-	module G : GAME = G
-
-	type player = {
-		name: string;
-		binary: string;
-		mutable score: int;
-	}
-
-	type 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 = {
-		g: G.game;
-		p1: player_proc;
-		p2: player_proc;
-		mutable s: game_proc_status;
-	}
-	let p1 g = g.p1.s
-	let p2 g = g.p2.s
-	let s g = g.s
-	let g g = g.g
-
-	let players = Hashtbl.create 12
-	let planned_games = Queue.create ()
-	let r_games = ref []
-
-	(* 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 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.";
-			"-t", Arg.Set_float game_time,
-				"Time (seconds) allotted to each player for a game."
-
-		] in
-		Arg.parse args (fun s -> game_dir := s)
-			"Usage: juge <game_directory>";
-		if !game_dir = "" then begin
-			Format.eprintf "Error: no game directory specified.@.";
-			exit 1
-		end;
-		let date =
-			let d = Unix.gmtime (Unix.time ()) in
-			Format.sprintf "%04d%02d%02d%02d%02d" d.tm_year d.tm_mon 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
-				try
-					let b = Filename.concat (Filename.concat !game_dir s) "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;
-						Hashtbl.add players	s
-							{ name = s;
-								binary = b;
-								score = 0; }
-					end
-				with _ -> ();	
-				rd()
-			with End_of_file -> ()
-		in rd ()
-
-	let add_rounds () =
-		Hashtbl.iter
-			(fun p _ -> Hashtbl.iter
-				(fun q _ -> if p <> q then Queue.push (p, q) planned_games)
-				players)
-			players
-
-	let handle_events () =
-		(* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
-		while (List.length
-				(List.filter (fun g -> match g.s with Finished _ -> false | _ -> true)
-					!r_games)) < !par_games
-			&& Queue.length planned_games > 0
-		do
-			let p1, p2 = Queue.pop planned_games in
-			Format.printf "Launching match: %s vs. %s@." p1 p2;
-
-			let open_c p =
-				let (j2p_i, j2p_o) = pipe () in
-				let (p2j_i, p2j_o) = pipe () in
-				let pid = fork() in
-				if pid = 0 then begin
-					dup2 j2p_i stdin;
-					dup2 p2j_o stdout;
-					execv 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
-				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, s = G.new_game () in
-			let g = { p1; p2; g; s = Initializing s } in
-			r_games := g::(!r_games)
-		done;
-
-		(* 2. LOOK IF ANYBODY IS TELLING US SOMETHING - IF SO, REACT
-					(wait max. 0.01 sec) *)
-		()
-	
-end
diff --git a/juge/protocol.ml b/juge/protocol.ml
deleted file mode 100644
index 3f6d548..0000000
--- a/juge/protocol.ml
+++ /dev/null
@@ -1,41 +0,0 @@
-
-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
-
-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)
-
-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"
-
-