[Toss-devel-svn] SF.net SVN: toss:[1262] trunk/Toss

[<luk...@us...>]

Revision: 1262
          http://toss.svn.sourceforge.net/toss/?rev=1262&view=rev
Author:   lukstafi
Date:     2010-12-19 20:42:04 +0000 (Sun, 19 Dec 2010)

Log Message:
-----------
Arena definition parsing bug fix. GDL parsing bug fix. Board elements <-> coordinates helpers. GDL test example: in progress.

Modified Paths:
--------------
    trunk/Toss/Arena/Arena.ml
    trunk/Toss/Play/GDL.ml
    trunk/Toss/Play/GDL.mli
    trunk/Toss/Play/GDLParser.mly
    trunk/Toss/Play/GameTest.ml
    trunk/Toss/Play/Server.ml
    trunk/Toss/Play/ServerGDLTest.in
    trunk/Toss/Play/ServerGDLTest.out
    trunk/Toss/Solver/Structure.ml
    trunk/Toss/Solver/Structure.mli

Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Arena/Arena.ml	2010-12-19 20:42:04 UTC (rev 1262)
@@ -154,7 +154,7 @@
 (* 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 =
-  let (old_rules, old_locs, players, defined_rels,
+  let (old_rules, old_locs, players, old_defined_rels,
        state, time, cur_loc, data) =
     match extend_state with
       | None ->
@@ -173,13 +173,10 @@
       (List.length old_rules) (List.length old_locs);
   );
   (* }}} *)
-  let rev_models_at_end l =
-    let m, n = List.partition (function StateStruc _ -> true | _ -> false) l in
-    n @ (List.rev m) in
   let rules, locations, players, defined_rels,
     state, time, cur_loc, data =
-    List.fold_right (fun def (rules, locations, players, defined_rels,
-                              state, time, cur_loc, data) ->
+    List.fold_left (fun (rules, locations, players, defined_rels,
+                         state, time, cur_loc, data) def ->
       match def with
         | DefRule (rname, r) ->
           ((rname, r)::rules, locations, players, defined_rels,
@@ -206,14 +203,15 @@
         | StateData more_data ->
           (rules, locations, players, defined_rels,
            state, time, cur_loc, data @ more_data)
-    ) (rev_models_at_end defs) ([], [], players, defined_rels,
-            state, time, cur_loc, data) in
+    ) ([], [], players, [],
+       state, time, cur_loc, data) defs in
   (* {{{ log entry *)
   if !debug_level > 2 then (
-    printf "process_definition: %d new rules, %d defined rels\n%!"
+    printf "process_definition: %d new rules, %d new defined rels\n%!"
       (List.length rules) (List.length defined_rels);
   );
   (* }}} *)
+  let defined_rels = old_defined_rels @ List.rev defined_rels in
   let def_rels_pure =
     List.map (fun (rel, args, body) -> (rel, (args, body))) defined_rels in
   let defined_rels =

Modified: trunk/Toss/Play/GDL.ml
===================================================================
--- trunk/Toss/Play/GDL.ml	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Play/GDL.ml	2010-12-19 20:42:04 UTC (rev 1262)
@@ -44,8 +44,22 @@
 
 let client_player = ref (Const "uninitialized")
 let game_description = ref []
+let game_state = ref (ref Arena.empty_state)
 
-let initialize_game player game_descr startcl =
+let state_of_file s =
+  Printf.printf "GDL: Loading file %s...\n%!" s;
+  let f = open_in s in
+  let res =
+    ArenaParser.parse_game_state Lexer.lex
+      (Lexing.from_channel f) in
+  Printf.printf "GDL: File %s loaded.\n%!" s;
+  res
+
+let initialize_game state player game_descr startcl =
+  game_state := state;
+
+  state := state_of_file "./examples/Tic-Tac-Toe.toss";
+
   client_player := player;
   game_description := game_descr;
   let effort, horizon, heur_adv_ratio =
@@ -53,7 +67,20 @@
   effort, horizon, heur_adv_ratio
   
 let translate_last_action actions =
-  "1", ["1","1"]
+  if actions = [] then
+    (* start of game -- Server will handle this answer as NOOP *)
+    "", []
+  else
+    (* FIXME: really translate *)
+    "Cross", ["a1","a1"]
 
-let translate_move move new_state =
-  "NOOP"
+let translate_move rule emb new_state =
+  let struc = new_state.Arena.struc in
+  let elem = snd (List.hd emb) in
+  let c, r =
+    Structure.board_elem_coords (Structure.elem_str struc elem) in
+  let mark = Printf.sprintf "(MARK %d %d)" c r in
+  match rule with
+    | "Cross" -> "(" ^ mark ^ " NOOP)"
+    | "Circle" -> "(NOOP " ^ mark ^ ")"
+    | _ -> assert false

Modified: trunk/Toss/Play/GDL.mli
===================================================================
--- trunk/Toss/Play/GDL.mli	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Play/GDL.mli	2010-12-19 20:42:04 UTC (rev 1262)
@@ -41,11 +41,11 @@
   game_descr_entry list -> game_description
 
 val initialize_game :
-  term -> game_description -> int -> int * int * float
+  Arena.game_state ref -> term -> game_description -> int -> int * int * float
 
 val translate_last_action :
   term list -> string * (string * string) list
 
-(* FIXME: remove dependency on Game? *)
+(* Rule name, embedding, game state. *)
 val translate_move :
-  Game.move -> Game.play_state -> string
+  string -> (int * int) list -> Arena.game_state -> string

Modified: trunk/Toss/Play/GDLParser.mly
===================================================================
--- trunk/Toss/Play/GDLParser.mly	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Play/GDLParser.mly	2010-12-19 20:42:04 UTC (rev 1262)
@@ -30,6 +30,9 @@
       | Const c::args -> Func (c, args)
       | _ -> raise (Lexer.Parsing_error "GDL term: not a constant head")
     }
