[Toss-devel-svn] SF.net SVN: toss:[1326] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
|
From: <luk...@us...> - 2011-02-23 01:53:50
|
Revision: 1326
http://toss.svn.sourceforge.net/toss/?rev=1326&view=rev
Author: lukaszkaiser
Date: 2011-02-23 01:53:43 +0000 (Wed, 23 Feb 2011)
Log Message:
-----------
Remove Game.game_state (= Arena.game_state now), add Move.make_move and haev fun with GameTree.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Play/Game.ml
trunk/Toss/Play/Game.mli
trunk/Toss/Play/GameTree.ml
trunk/Toss/Play/GameTree.mli
trunk/Toss/Play/GameTreeTest.ml
trunk/Toss/Play/Move.ml
trunk/Toss/Play/Move.mli
trunk/Toss/Server/Server.ml
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Formula/Aux.ml 2011-02-23 01:53:43 UTC (rev 1326)
@@ -47,7 +47,8 @@
(* {2 Helper functions on lists and other functions lacking from the
standard library.} *)
-let random_elem l = List.nth l (Random.int (List.length l))
+let random_elem l =
+ if l = [] then raise Not_found else List.nth l (Random.int (List.length l))
let concat_map f l =
let rec cmap_f accu = function
Modified: trunk/Toss/Play/Game.ml
===================================================================
--- trunk/Toss/Play/Game.ml 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Play/Game.ml 2011-02-23 01:53:43 UTC (rev 1326)
@@ -63,21 +63,9 @@
Array.map (fun payoff ->
(0.5 +. 1./.((float_of_int n) +. 2.)) *. payoff) payoffs
-(* Analogous to {!Arena.game_state}, but without the game component. *)
-type game_state = {
- struc : Structure.structure ; (* structure state *)
- time : float ; (* current time in game *)
- loc : int ; (* positin in the game graph *)
-}
-let gen_models rules models time moves =
- let (mv, a) = Move.gen_models rules models time moves in
- (mv, Array.map (fun s -> {struc=s.Arena.struc;
- time=s.Arena.time; loc=s.Arena.cur_loc}) a)
-
-
type uctree_node = {
- node_state : game_state ;
+ node_state : Arena.game_state ;
node_stats : score ; (* playout statistic *)
node_heuristic : f_table ; (* heuristic table *)
node_bestheur : int ; (* the subtree from which
@@ -93,12 +81,12 @@
result in the same array of moves). *)
and uctree =
| Node of uctree_node
- | Leaf of game_state * score * f_table * Structure.structure
+ | Leaf of Arena.game_state * score * f_table * Structure.structure
(* once played leaf: state, time, location, score, heuristic, game-end *)
- | Tip of game_state * f_table
+ | Tip of Arena.game_state * f_table
(* unplayed leaf, with heuristic value (evaluation game
result) *)
- | Terminal of game_state * score * f_table * f_table
+ | Terminal of Arena.game_state * score * f_table * f_table
(* the score, the cache of the actual payoff table and the
heuristic *)
| TEmpty (* to be expanded in any context *)
@@ -190,7 +178,7 @@
(* The evolving state of a play. *)
type play_state = {
- game_state : game_state ;
+ game_state : Arena.game_state ;
memory : memory array ; (* player-specific history *)
}
@@ -292,17 +280,17 @@
| TEmpty -> 0
let uctree_location = function
- | Node node -> node.node_state.loc
- | Leaf (s,_,_,_) -> s.loc
- | Tip (s,_) -> s.loc
- | Terminal (s,_,_,_) -> s.loc
+ | Node node -> node.node_state.Arena.cur_loc
+ | Leaf (s,_,_,_) -> s.Arena.cur_loc
+ | Tip (s,_) -> s.Arena.cur_loc
+ | Terminal (s,_,_,_) -> s.Arena.cur_loc
| _ -> failwith "uctree_location: empty tree"
let uctree_model = function
- | Node node -> node.node_state.struc
- | Leaf (m,_,_,_) -> m.struc
- | Tip (m,_) -> m.struc
- | Terminal (m,_,_,_) -> m.struc
+ | Node node -> node.node_state.Arena.struc
+ | Leaf (m,_,_,_) -> m.Arena.struc
+ | Tip (m,_) -> m.Arena.struc
+ | Terminal (m,_,_,_) -> m.Arena.struc
| _ -> failwith "uctree_model: empty tree"
let uctree_state = function
@@ -333,7 +321,7 @@
| Node node -> node.node_endstate
| Leaf (_,_,_,r) -> r
| Tip _ -> failwith "uctree_endgame: Tip"
- | Terminal (r,_,_,_) -> r.struc
+ | Terminal (r,_,_,_) -> r.Arena.struc
| TEmpty -> failwith "uctree_endgame: TEmpty"
@@ -410,14 +398,14 @@
let player_memory = Array.map
(function Tree_search _ -> UCTree TEmpty | _ -> No_memory) agents in
{
- game_state = {loc = loc; time = 0.0; struc = model};
+ game_state = {Arena.cur_loc = loc; time = 0.0; struc = model};
memory = player_memory;
}
(* TODO: [num_players] not used (remove if not needed). *)
let update_memory_single num_players state pos = function
| No_memory -> No_memory
- | State_history history -> State_history (state.struc::history)
+ | State_history history -> State_history (state.Arena.struc::history)
| UCTree (Node node) ->
UCTree node.node_subtrees.(pos)
| UCTree _ -> UCTree TEmpty
@@ -518,7 +506,7 @@
Solver.M.get_real_val expr model) subloc.Arena.payoffs_pp
else
let state =
- {game_state={loc=evgame.ev_location; struc=model; time=time};
+ {game_state={Arena.cur_loc=evgame.ev_location; struc=model; time=time};
memory=evgame.ev_memory} in
let subplay =
{game=evgame.ev_game; agents=evgame.ev_agents; delta=evgame.ev_delta} in
@@ -530,7 +518,7 @@
(* Generate evgame scores for possible moves. *)
and gen_scores grid_size subgames moves models loc =
Array.mapi (fun pos mv ->
- let {struc=model; time=time} = models.(pos) in
+ let {Arena.struc=model; time=time} = models.(pos) in
play_evgame grid_size model time subgames.(mv.Move.next_loc)
) moves
@@ -548,16 +536,16 @@
defined_rels=defined_rels};
agents=agents; delta=delta} as play_def)
{game_state=state; memory=memory} =
- let loc = graph.(state.loc) in
+ let loc = graph.(state.Arena.cur_loc) in
let moves =
if just_payoffs then [| |]
- else Move.gen_moves grid_size rules state.struc loc in
+ else Move.gen_moves grid_size rules state.Arena.struc loc in
(* Don't forget to check after generating models as well --
postconditions! *)
if moves = [| |] then
let payoff =
Array.map (fun expr ->
- Solver.M.get_real_val expr state.struc)
+ Solver.M.get_real_val expr state.Arena.struc)
loc.Arena.payoffs_pp in
Aux.Right payoff
else
@@ -578,8 +566,8 @@
Aux.map_option
(fun (model, time, _) ->
(* ignoring shifts, i.e. animation steps *)
- {loc=mv.Move.next_loc; struc=model; time=time})
- (ContinuousRule.rewrite_single state.struc state.time
+ {Arena.cur_loc=mv.Move.next_loc; struc=model; time=time})
+ (ContinuousRule.rewrite_single state.Arena.struc state.Arena.time
mv.Move.embedding rule mv.Move.mv_time mv.Move.parameters);
incr pos
done;
@@ -587,7 +575,7 @@
| None ->
let payoff =
Array.map (fun expr ->
- Solver.M.get_real_val expr state.struc)
+ Solver.M.get_real_val expr state.Arena.struc)
loc.Arena.payoffs_pp in
Aux.Right payoff
| Some state ->
@@ -615,7 +603,7 @@
calls, with optional alpha-beta pruning *)
(* [betas] are used imperatively *)
let rec maximax_tree pre_heur prev_player betas depth
- {loc=loc; struc=model; time=time} =
+ {Arena.cur_loc = loc; struc=model; time=time} =
(* {{{ log entry *)
incr nodes_count;
size_count := !size_count + Array.length moves;
@@ -669,7 +657,7 @@
else if !timeout then
Array.map (fun _ -> 0.) graph.(loc).Arena.payoffs
else
- let moves, models = gen_models rules model time moves in
+ let moves, models = Move.gen_models rules model time moves in
let n = Array.length models in
if !timeout then
Array.map (fun _ -> 0.) graph.(loc).Arena.payoffs
@@ -750,11 +738,12 @@
aux alphas 0 in
let betas = Array.make num_players infinity in
let player = loc.Arena.player in
- let moves, models = gen_models rules state.struc state.time moves in
+ let moves, models =
+ Move.gen_models rules state.Arena.struc state.Arena.time moves in
if models = [| |] then
let payoff =
Array.map (fun expr ->
- Solver.M.get_real_val expr state.struc)
+ Solver.M.get_real_val expr state.Arena.struc)
loc.Arena.payoffs_pp in
Aux.Right payoff
else
@@ -795,7 +784,7 @@
!cur_depth;
Array.iteri (fun i score ->
Printf.printf "Structure:%s -- score %F\n"
- (Structure.str models.(i).struc) score.(player)) scores
+ (Structure.str models.(i).Arena.struc) score.(player)) scores
);
(* }}} *)
done;
@@ -811,7 +800,7 @@
if !debug_level > 1 && (depth > 1 || !debug_level > 3)
then
Printf.printf "moving to state\n%s\n%!"
- (Structure.str state.struc);
+ (Structure.str state.Arena.struc);
(* }}} *)
Aux.Left
(best, moves, memory,
@@ -879,7 +868,7 @@
(* {{{ log entry *)
if !debug_level > 1 then
Printf.printf "moving to state\n%s\n%!"
- (Structure.str state.struc);
+ (Structure.str state.Arena.struc);
(* }}} *)
memory.(loc.Arena.player) <- (UCTree (Node node));
Aux.Left
@@ -896,16 +885,17 @@
(* {{{ log entry *)
if !debug_level > 3 then printf "toss: external\n";
(* }}} *)
- let moves, models = gen_models rules state.struc state.time moves in
+ let moves, models =
+ Move.gen_models rules state.Arena.struc state.Arena.time moves in
if models = [| |] then
let payoff =
Array.map (fun expr ->
- Solver.M.get_real_val expr state.struc)
+ Solver.M.get_real_val expr state.Arena.struc)
loc.Arena.payoffs_pp in
Aux.Right payoff
else
let descriptions =
- Array.map (fun m -> Structure.str m.struc) models in
+ Array.map (fun m -> Structure.str m.Arena.struc) models in
let best = callback descriptions in
let state = models.(best) in
Aux.Left
@@ -939,7 +929,8 @@
| Aux.Left (_,_,_,state) ->
(* {{{ log entry *)
if !debug_level > 5 || (!debug_level > 0 && set_timer <> None) then
- printf "step-state:\n%s\n%!" (Structure.str state.game_state.struc);
+ printf "step-state:\n%s\n%!"
+ (Structure.str state.game_state.Arena.struc);
(* }}} *)
play ~grid_size ?set_timer ?horizon ~plys:(plys+1) play_def state
| Aux.Right payoff ->
@@ -948,7 +939,7 @@
printf "payoff-state:\n%a\n%!"
(Aux.array_fprint (fun f pv->fprintf f "%F" pv)) payoff;
(* }}} *)
- state.game_state.struc, discount plys payoff
+ state.game_state.Arena.struc, discount plys payoff
(* Walk up the tree selecting the optimal estimates route, and update
@@ -966,7 +957,7 @@
node_heuristic=heuristic; node_bestheur=old_bestheur;
node_endstate=endmodel; node_subtrees=subtrees
} ->
- let player = graph.(game_state.loc).Arena.player in
+ let player = graph.(game_state.Arena.cur_loc).Arena.player in
(* compute UCBs and update the best subtree *)
let ucb_scores = Array.map (fun subtree ->
let heuristic = uctree_heuristic subtree in
@@ -1006,13 +997,13 @@
}
| Leaf (game_state, score, heuristic, endmodel) ->
- let player = graph.(game_state.loc).Arena.player in
+ let player = graph.(game_state.Arena.cur_loc).Arena.player in
expand_uctree grid_size play_def game_state ~score subgames
evgame_horizon params.heur_effect heuristic params.horizon
params.cooperative player
| Tip (game_state, heuristic) ->
- let player = graph.(game_state.loc).Arena.player in
+ let player = graph.(game_state.Arena.cur_loc).Arena.player in
expand_uctree grid_size play_def game_state subgames evgame_horizon
params.heur_effect heuristic params.horizon params.cooperative
player
@@ -1039,22 +1030,23 @@
delta=delta} as play_def)
state ?score subgames evgame_horizon heur_effect heuristic
horizon cooperative player =
- let location = graph.(state.loc) in
- let moves = Move.gen_moves grid_size rules state.struc location in
+ let location = graph.(state.Arena.cur_loc) in
+ let moves = Move.gen_moves grid_size rules state.Arena.struc location in
if moves = [| |] then
let payoff =
Array.map (fun expr ->
- Solver.M.get_real_val expr state.struc)
+ Solver.M.get_real_val expr state.Arena.struc)
location.Arena.payoffs_pp in
let upscore = score_payoff payoff in
upscore, Terminal (state, upscore, heuristic, payoff)
else
- let moves, models = gen_models rules state.struc state.time moves in
+ let moves, models =
+ Move.gen_models rules state.Arena.struc state.Arena.time moves in
if models = [| |] then
let payoff =
Array.map (fun expr ->
- Solver.M.get_real_val expr state.struc)
+ Solver.M.get_real_val expr state.Arena.struc)
location.Arena.payoffs_pp in
let upscore = score_payoff payoff in
upscore, Terminal (state, upscore, heuristic, payoff)
@@ -1085,11 +1077,11 @@
| None -> upscore
| Some score -> add_score score upscore in
subtrees.(best) <-
- Leaf (next_state, upscore, heuristics.(best), next_state.struc);
+ Leaf (next_state, upscore, heuristics.(best), next_state.Arena.struc);
(upscore,
Node {
node_state=next_state; node_stats=score;
- node_heuristic=heuristic; node_endstate=next_state.struc;
+ node_heuristic=heuristic; node_endstate=next_state.Arena.struc;
node_subtrees=subtrees; node_bestheur=bestheur;
})
else
Modified: trunk/Toss/Play/Game.mli
===================================================================
--- trunk/Toss/Play/Game.mli 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Play/Game.mli 2011-02-23 01:53:43 UTC (rev 1326)
@@ -85,16 +85,9 @@
structures and return the position of the desired state; for
interacting with external players only *)
-(** Analogous to {!Arena.game_state}. *)
-type game_state = {
- struc : Structure.structure ; (** structure state *)
- time : float ; (** current time in game *)
- loc : int ; (** positin in the game graph *)
-}
-
(** The evolving state of a play. *)
type play_state = {
- game_state : game_state ;
+ game_state : Arena.game_state ;
memory : memory array ; (** player-specific history *)
}
@@ -134,7 +127,7 @@
(** Update "memory" assuming that the position given corresponds to a
move selected, as generated by {!gen_moves}. With tree search,
selects the corresponding subtree of a tree. *)
-val update_memory : num_players:int -> game_state -> int ->
+val update_memory : num_players:int -> Arena.game_state -> int ->
memory array -> memory array
(** Make a move in a play, or compute the payoff table when the game
Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Play/GameTree.ml 2011-02-23 01:53:43 UTC (rev 1326)
@@ -1,5 +1,6 @@
(* Game Tree used for choosing moves. *)
+let debug_level = ref 0
(* Abstract game tree, just stores state and move information. *)
type ('a, 'b) abstract_game_tree =
@@ -55,7 +56,7 @@
(* Abstract game tree unfolding function, calls argument functions for work. *)
let rec unfold_abstract ?(depth=0) game
~info_terminal ~info_leaf ~info_node ~choice = function
- | Terminal _ as t -> t
+ | Terminal _ -> raise Not_found
| Leaf (state, player, info) ->
let moves = Move.list_moves game state in
if moves = [||] then
@@ -116,7 +117,6 @@
| Node (_, _, i, _) -> i.info
-
(* Game tree initialization. *)
let info_leaf_f f heurs depth game state player =
let calc re =
@@ -156,31 +156,44 @@
~info_node:(info_node_f info_node)
~choice:choice
+(* Choose one of the maximizing moves (at random) given a game tree. *)
+let choose_move game = function
+ | Terminal _ -> raise Not_found
+ | Leaf (state, _, _) ->
+ fst (Aux.random_elem (Array.to_list (Move.list_moves game state)))
+ | Node (_, p, info, succ) ->
+ let mval = info.heurs.(p) in
+ let max = Aux.array_find_all (fun (_,c) -> (node_values c).(p)=mval) succ in
+ let (m, _) = Aux.random_elem max in m
+
(* ------------ MAXIMAX BY DEPTH ------------- *)
-let depth_ready_leaf maxdp dp g s = dp >= maxdp
-let depth_ready_node maxdp dp player heurs children =
- let mval child = (node_values (snd child)).(player) in
- let maxval = heurs.(player) in
- Aux.array_existsi (fun _ c -> mval c = maxval && node_info (snd c)) children
+let maxdepth_node dp player heurs children =
+ let depths = Array.map (fun child -> (node_info (snd child))) children in
+ (Array.fold_left (fun m d -> max m d) 0 depths) + 1
-let depth_maximax_choice maxdp dp game state player info children =
- let mval child = (node_values (snd child)).(player) in
- let (max_val, unready) = (info.heurs.(player), ref []) in
- Array.iteri (fun i c -> if not (node_info (snd c)) then
- unready:= i::!unready) children; (* TODO: reordering, alpha-beta *)
- if !unready = [] then raise Not_found else List.hd !unready
+let maximax_depth_choice dp game cur_state player info children =
+ let mval child = (node_values (snd child)).(player), node_info (snd child) in
+ let cmp c1 c2 =
+ let (v1, d1), (v2, d2) = mval c1, mval c2 in
+ if d1 > 4*(d2+1) then -1 else if d2 > 4*(d1+1) then 1 else
+ if v1 > v2 then 1 else if v2 > v1 then -1 else d1 - d2 in
+ let res = Aux.random_elem (Aux.array_argfind_all_max cmp children) in
+ if !debug_level > 0 then
+ print_endline (Structure.str (state (snd children.(res))).Arena.struc);
+ res
(* Maximax by depth unfolding function. Throws Not_found if ready. *)
-let unfold_maximax_depth dp game heur =
- unfold game heur ~info_leaf:(depth_ready_leaf dp)
- ~info_node:(depth_ready_node dp) ~choice:(depth_maximax_choice dp)
+let unfold_maximax game heur =
+ unfold game heur ~info_leaf:(fun _ _ _ -> 0)
+ ~info_node:(maxdepth_node) ~choice:(maximax_depth_choice)
(* Maximax unfolding upto depth. *)
-let rec unfold_maximax_upto dp game heur t =
- try
- let u = unfold_maximax_depth dp game heur t in
- unfold_maximax_upto dp game heur u
- with Not_found -> t
+let rec unfold_maximax_upto count game heur t =
+ if count = 0 then t else
+ try
+ let u = unfold_maximax game heur t in
+ unfold_maximax_upto (count-1) game heur u
+ with Not_found -> t
Modified: trunk/Toss/Play/GameTree.mli
===================================================================
--- trunk/Toss/Play/GameTree.mli 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Play/GameTree.mli 2011-02-23 01:53:43 UTC (rev 1326)
@@ -68,6 +68,10 @@
val node_info : 'a game_tree -> 'a
+(** Choose one of the maximizing moves (at random) given a game tree. *)
+val choose_move : Arena.game -> 'a game_tree -> Move.move
+
+
(** Game tree initialization. *)
val init : Arena.game -> Arena.game_state ->
(int -> Arena.game -> Arena.game_state -> 'a) ->
@@ -86,10 +90,10 @@
(** ------------ MAXIMAX BY DEPTH ------------- *)
(** Maximax by depth unfolding function. Throws Not_found if ready. *)
-val unfold_maximax_depth : int -> Arena.game ->
- Formula.real_expr array array -> bool game_tree -> bool game_tree
+val unfold_maximax : Arena.game ->
+ Formula.real_expr array array -> int game_tree -> int game_tree
(** Maximax unfolding upto depth. *)
val unfold_maximax_upto : int -> Arena.game ->
- Formula.real_expr array array -> bool game_tree -> bool game_tree
+ Formula.real_expr array array -> int game_tree -> int game_tree
Modified: trunk/Toss/Play/GameTreeTest.ml
===================================================================
--- trunk/Toss/Play/GameTreeTest.ml 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Play/GameTreeTest.ml 2011-02-23 01:53:43 UTC (rev 1326)
@@ -60,21 +60,20 @@
(fun () ->
let (g, s) = state_of_file "./examples/Tic-Tac-Toe.toss" in
let h = Heuristic.default_heuristic ~struc:s.Arena.struc ~advr:4. g in
- let t = GameTree.init g s (fun _ _ _ -> false) h in
- let u = GameTree.unfold_maximax_depth 1 g h t in
- (* print_endline (GameTree.str string_of_bool u); *)
- assert_equal ~printer:(fun x -> string_of_bool x) true
- (GameTree.node_info u)
+ let t = GameTree.init g s (fun _ _ _ -> 0) h in
+ let u = GameTree.unfold_maximax g h t in
+ (* print_endline (GameTree.str string_of_int u); *)
+ assert_equal ~printer:(fun x -> string_of_int x) 1 (GameTree.node_info u)
);
"maximax unfold upto depth, size" >::
(fun () ->
let (g, s) = state_of_file "./examples/Tic-Tac-Toe.toss" in
let h = Heuristic.default_heuristic ~struc:s.Arena.struc ~advr:4. g in
- let t = GameTree.init g s (fun _ _ _ -> false) h in
- let u = GameTree.unfold_maximax_upto 2 g h t in
- (* print_endline (GameTree.str string_of_bool u); *)
- assert_equal ~printer:(fun x -> string_of_int x) 82 (GameTree.size u)
+ let t = GameTree.init g s (fun _ _ _ -> 0) h in
+ let u = GameTree.unfold_maximax_upto 50 g h t in
+ (* print_endline (GameTree.str string_of_int u); *)
+ assert_equal ~printer:(fun x -> string_of_int x) 250 (GameTree.size u)
);
]
Modified: trunk/Toss/Play/Move.ml
===================================================================
--- trunk/Toss/Play/Move.ml 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Play/Move.ml 2011-02-23 01:53:43 UTC (rev 1326)
@@ -14,7 +14,13 @@
embedding : (int * int) list ;
}
+(* Make a move in a game. *)
+let make_move m (game, state) =
+ let req = Arena.ApplyRuleInt (m.rule, m.embedding, m.mv_time, m.parameters) in
+ let (new_game, new_state), _ = Arena.handle_request (game, state) req in
+ (new_game, { new_state with Arena.cur_loc = m.next_loc })
+
(* Print a move as string.
TODO: perhaps find a nicer syntax? See {!TestGame.move_str}. *)
let move_str rules struc move =
Modified: trunk/Toss/Play/Move.mli
===================================================================
--- trunk/Toss/Play/Move.mli 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Play/Move.mli 2011-02-23 01:53:43 UTC (rev 1326)
@@ -17,7 +17,11 @@
val move_gs_str_short : Arena.game_state -> move -> string
+(** Make a move in a game. *)
+val make_move : move ->
+ Arena.game * Arena.game_state -> Arena.game * Arena.game_state
+
(** Default number of sample points per parameter in tree search.
TODO: fixed for now. *)
val cGRID_SIZE : int
Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml 2011-02-22 03:24:44 UTC (rev 1325)
+++ trunk/Toss/Server/Server.ml 2011-02-23 01:53:43 UTC (rev 1326)
@@ -245,17 +245,17 @@
| Some play, Some {Game.memory=memory; game_state=pstate} ->
Game.update_memory
~num_players:play.Game.game.Arena.num_players
- {Game.struc=old_struc;
+ {Arena.struc=old_struc;
time = (snd !state).Arena.time;
- loc = (snd !state).Arena.cur_loc} pos memory
+ cur_loc = (snd !state).Arena.cur_loc} pos memory
| _ -> failwith "req_handle: impossible" in
(* Rewriting doesn't handle location update. *)
let new_loc = moves.(pos).Move.next_loc in
state := (fst new_state,
{snd new_state with Arena.cur_loc = new_loc});
let new_game_state = {
- Game.struc = (snd new_state).Arena.struc;
- loc = moves.(pos).Move.next_loc;
+ Arena.struc = (snd new_state).Arena.struc;
+ cur_loc = moves.(pos).Move.next_loc;
time = (snd new_state).Arena.time;
} in
play_state := Some {
@@ -341,17 +341,17 @@
| Some play, Some {Game.memory=memory; game_state=pstate} ->
Game.update_memory
~num_players:play.Game.game.Arena.num_players
- {Game.struc=old_struc;
+ {Arena.struc=old_struc;
time = (snd !state).Arena.time;
- loc = (snd !state).Arena.cur_loc} pos memory
+ cur_loc = (snd !state).Arena.cur_loc} pos memory
| _ -> failwith "req_handle: impossible" in
(* Rewriting doesn't handle location update. *)
let new_loc = moves.(pos).Move.next_loc in
state := (fst new_state,
{snd new_state with Arena.cur_loc = new_loc});
let new_game_state = {
- Game.struc = (snd new_state).Arena.struc;
- loc = moves.(pos).Move.next_loc;
+ Arena.struc = (snd new_state).Arena.struc;
+ cur_loc = moves.(pos).Move.next_loc;
time = (snd new_state).Arena.time;
} in
play_state := Some {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|