[Toss-devel-svn] SF.net SVN: toss:[1569] trunk/Toss/Arena
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1569] trunk/Toss/Arena
|
From: <luk...@us...> - 2011-09-18 21:35:54
|
Revision: 1569
http://toss.svn.sourceforge.net/toss/?rev=1569&view=rev
Author: lukaszkaiser
Date: 2011-09-18 21:35:48 +0000 (Sun, 18 Sep 2011)
Log Message:
-----------
Move history parsing and state reconstruction. Untested for now.
Modified Paths:
--------------
trunk/Toss/Arena/Arena.ml
trunk/Toss/Arena/Arena.mli
trunk/Toss/Arena/ArenaParser.mly
Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml 2011-09-14 23:17:26 UTC (rev 1568)
+++ trunk/Toss/Arena/Arena.ml 2011-09-18 21:35:48 UTC (rev 1569)
@@ -1,4 +1,5 @@
(* Represent the game arena and operate on it. *)
+open Printf
let debug_level = ref 0
@@ -128,11 +129,12 @@
| DefPlayers of string list (* add players (fresh numbers) *)
| DefRel of string * string list * Formula.formula
(* add a defined relation *)
- | DefPattern of Formula.real_expr (* Pattern definition *)
- | StateStruc of Structure.structure (* initial/saved state *)
- | StateTime of float (* initial/saved time *)
- | StateLoc of int (* initial/saved location *)
- | StateData of (string * string) list (* saved data *)
+ | DefPattern of Formula.real_expr (* Pattern definition *)
+ | StateStruc of Structure.structure (* initial/saved state *)
+ | History of (move * float option) list (* Move history *)
+ | StateTime of float (* initial/saved time *)
+ | StateLoc of int (* initial/saved location *)
+ | StateData of (string * string) list (* saved data *)
(* We allow for missing players with a default value. *)
let array_of_players default player_names l =
@@ -169,8 +171,21 @@
array_of_players zero_loc player_names locs
-open Printf
+(* Helper: Apply a move to a game state, get the new state. *)
+let apply_move rules state (m, t) =
+ let r = List.assoc m.rule rules in
+ match ContinuousRule.rewrite_single state.struc state.time m.embedding r
+ m.mv_time m.parameters with
+ | Some (new_struc, new_time, _) ->
+ { struc = new_struc;
+ time = new_time;
+ history = (m, t) :: state.history;
+ cur_loc = m.next_loc }
+ | _ -> failwith "rule inapplicable"
+(* Make a move in a game. *)
+let make_move m (game, state) = (game, apply_move game.rules state (m, None))
+
(* Create a game state, possibly by extending an old state, from a
list of definitions (usually corresponding to a ".toss" file.) *)
let process_definition ?extend_state defs =
@@ -192,40 +207,43 @@
);
(* }}} *)
let rules, locations, players, defined_rels,
- state, time, cur_loc, patterns, data =
+ state, time, cur_loc, patterns, data, hist =
List.fold_left (fun (rules, locations, players, defined_rels,
- state, time, cur_loc, patterns, data) def ->
+ state, time, cur_loc, patterns, data, hist) def ->
match def with
| DefRule (rname, r) ->
((rname, r)::rules, locations, players, defined_rels,
- state, time, cur_loc, patterns, data)
+ state, time, cur_loc, patterns, data, hist)
| DefLoc loc ->
(rules, loc::locations, players, defined_rels,
- state, time, cur_loc, patterns, data)
+ state, time, cur_loc, patterns, data, hist)
| DefPlayers more_players ->
(rules, locations, players @ more_players, defined_rels,
- state, time, cur_loc, patterns, data)
+ state, time, cur_loc, patterns, data, hist)
| DefRel (rel, args, body) ->
(rules, locations, players,
(rel, args, body)::defined_rels,
- state, time, cur_loc, patterns, data)
+ state, time, cur_loc, patterns, data, hist)
| DefPattern pat ->
(rules, locations, players, defined_rels,
- state, time, cur_loc, pat :: patterns, data)
+ state, time, cur_loc, pat :: patterns, data, hist)
| StateStruc struc ->
(rules, locations, players, defined_rels,
- struc, time, cur_loc, patterns, data)
+ struc, time, cur_loc, patterns, data, hist)
+ | History h ->
+ (rules, locations, players, defined_rels,
+ state, time, cur_loc, patterns, data, h @ hist)
| StateTime ntime ->
(rules, locations, players, defined_rels,
- state, ntime, cur_loc, patterns, data)
+ state, ntime, cur_loc, patterns, data, hist)
| StateLoc ncur_loc ->
(rules, locations, players, defined_rels,
- state, time, ncur_loc, patterns, data)
+ state, time, ncur_loc, patterns, data, hist)
| StateData more_data ->
(rules, locations, players, defined_rels,
- state, time, cur_loc, patterns, data @ more_data)
+ state, time, cur_loc, patterns, data @ more_data, hist)
) ([], [], players, [],
- state, time, cur_loc, patterns, data) defs in
+ state, time, cur_loc, patterns, data, []) defs in
(* {{{ log entry *)
if !debug_level > 2 then (
printf "process_definition: %d new rules, %d new defined rels\n%!"
@@ -280,6 +298,7 @@
let graph = Array.of_list (List.rev locations) in
(* TODO; FIXME; JUST THIS List.rev ABOVE WILL NOT ALWAYS BE GOOD, OR?!! *)
let pats=List.rev_map (FormulaSubst.subst_rels_expr def_rels_pure) patterns in
+ let apply_moves rules mvs s = List.fold_left (apply_move rules) s mvs in
{
rules = rules;
patterns = pats;
@@ -289,7 +308,8 @@
data = data;
defined_rels = List.map (fun (a, b, c) -> (a, (b, c))) defined_rels;
starting_struc = state;
- }, {
+ },
+ apply_moves rules hist {
struc = state;
time = time;
cur_loc = cur_loc;
@@ -1071,13 +1091,3 @@
| SetModel _ -> true
| GetModel -> false
-
-(* Make a move in a game. *)
-let make_move m (game, state) =
- let req = ApplyRuleInt (m.rule, m.embedding, m.mv_time, m.parameters) in
- let (new_game, new_state), _ = handle_request (game, state) req in
- (new_game,
- { new_state with cur_loc = m.next_loc ;
- history = (m, None) :: state.history })
-
-
Modified: trunk/Toss/Arena/Arena.mli
===================================================================
--- trunk/Toss/Arena/Arena.mli 2011-09-14 23:17:26 UTC (rev 1568)
+++ trunk/Toss/Arena/Arena.mli 2011-09-18 21:35:48 UTC (rev 1569)
@@ -110,11 +110,12 @@
| DefPlayers of string list (** add players (fresh numbers) *)
| DefRel of string * string list * Formula.formula
(** add a defined relation *)
- | DefPattern of Formula.real_expr (** Pattern definition *)
- | StateStruc of Structure.structure (** initial/saved state *)
- | StateTime of float (** initial/saved time *)
- | StateLoc of int (** initial/saved location *)
- | StateData of (string * string) list (** saved data *)
+ | DefPattern of Formula.real_expr (** Pattern definition *)
+ | StateStruc of Structure.structure (** initial/saved state *)
+ | History of (move * float option) list (** Move history *)
+ | StateTime of float (** initial/saved time *)
+ | StateLoc of int (** initial/saved location *)
+ | StateData of (string * string) list (** saved data *)
exception Arena_definition_error of string
Modified: trunk/Toss/Arena/ArenaParser.mly
===================================================================
--- trunk/Toss/Arena/ArenaParser.mly 2011-09-14 23:17:26 UTC (rev 1568)
+++ trunk/Toss/Arena/ArenaParser.mly 2011-09-18 21:35:48 UTC (rev 1569)
@@ -85,6 +85,19 @@
| rel = ID args = delimited (OPEN, separated_list (COMMA, ID), CLOSE)
EQ body = formula_expr_err { (rel, args, body) }
+game_move_timed:
+ | OPENSQ RULE_SPEC? r = id_int COMMA? t = FLOAT COMMA?
+ p = separated_list (COMMA, separated_pair (ID, COLON, FLOAT))
+ RARR LOC_MOD? l = INT EMB
+ emb = separated_list (COMMA, separated_pair (INT, COLON, INT)) CLOSESQ
+ f = FLOAT?
+ { ({mv_time = t; parameters = p; rule = r; next_loc = l; embedding = emb;},
+ f) }
+ | OPENSQ error
+ { Lexer.report_parsing_error $startpos $endpos
+ "Syntax error in timed game move definition."
+ }
+
game_defs:
| RULE_SPEC rname = id_int COLON r = rule_expr
{ DefRule (rname, r) }
@@ -108,6 +121,8 @@
| MODEL_SPEC model = struct_expr WITH
defs = separated_list (SEMICOLON, rel_def_simple)
{ StateStruc (Arena.add_def_rels model defs) }
+ | MOVES moves = separated_list (SEMICOLON, game_move_timed)
+ { History (moves) }
| TIME_MOD t = FLOAT
{ StateTime t }
| STATE_SPEC LOC_MOD i = INT
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|