+| error {
+  Lexer.report_parsing_error $startpos $endpos
+  "GDL: Syntax error in term." }
 
 atom:
 | r=WORD { Rel (r, []) }
@@ -41,6 +44,9 @@
       | Const r::args -> Rel (r, args)
       | _ -> raise (Lexer.Parsing_error "GDL atom: not a constant head")
     }
+| error {
+  Lexer.report_parsing_error $startpos $endpos
+  "GDL: Syntax error in atom." }
 
 literal:
 | a=atom { Pos a }
@@ -92,13 +98,17 @@
                  "GDL atomic entry: not init, role nor fact")
     }
 
+
 %public game_description:
-    OPEN descr=list(game_descr_entry) CLOSE
+| OPEN descr=list(game_descr_entry) CLOSE
     { compile_game_descr descr }
+| error {
+  Lexer.report_parsing_error $startpos $endpos
+  "GDL: Syntax error in game description." }
 
 %public request:
 | OPEN start=WORD id=WORD role=term descr=game_description
-    startclock=WORD playclock=WORD
+    startclock=WORD playclock=WORD CLOSE
     {
       if start <> "START" && start <> "start" then
         raise (Lexer.Parsing_error "GDL request: start request expected")
@@ -110,7 +120,8 @@
         with Failure _ | Invalid_argument _ ->
           raise (Lexer.Parsing_error "GDL start: clock not a constant int")
     }
-| OPEN command=WORD id=WORD actions=delimited (OPEN, list(term), CLOSE)
+| OPEN command=WORD id=WORD
+    actions=delimited (OPEN, list(term), CLOSE) CLOSE
     {
       if command = "PLAY" || command = "play" then
         Play (id, actions)
@@ -120,7 +131,7 @@
         (Lexer.Parsing_error
            "GDL request: play or stop request expected")
     }
-| OPEN command=WORD id=WORD actions=WORD
+| OPEN command=WORD id=WORD actions=WORD CLOSE
     {
       if actions = "nil" || actions = "NIL" then (
         if command = "PLAY" || command = "play" then
@@ -132,6 +143,9 @@
       ) else raise
         (Lexer.Parsing_error "GDL request: action list expected")
     }
+| error {
+  Lexer.report_parsing_error $startpos $endpos
+  "GDL: Syntax error in request." }
 
 parse_game_description:
   | game_description EOF { $1 }

