[Toss-devel-svn] SF.net SVN: toss:[1518] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1518] trunk/Toss
|
From: <luk...@us...> - 2011-07-26 21:50:46
|
Revision: 1518
http://toss.svn.sourceforge.net/toss/?rev=1518&view=rev
Author: lukaszkaiser
Date: 2011-07-26 21:50:38 +0000 (Tue, 26 Jul 2011)
Log Message:
-----------
Corrections towards compilation.
Modified Paths:
--------------
trunk/Toss/GGP/GDL.mli
trunk/Toss/GGP/GDLParser.mly
trunk/Toss/GGP/GDLTest.ml
trunk/Toss/GGP/TranslateFormula.ml
trunk/Toss/GGP/TranslateFormula.mli
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/GGP/TranslateGame.mli
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Server/Tests.ml
Modified: trunk/Toss/GGP/GDL.mli
===================================================================
--- trunk/Toss/GGP/GDL.mli 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/GDL.mli 2011-07-26 21:50:38 UTC (rev 1518)
@@ -77,6 +77,9 @@
negation of disjunction of given clause bodies. *)
val negate_bodies : literal list list -> literal list list
+val func_graph : string -> term list -> term array list
+
+
(** {3 GDL translation helpers.} *)
val blank : term
Modified: trunk/Toss/GGP/GDLParser.mly
===================================================================
--- trunk/Toss/GGP/GDLParser.mly 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/GDLParser.mly 2011-07-26 21:50:38 UTC (rev 1518)
@@ -28,7 +28,7 @@
| c=WORD { Const c }
| sexp=delimited (OPEN, list (term), CLOSE)
{ match sexp with
- | Const c::args -> Func (c, args)
+ | Const c::args -> Func (c, Array.of_list args)
| _ -> raise (Lexer.Parsing_error "GDL term: not a constant head")
}
| error {
@@ -37,29 +37,29 @@
atom:
| r=WORD {
- if r="TERMINAL" then Rel ("terminal", [])
- else Rel (r, []) }
+ if r="TERMINAL" then Rel ("terminal", [||])
+ else Rel (r, [||]) }
| sexp=delimited (OPEN, list (term), CLOSE)
{ match sexp with
| (Const "distinct" | Const "DISTINCT")::args ->
- Distinct args
+ Distinct (Array.of_list args)
| [(Const "true" | Const "TRUE"); arg] ->
True arg
| [(Const "does" | Const "DOES"); player; action] ->
Does (player, action)
| (Const "role" | Const "ROLE")::player ->
- Role player
+ Role (List.hd player) (* FIXME!!! *)
| (Const "init" | Const "INIT")::state ->
- Rel ("init", state)
+ Rel ("init", Array.of_list state)
| (Const "next" | Const "NEXT")::state ->
- Rel ("next", state)
+ Rel ("next", Array.of_list state)
| (Const "terminal" | Const "TERMINAL")::no_arg ->
- Rel ("terminal", no_arg)
+ Rel ("terminal", Array.of_list no_arg)
| (Const "legal" | Const "LEGAL")::args ->
- Rel ("legal", args)
+ Rel ("legal", Array.of_list args)
| (Const "goal" | Const "GOAL")::args ->
- Rel ("goal", args)
- | Const r::args -> Rel (r, args)
+ Rel ("goal", Array.of_list args)
+ | Const r::args -> Rel (r, Array.of_list args)
| _ -> raise (Lexer.Parsing_error "GDL atom: not a constant head")
}
| error {
@@ -75,7 +75,7 @@
| OPEN REVIMPL head=atom body=list (literal) CLOSE
{ match head with
| Rel rel_atom -> rel_atom, body
- | Role player -> ("role", [player]), body
+ | Role player -> ("role", [|player|]), body
| True _ ->
raise (Lexer.Parsing_error "GDL rule: \"true\" in head")
| Distinct _ ->
@@ -85,7 +85,7 @@
}
| a=atom
{ match a with
- | Role player -> ("role", [player]), []
+ | Role player -> ("role", [|player|]), []
| Rel rel_atom -> rel_atom, []
| _ ->
raise (Lexer.Parsing_error
Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/GDLTest.ml 2011-07-26 21:50:38 UTC (rev 1518)
@@ -39,15 +39,14 @@
| _, [] -> true
| [], _ -> aux players playout
| player::turn, state::playout ->
- if GDL.func_graph "control" state <> [[player]]
- then false
- else aux turn playout in
+ if GDL.func_graph "control" state <> [[|player|]] then false else
+ aux turn playout in
aux players playout
let tests = "GDL" >::: [
- "saturate" >::
+(* "saturate" >::
(fun () ->
let descr = parse_game_descr
"
@@ -76,7 +75,7 @@
"(a 1) (a 2) (a 3) (two-of-three 1 2) (two-of-three 1 3) (two-of-three 2 1) (two-of-three 2 3) (two-of-three 3 1) (two-of-three 3 2)"
(String.concat " "
(List.map GDL.fact_str res));
- );
+ );
"saturate recursive" >::
(fun () ->
@@ -103,7 +102,7 @@
"(lte 0 0) (lte 0 1) (lte 0 2) (lte 0 3) (lte 0 4) (lte 0 5) (lte 0 6) (lte 0 7) (lte 0 8) (lte 1 1) (lte 1 2) (lte 1 3) (lte 1 4) (lte 1 5) (lte 1 6) (lte 1 7) (lte 1 8) (lte 2 2) (lte 2 3) (lte 2 4) (lte 2 5) (lte 2 6) (lte 2 7) (lte 2 8) (lte 3 3) (lte 3 4) (lte 3 5) (lte 3 6) (lte 3 7) (lte 3 8) (lte 4 4) (lte 4 5) (lte 4 6) (lte 4 7) (lte 4 8) (lte 5 5) (lte 5 6) (lte 5 7) (lte 5 8) (lte 6 6) (lte 6 7) (lte 6 8) (lte 7 7) (lte 7 8) (lte 8 8) (number 0) (number 1) (number 2) (number 3) (number 4) (number 5) (number 6) (number 7) (number 8) (succ 0 1) (succ 1 2) (succ 2 3) (succ 3 4) (succ 4 5) (succ 5 6) (succ 6 7) (succ 7 8)"
(String.concat " "
(List.map GDL.fact_str res));
- );
+ ); *)
]
let exec = Aux.run_test_if_target "GDLTest" tests
Modified: trunk/Toss/GGP/TranslateFormula.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormula.ml 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/TranslateFormula.ml 2011-07-26 21:50:38 UTC (rev 1518)
@@ -64,6 +64,16 @@
term_arities : (string * int) list;
}
+let empty_transl_data = {
+ f_paths = empty_path_set;
+ m_paths = empty_path_set;
+ all_paths = empty_path_set;
+ mask_reps = [];
+ defined_rels = [];
+ defrel_arg_type = ref [];
+ term_arities = [];
+}
+
let blank_out data t =
simult_subst data.f_paths blank t
Modified: trunk/Toss/GGP/TranslateFormula.mli
===================================================================
--- trunk/Toss/GGP/TranslateFormula.mli 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/TranslateFormula.mli 2011-07-26 21:50:38 UTC (rev 1518)
@@ -13,5 +13,7 @@
term_arities : (string * int) list;
}
+val empty_transl_data : transl_data
+
val translate :
transl_data -> GDL.literal list list -> Formula.formula
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-07-26 21:50:38 UTC (rev 1518)
@@ -64,6 +64,24 @@
(* term representatives of structure elements *)
}
+let empty_gdl_translation = {
+ elem_term_map = Aux.IntMap.empty;
+ f_paths = empty_path_set;
+ m_paths = empty_path_set;
+ masks = [];
+ tossrule_data = Aux.StrMap.empty;
+ turnbased_noops = None;
+ playing_as = 0;
+ is_concurrent = false;
+ transl_data = TranslateFormula.empty_transl_data;
+ element_terms = Aux.IntMap.empty;
+}
+
+let our_turn gdl state = true
+
+let noop_move gdl state = "NOOP"
+
+
(* [most_similar c ts] finds a term from [ts] most similar to [c], and
the set of paths that merges the found term and [c]; as in the
definition of $s_\calC$ and $t_\calC$ for a clause $\calC \in
Modified: trunk/Toss/GGP/TranslateGame.mli
===================================================================
--- trunk/Toss/GGP/TranslateGame.mli 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/TranslateGame.mli 2011-07-26 21:50:38 UTC (rev 1518)
@@ -1,5 +1,5 @@
type tossrule_data = {
- lead_legal : GDL.term;
+ legal_tuple : GDL.term;
(* the "legal"/"does" term of the player that performs the move, we
call its parameters "fixed variables" as they are provided externally *)
precond : Formula.formula;
@@ -8,26 +8,25 @@
(* the elements of LHS/RHS structures, corresponding to the "next"
terms *)
struc_elems : string list;
- fixvar_elemvars :
- (string * (GDL.term * (string * string list) list) list) list;
- (* "state" terms indexed by variables that they contain, together
- with the mask-path of the variable *)
- elemvars : GDL.term Aux.StrMap.t;
-(* "state" terms indexed by Toss variable names they generate *)
+ fixvar_terms : (string * (GDL.term * GDL.path) list) list;
+ rulevar_terms : GDL.term Aux.StrMap.t;
}
(** Data to be used when translating moves. *)
-type gdl_translation = {
- (* map between structure elements and their term representations;
- the reverse direction is by using element names *)
- elem_term_map : GDL.term Aux.IntMap.t;
- f_paths : GDL.path_set;
- m_paths : GDL.path_set;
- masks : GDL.term list;
- tossrule_data : tossrule_data Aux.StrMap.t;
- (* rule name to rule translation data *)
-}
+type gdl_translation
+val empty_gdl_translation : gdl_translation
val translate_game :
GDL.clause list -> gdl_translation * (Arena.game * Arena.game_state)
+
+val translate_incoming_move :
+ gdl_translation -> (Arena.game * Arena.game_state) -> GDL.term list ->
+ string * (int * int) list
+
+val translate_outgoing_move : gdl_translation ->
+ (Arena.game * Arena.game_state) -> string -> (int * int) list -> string
+
+val noop_move : gdl_translation -> Arena.game_state -> string
+
+val our_turn : gdl_translation -> (Arena.game * Arena.game_state) -> bool
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-07-26 21:50:38 UTC (rev 1518)
@@ -39,16 +39,15 @@
| _, [] -> true
| [], _ -> aux players playout
| player::turn, state::playout ->
- if GDL.func_graph "control" state <> [[player]]
- then false
- else aux turn playout in
+ if GDL.func_graph "control" state <> [[|player|]] then false else
+ aux turn playout in
aux players playout
let game_test_case ~game_name ~player ~loc0_rule_name ~loc0_emb
~loc0_move ~loc0_noop ~loc1 ~loc1_rule_name ~loc1_emb ~loc1_noop
~loc1_move =
let game = load_rules ("./GGP/examples/"^game_name^".gdl") in
- let gdl, res = Translate.translate_game (Const player) game in
+ let gdl, res = TranslateGame.translate_game (*Const player*) game in
let goal_name =
(*if !GDL.prune_rulecands_at = GDL.Never
then game_name^"-simpl-unpruned.toss"
@@ -70,10 +69,10 @@
let emb =
Arena.emb_of_names res rname loc0_emb in
let transl =
- Translate.translate_outgoing_move gdl res rname emb in
+ TranslateGame.translate_outgoing_move gdl res rname emb in
assert_equal ~printer:(fun x->x) loc0_move transl;
let move =
- Translate.translate_incoming_move gdl res
+ TranslateGame.translate_incoming_move gdl res
[pte loc0_move; pte loc0_noop] in
assert_equal ~msg:"own incoming move" ~printer:(emb_str res)
(norm_move (rname, emb)) (norm_move move);
@@ -84,15 +83,15 @@
let emb =
Arena.emb_of_names res rname loc1_emb in
let move =
- Translate.translate_incoming_move gdl res
+ TranslateGame.translate_incoming_move gdl res
[pte loc1_noop; pte loc1_move] in
assert_equal ~msg:"opponent incoming move"
~printer:(emb_str res)
(norm_move (rname, emb)) (norm_move move)
-let tests = "Translate" >::: [
-
+let tests = "TranslateGame" >::: [
+ (*
"expand_def_rules" >::
(fun () ->
let descr = parse_game_descr
@@ -126,10 +125,10 @@
"cell_x71_y26__blank_", "cell_1_1_MV1";
"control__blank_", "control_MV1"]
~loc1_noop:"noop" ~loc1_move:"(mark 1 1)"
- );
+ ); *)
]
-let bigtests = "TranslateBig" >::: [
+let bigtests = "TranslateGameBig" >::: [
"connect5" >::
(fun () ->
@@ -186,10 +185,10 @@
let a =
- Aux.run_test_if_target "TranslateTest" tests
+ Aux.run_test_if_target "TranslateGameTest" tests
let a =
- Aux.run_test_if_target "TranslateTest" bigtests
+ Aux.run_test_if_target "TranslateGameTest" bigtests
let a () =
GDL.debug_level := 4;
@@ -205,10 +204,9 @@
| Some tests -> ignore (run_test_tt ~verbose:true tests)
| None -> ()
-let regenerate ~debug ~game_name ~player =
+(* let regenerate ~debug ~game_name ~player =
Printf.printf "Regenerating %s...\n%!" game_name;
if debug then (
- Translate.debug_level := 4;
GameSimpl.debug_level := 4;
DiscreteRule.debug_level := 4);
Translate.generate_test_case := Some game_name;
@@ -222,3 +220,4 @@
regenerate ~debug:false ~game_name:"breakthrough" ~player:"white";
(* regenerate ~debug:true ~game_name:"pawn_whopping" ~player:"x"; *)
(* regen_with_debug ~game_name:"connect4" ~player:"white" *)
+*)
Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/Server/ReqHandler.ml 2011-07-26 21:50:38 UTC (rev 1518)
@@ -17,11 +17,11 @@
Formula.real_expr array array option (** heuristic option *)
* bool (** game modified *)
* (Arena.game * Arena.game_state) (** game and state *)
- * Translate.gdl_translation (** current gdl translation *)
+ * TranslateGame.gdl_translation (** current gdl translation *)
* int (** playclock *)
let init_state =
- (None, true, Arena.empty_state, Translate.empty_gdl_translation, 0)
+ (None, true, Arena.empty_state, TranslateGame.empty_gdl_translation, 0)
(* TODO; FIXME; remove the function below. *)
@@ -83,12 +83,9 @@
Random.self_init ();
let old_force_competitive = !Heuristic.force_competitive in
Heuristic.force_competitive := true;
- let new_state, params, new_gdl_transl =
- Translate.initialize_game player game_descr startcl in
- let effort, horizon, advr =
- match params with
- | Some (e,h,r) -> Some e, Some h, Some r
- | None -> None, None, None in
+ let new_gdl_transl, new_state =
+ TranslateGame.translate_game game_descr in
+ let effort, horizon, advr = (None, None, None) in
let new_heur =
Heuristic.default_heuristic ~struc:(snd new_state).Arena.struc
?advr (fst new_state) in
@@ -101,7 +98,7 @@
let time_started = Unix.gettimeofday () in
let r_name, mtch =
- Translate.translate_last_action gdl_transl state actions in
+ TranslateGame.translate_incoming_move gdl_transl state actions in
let state =
if r_name <> "" then (
@@ -136,7 +133,7 @@
else
let mov_msg =
let time_used = time_started -. Unix.gettimeofday () in
- if Translate.our_turn gdl_transl state then (
+ if TranslateGame.our_turn gdl_transl state then (
Play.set_timeout (float(playclock) -. time_used -. 0.07);
let heur = match g_heur with
| Some h -> h
@@ -144,11 +141,11 @@
let (move, _) =
Aux.random_elem (Play.maximax_unfold_choose 5500
(fst state) (snd state) heur) in
- Translate.translate_move gdl_transl state
+ TranslateGame.translate_outgoing_move gdl_transl state
move.Move.rule move.Move.embedding
) else (
Gc.compact ();
- Translate.noop_move gdl_transl (snd state)
+ TranslateGame.noop_move gdl_transl (snd state)
) in
let msg_len = String.length mov_msg in
("HTTP/1.0 200 OK\r\nContent-type: text/acl\r\nContent-length: "
Modified: trunk/Toss/Server/Tests.ml
===================================================================
--- trunk/Toss/Server/Tests.ml 2011-07-26 19:50:54 UTC (rev 1517)
+++ trunk/Toss/Server/Tests.ml 2011-07-26 21:50:38 UTC (rev 1518)
@@ -32,9 +32,9 @@
]
let ggp_tests = "GGP", [
- "GameSimplTest", [GameSimplTest.tests];
- "GDLTest", [GDLTest.tests];
- "TranslateTest", [TranslateTest.tests; TranslateTest.bigtests];
+ "GameSimplTest", [GameSimplTest.tests];
+ "GDLTest", [GDLTest.tests];
+ "TranslateGameTest", [TranslateGameTest.tests; TranslateGameTest.bigtests];
]
let server_tests = "Server", [
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
