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

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

Revision: 1426
          http://toss.svn.sourceforge.net/toss/?rev=1426&view=rev
Author:   lukstafi
Date:     2011-04-29 11:37:27 +0000 (Fri, 29 Apr 2011)

Log Message:
-----------
ReqHandle GDL: bug fix (do not keep old state).

Modified Paths:
--------------
    trunk/Toss/GGP/GDL.ml
    trunk/Toss/GGP/GDLTest.ml
    trunk/Toss/Server/ReqHandler.ml
    trunk/Toss/Server/ServerTest.ml
    trunk/Toss/www/reference/reference.tex

Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml	2011-04-29 09:09:04 UTC (rev 1425)
+++ trunk/Toss/GGP/GDL.ml	2011-04-29 11:37:27 UTC (rev 1426)
@@ -756,9 +756,14 @@
 
 let fprint_gdl_transl_data ?(details=false) ppf gdl =
   (* TODO: print more data if needed *)
-  Format.fprintf ppf "GDL_DATA@,{@[<1>FLUENTS@ %a;@ PLAYING_AS@ %d;"
-    (Aux.fprint_sep_list ";" Format.pp_print_string) gdl.fluents
-    gdl.playing_as;
+  Format.fprintf ppf
+    "GDL_DATA@,{@[<1>FLUENTS@ %a;@ PLAYING_AS@ %d;@ NOOPS@ %a;"
+    (Aux.fprint_sep_list "," Format.pp_print_string) gdl.fluents
+    gdl.playing_as
+    (Aux.fprint_sep_list "," Format.pp_print_string)
+    (Array.to_list (Array.mapi (fun i -> function
+      | None -> string_of_int i ^": None"
+      | Some noop -> string_of_int i ^": "^term_str noop) gdl.noop_actions));
   Aux.StrMap.iter (fun rname data ->
     Format.fprintf ppf "@ @[<1>RULE@ %s:@ LEGAL=@,%s;@ PRECOND=@,%a;@ "
       rname (term_str data.lead_legal) Formula.fprint data.precond;
@@ -4403,12 +4408,24 @@
 
 let our_turn gdl state =
   let loc = (snd state).Arena.cur_loc in
-  gdl.playing_as = Aux.array_argfind (fun l -> l.Arena.moves <> []) 
-      (fst state).Arena.graph.(loc)
+  let res =
+    gdl.playing_as = Aux.array_argfind (fun l -> l.Arena.moves <> []) 
+    (fst state).Arena.graph.(loc) in
+  (* {{{ log entry *)
+  if !debug_level > 3 then (
+    Printf.printf "our_turn: %b at loc %d\n%!" res loc
+  );
+  (* }}} *)
+  res
 
 
 let noop_move ?(force=false) gdl state =
   let loc = state.Arena.cur_loc in
+  (* {{{ log entry *)
+  if !debug_level > 3 then (
+    Printf.printf "noop_move: loc %d\n%!" loc
+  );
+  (* }}} *)
   match gdl.noop_actions.(loc) with
     | Some t -> term_str t
     | None when force ->

Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml	2011-04-29 09:09:04 UTC (rev 1425)
+++ trunk/Toss/GGP/GDLTest.ml	2011-04-29 11:37:27 UTC (rev 1426)
@@ -243,10 +243,10 @@
 ]
 
 
-let a  =
+let a =
   Aux.run_test_if_target "GDLTest" tests
 
-let a  =
+let a =
   Aux.run_test_if_target "GDLTest" bigtests
 
 let a () =
@@ -263,7 +263,8 @@
     | Some tests -> ignore (run_test_tt ~verbose:true tests)
     | None -> ()
         