Modified: trunk/Toss/Play/GameTest.ml
===================================================================
--- trunk/Toss/Play/GameTest.ml	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Play/GameTest.ml	2010-12-19 20:42:04 UTC (rev 1262)
@@ -1205,11 +1205,11 @@
 let a () = run_test_tt ~verbose:true experiments
 
 let a () =
-  Game.set_debug_level 3
+  Server.set_debug_level 3
 
 let a () =
   match test_filter
-    ["Game:0:misc:5:chess draw"]
+    ["Game:0:misc:1:server: ServerGDLTest.in GDL Tic-Tac-Toe"]
     tests
   with
     | Some tests -> ignore (run_test_tt ~verbose:true tests)

Modified: trunk/Toss/Play/Server.ml
===================================================================
--- trunk/Toss/Play/Server.ml	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Play/Server.ml	2010-12-19 20:42:04 UTC (rev 1262)
@@ -55,9 +55,15 @@
 let req_of_str s =
   let s_len = String.length s in
   if s_len > 4 && String.sub s 0 4 = "GDL "
-  then
+  then (
+    (* {{{ log entry *)
+    if !debug_level > 1 then (
+      Printf.printf "req_of_str-GDL:\n%s\n%!" (String.sub s 4 (s_len-4));
+    );
+    (* }}} *)
     Aux.Right (GDLParser.parse_request KIFLexer.lex
                  (Lexing.from_string (String.sub s 4 (s_len-4))))
+  )
   else
     Aux.Left (ArenaParser.parse_request Lexer.lex (Lexing.from_string s))
 
@@ -258,7 +264,7 @@
         | Aux.Right (GDL.Start (_, player, game_descr, startcl, playcl)) ->
           (* GDL will store the player and the game in its state. *)
           let effort, horizon, heur_adv_ratio =
-            GDL.initialize_game player game_descr startcl in
+            GDL.initialize_game state player game_descr startcl in
           (* TODO: handle timer (startclock) in Game.initialize_default*)
           let p, ps = Game.initialize_default
             !state ~effort ~search_method:"alpha_beta_ord"
@@ -275,6 +281,7 @@
           let r_name, mtch =
             GDL.translate_last_action actions in
 
+          if r_name <> "" then (
 	  let {Arena.rules=rules; graph=graph} = !state.Arena.game in
           let struc = !state.Arena.struc in
 	  let fn s n = Structure.find_elem s n in
@@ -291,6 +298,12 @@
                for i = 0 to Array.length moves - 1 do
                  (* FIXME: handle time and params! *)
                  let mov = moves.(i) in
+                 (* {{{ log entry *)
+                 if !debug_level > 1 then (
+                   Printf.printf "GDL: considering move %s\n%!"
+                     (Game.move_gs_str !state mov)
+                 );
+                 (* }}} *)
                  if
                    r_name = mov.Game.rule &&
                    (* t = mov.Game.time && *)
@@ -309,6 +322,7 @@
                done;
                (* TODO: if not due to only time or params mismatch,
                   block or warn about invalid rule application *)
+               
                failwith
                  "Server GDL Play request: action mismatched with play state"
              with Found pos -> pos) in
@@ -333,8 +347,8 @@
           play_state := Some {
             Game.game_state = new_game_state;
             memory = memory;
-          };
-
+          });
+          
           let time_used =
             time_started - (int_of_float (ceil (Sys.time ()))) in
           let p, ps =
@@ -349,7 +363,8 @@
             match res with
               | Some (move, new_state) ->
                 play_state := Some new_state;
-                GDL.translate_move move new_state
+                GDL.translate_move move.Game.rule move.Game.embedding
+                  !state
               | None -> "NOOP" 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/Play/ServerGDLTest.in
===================================================================
--- trunk/Toss/Play/ServerGDLTest.in	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Play/ServerGDLTest.in	2010-12-19 20:42:04 UTC (rev 1262)
@@ -3,9 +3,9 @@
 Sender: GAMEMASTER
 Receiver: GAMEPLAYER
 Content-type: text/acl
-Content-length: 1587
+Content-length: 1589
 
