[Toss-devel-svn] SF.net SVN: toss:[1518] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
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. |