-let regenerate ?(debug=true) ~game_name ~player =
+let regenerate ~debug ~game_name ~player =
+  Printf.printf "Regenerating %s...\n%!" game_name;
   if debug then (
     GDL.debug_level := 4;
     GameSimpl.debug_level := 4;
@@ -274,7 +275,8 @@
   GDL.generate_test_case := None
 
 let a () =
-  regenerate ~debug:false ~game_name:"tictactoe" ~player:"xplayer";
-  regenerate ~debug:false ~game_name:"connect5" ~player:"x";
-  regenerate ~debug:false ~game_name:"breakthrough" ~player:"white";
+  (* regenerate ~debug:false ~game_name:"tictactoe" ~player:"xplayer"; *)
+  (* regenerate ~debug:false ~game_name:"connect5" ~player:"x"; *)
+  (* 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-04-29 09:09:04 UTC (rev 1425)
+++ trunk/Toss/Server/ReqHandler.ml	2011-04-29 11:37:27 UTC (rev 1426)
@@ -65,7 +65,7 @@
     let r_name, mtch =
       GDL.translate_last_action gdl_transl state actions in
 
-    let new_state =
+    let state =
       if r_name <> "" then (
 	let {Arena.rules=rules; graph=graph} = fst state in
 	let mv_loc = select_moving graph.((snd state).Arena.cur_loc) in
@@ -98,7 +98,7 @@
       else
 	let mov_msg =
           let time_used = time_started -. Unix.gettimeofday () in
-	  if GDL.our_turn gdl_transl new_state then (
+	  if GDL.our_turn gdl_transl state then (
 	    Play.set_timeout (float(playclock) -. time_used -. 0.07);
 	    let heur = match g_heur with
 	      | Some h -> h
@@ -115,4 +115,4 @@
 	let msg_len = String.length mov_msg in
 	("HTTP/1.0 200 OK\r\nContent-type: text/acl\r\nContent-length: "
 	 ^ string_of_int msg_len ^ "\r\n\r\n" ^ mov_msg) in
-    (g_heur, game_modified, new_state, resp, gdl_transl, playclock)
+    (g_heur, game_modified, state, resp, gdl_transl, playclock)

Modified: trunk/Toss/Server/ServerTest.ml
===================================================================
--- trunk/Toss/Server/ServerTest.ml	2011-04-29 09:09:04 UTC (rev 1425)
+++ trunk/Toss/Server/ServerTest.ml	2011-04-29 11:37:27 UTC (rev 1426)
@@ -22,7 +22,6 @@
 
   "ServerGDLTest.in GDL Tic-Tac-Toe manual" >::
     (fun () ->
-      GDL.debug_level := 4;
       let old_translation = !GDL.manual_translation in
       GDL.manual_translation := true;
       GDL.manual_game := "tictactoe";
@@ -44,7 +43,6 @@
 
   "ServerGDLTest.in GDL Tic-Tac-Toe automatic" >::
     (fun () ->
-      GDL.debug_level := 4;
       (* todo "real soon now..."; *)
       (* Solver.set_debug_level 2; *)
       let old_translation = !GDL.manual_translation in

Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex	2011-04-29 09:09:04 UTC (rev 1425)
+++ trunk/Toss/www/reference/reference.tex	2011-04-29 11:37:27 UTC (rev 1426)
@@ -1730,17 +1730,17 @@
 of substituted bodies of the frame clauses and bring this Boolean combination
 to disjunctive normal form (DNF), \ie we compute conjunctions $e_1, \dots, e_l$
 such that 
-\[ \neg( \rho(b_1) \lor \dots \lor \rho(b_{|J|}) \ \equiv \ 
-   (e_1 \lor e_2 \ldots \lor e_l). \]
-As the head of each erasure clause we use $\rho(s_1) = \dots = \rho(s_{|J|})$,
-with the one technical change that we ignore the fluent paths in this term.
-We replace these fluent paths with \texttt{BLANK} and thus allow them
-to be deleted in case they are not preserved by other \texttt{next} clauses
-of the rule, which causes no problems. Let us denote by $h$ the term
-$\rho(s_1)$ after the above replacement. The erasure clauses
-$\calE_{\ol{\calC}, \ol{\calN}}(J) = 
-     \{ \mathtt{(<=\ h\ e_1)} \dots \mathtt{(<=\ h\ e_l)} \},$
-and we write $\calE_{\ol{\calC}, \ol{\calN}}$ for the union of all
+\[ \neg( \rho(b_1) \lor \dots \lor \rho(b_{|J|})) \ \equiv \ (e_1 \lor
+e_2 \ldots \lor e_l). \] 
+As the head of each erasure clause we use
+$\rho(s_1) = \dots = \rho(s_{|J|})$, with the one technical change
+that we ignore the fluent paths in this term.  We replace these fluent
+paths with \texttt{BLANK} and thus allow them to be deleted in case
+they are not preserved by other \texttt{next} clauses of the rule. Let
+us denote by $h$ the term $\rho(s_1)$ after the above replacement. The
+erasure clauses $\calE_{\ol{\calC}, \ol{\calN}}(J) = \{ \mathtt{(<=\
+  h\ e_1)} \dots \mathtt{(<=\ h\ e_l)} \},$ and we write
+$\calE_{\ol{\calC}, \ol{\calN}}$ for the union of all
 $\calE_{\ol{\calC}, \ol{\calN}}(J)$, \ie for the set of all
 $\ol{\calC}, \ol{\calN}$ erasure clauses.
 


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