-(START MATCH.3316980891 X (ROLE X) (ROLE O) (INIT (CELL 1 1 B)) (INIT (CELL 1 2 B)) (INIT (CELL 1 3 B)) (INIT (CELL 2 1 B)) (INIT (CELL 2 2 B)) (INIT (CELL 2 3 B)) (INIT (CELL 3 1 B)) (INIT (CELL 3 2 B)) (INIT (CELL 3 3 B)) (INIT (CONTROL X)) (<= (NEXT (CELL ?X ?Y ?PLAYER)) (DOES ?PLAYER (MARK ?X ?Y))) (<= (NEXT (CELL ?X ?Y ?MARK)) (TRUE (CELL ?X ?Y ?MARK)) (DOES ?PLAYER (MARK ?M ?N)) (DISTINCTCELL ?X ?Y ?M ?N)) (<= (NEXT (CONTROL X)) (TRUE (CONTROL O))) (<= (NEXT (CONTROL O)) (TRUE (CONTROL X))) (<= (ROW ?X ?PLAYER) (TRUE (CELL ?X 1 ?PLAYER)) (TRUE (CELL ?X 2 ?PLAYER)) (TRUE (CELL ?X 3 ?PLAYER))) (<= (COLUMN ?Y ?PLAYER) (TRUE (CELL 1 ?Y ?PLAYER)) (TRUE (CELL 2 ?Y ?PLAYER)) (TRUE (CELL 3 ?Y ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 1 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 3 ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 3 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 1 ?PLAYER))) (<= (LINE ?PLAYER) (ROW ?X ?PLAYER)) (<= (LINE ?PLAYER) (COLUMN ?Y ?PLAYER)) (<= (LINE ?PLAYER) (DIAGONAL ?PLAYER)) (<= OPEN (TRUE (CELL ?X ?Y B))) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?X ?M)) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?Y ?N)) (<= (LEGAL ?PLAYER (MARK ?X ?Y)) (TRUE (CELL ?X ?Y B)) (TRUE (CONTROL ?PLAYER))) (<= (LEGAL ?PLAYER NOOP) (NOT (TRUE (CONTROL ?PLAYER)))) (<= (GOAL ?PLAYER 100) (LINE ?PLAYER)) (<= (GOAL ?PLAYER 50) (NOT (LINE X)) (NOT (LINE O)) (NOT OPEN)) (<= (GOAL ?PLAYER1 0) (LINE ?PLAYER2) (DISTINCT ?PLAYER1 ?PLAYER2)) (<= (GOAL ?PLAYER 0) (NOT (LINE X)) (NOT (LINE O)) OPEN) (<= TERMINAL (LINE ?PLAYER)) (<= TERMINAL (NOT OPEN)) 30 30)
+(START MATCH.3316980891 X ((ROLE X) (ROLE O) (INIT (CELL 1 1 B)) (INIT (CELL 1 2 B)) (INIT (CELL 1 3 B)) (INIT (CELL 2 1 B)) (INIT (CELL 2 2 B)) (INIT (CELL 2 3 B)) (INIT (CELL 3 1 B)) (INIT (CELL 3 2 B)) (INIT (CELL 3 3 B)) (INIT (CONTROL X)) (<= (NEXT (CELL ?X ?Y ?PLAYER)) (DOES ?PLAYER (MARK ?X ?Y))) (<= (NEXT (CELL ?X ?Y ?MARK)) (TRUE (CELL ?X ?Y ?MARK)) (DOES ?PLAYER (MARK ?M ?N)) (DISTINCTCELL ?X ?Y ?M ?N)) (<= (NEXT (CONTROL X)) (TRUE (CONTROL O))) (<= (NEXT (CONTROL O)) (TRUE (CONTROL X))) (<= (ROW ?X ?PLAYER) (TRUE (CELL ?X 1 ?PLAYER)) (TRUE (CELL ?X 2 ?PLAYER)) (TRUE (CELL ?X 3 ?PLAYER))) (<= (COLUMN ?Y ?PLAYER) (TRUE (CELL 1 ?Y ?PLAYER)) (TRUE (CELL 2 ?Y ?PLAYER)) (TRUE (CELL 3 ?Y ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 1 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 3 ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 3 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 1 ?PLAYER))) (<= (LINE ?PLAYER) (ROW ?X ?PLAYER)) (<= (LINE ?PLAYER) (COLUMN ?Y ?PLAYER)) (<= (LINE ?PLAYER) (DIAGONAL ?PLAYER)) (<= OPEN (TRUE (CELL ?X ?Y B))) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?X ?M)) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?Y ?N)) (<= (LEGAL ?PLAYER (MARK ?X ?Y)) (TRUE (CELL ?X ?Y B)) (TRUE (CONTROL ?PLAYER))) (<= (LEGAL ?PLAYER NOOP) (NOT (TRUE (CONTROL ?PLAYER)))) (<= (GOAL ?PLAYER 100) (LINE ?PLAYER)) (<= (GOAL ?PLAYER 50) (NOT (LINE X)) (NOT (LINE O)) (NOT OPEN)) (<= (GOAL ?PLAYER1 0) (LINE ?PLAYER2) (DISTINCT ?PLAYER1 ?PLAYER2)) (<= (GOAL ?PLAYER 0) (NOT (LINE X)) (NOT (LINE O)) OPEN) (<= TERMINAL (LINE ?PLAYER)) (<= TERMINAL (NOT OPEN))) 30 30)
 
 POST / HTTP/1.0
 Accept: text/delim
@@ -23,7 +23,7 @@
 Content-type: text/acl
 Content-length: 41
 
-(PLAY MATCH.3316980891 ((MARK 3 3) NOOP))
+(PLAY MATCH.3316980891 ((MARK 2 2) NOOP))
 
 POST / HTTP/1.0
 Accept: text/delim
@@ -32,7 +32,7 @@
 Content-type: text/acl
 Content-length: 41
 
-(PLAY MATCH.3316980891 (NOOP (MARK 1 3)))
+(PLAY MATCH.3316980891 (NOOP (MARK 1 1)))
 
 POST / HTTP/1.0
 Accept: text/delim

Modified: trunk/Toss/Play/ServerGDLTest.out
===================================================================
--- trunk/Toss/Play/ServerGDLTest.out	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Play/ServerGDLTest.out	2010-12-19 20:42:04 UTC (rev 1262)
@@ -7,7 +7,7 @@
 Content-type: text/acl
 Content-length: 10
 
-(MARK 3 3)
+(MARK 2 2)
 HTTP/1.0 200 OK
 Content-type: text/acl
 Content-length: 4

Modified: trunk/Toss/Solver/Structure.ml
===================================================================
--- trunk/Toss/Solver/Structure.ml	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Solver/Structure.ml	2010-12-19 20:42:04 UTC (rev 1262)
@@ -1033,6 +1033,19 @@
   Format.fprintf Format.str_formatter "%a" fprint struc;
   Format.flush_str_formatter ()
     
+let board_elem_coords name =
+  let col_index =
+    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" in
+  let col = String.index col_index name.[0] + 1 in
+  try col, int_of_string (String.sub name 1 (String.length name - 1))
+  with Failure _ | Invalid_argument _ ->
+    raise Not_found
+    
+let board_coords_name (col, row) =
+  if col < 1 || col > 52 || row < 1 then raise Not_found;
+  let col_index =
+    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" in
+  Char.escaped col_index.[col-1] ^ string_of_int row
 
 (* -------------------- PARSER HELPERS -------------------- *)
 

Modified: trunk/Toss/Solver/Structure.mli
===================================================================
--- trunk/Toss/Solver/Structure.mli	2010-12-19 17:35:10 UTC (rev 1261)
+++ trunk/Toss/Solver/Structure.mli	2010-12-19 20:42:04 UTC (rev 1262)
@@ -105,7 +105,14 @@
 
 val sprint : structure -> string
 
+(** Coordinates, column first, of a board element name. Raises
+    [Not_found] if the name is not of proper format. *)
+val board_elem_coords : string -> int * int
 
+(** Board element name under given coordinates, column first. Raises
+    [Not_found] if the coordinates are out of bounds. *)
+val board_coords_name : int * int -> string
+
 (** {2 Adding elements possibly with string names} *)
 
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.