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

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

Revision: 1718
          http://toss.svn.sourceforge.net/toss/?rev=1718&view=rev
Author:   lukaszkaiser
Date:     2012-06-02 21:13:38 +0000 (Sat, 02 Jun 2012)
Log Message:
-----------
Debugging and some evaluator improvements.

Modified Paths:
--------------
    trunk/Toss/Arena/ArenaTest.ml
    trunk/Toss/Client/.cvsignore
    trunk/Toss/Client/JsEval.ml
    trunk/Toss/Client/Makefile
    trunk/Toss/Formula/FormulaParser.mly
    trunk/Toss/Makefile
    trunk/Toss/Server/Tests.ml
    trunk/Toss/Solver/AssignmentSet.ml
    trunk/Toss/Solver/Assignments.mli
    trunk/Toss/Solver/Solver.ml
    trunk/Toss/Solver/SolverTest.ml
    trunk/Toss/Solver/Structure.ml
    trunk/Toss/Solver/Structure.mli
    trunk/Toss/Solver/StructureParser.mly
    trunk/Toss/Solver/StructureTest.ml

Added Paths:
-----------
    trunk/Toss/Client/eval.html

Removed Paths:
-------------
    trunk/Toss/Client/SimpleEvaluator.ml
    trunk/Toss/Client/SimpleEvaluator.mli
    trunk/Toss/Client/SimpleEvaluatorTest.ml

Property Changed:
----------------
    trunk/Toss/Client/

Modified: trunk/Toss/Arena/ArenaTest.ml
===================================================================
--- trunk/Toss/Arena/ArenaTest.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Arena/ArenaTest.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -4,8 +4,34 @@
 let gs_of_str s =
   ArenaParser.parse_game_state Lexer.lex (Lexing.from_string s)
 
+let struc_of_str s =
+  match ArenaParser.parse_game_defs Lexer.lex (Lexing.from_string s) with
+    | Arena.StartStruc struc -> struc
+    | _ -> failwith "GameTreeTest:struc_of_str: not a structure"
 
+let rel_str rel struc_str =
+  let s = struc_of_str struc_str in
+  Structure.rel_str s rel (Structure.rel_graph rel s)
+
 let tests = "Arena" >::: [
+  "structure with rels parsing" >::
+    (fun () ->
+      let test p s res = assert_equal ~printer:(fun x -> x) res (rel_str p s) in
+      test "P" "START [ 1 - 5 | | - ] with P(a) = :nbr(a) = 2" "P (e2)";
+      test "P" ("START [ 1 - 10 | | - ] with P(z) = &z > 1 and " ^ 
+		   "all x, y (&x * &y = &z -> (&x = 1 or &y = 1))")
+	"P {e2; e3; e5; e7}";
+      test "P" ("START [ 1 - 3 | | - ] with E(x, y) = &y = &x + 1; " ^ 
+		   "P(x, y) = &x != &y and tc x, y E(x, y)")
+	"P {(e1, e2); (e1, e3); (e2, e3)}";
+      test "S" ("START [ 1 - 10 | | - ] with P(z) = &z > 1 and " ^ 
+		   "all x, y (&x * &y = &z -> (&x = 1 or &y = 1));" ^
+		   "E(x, y) = P(x) and P(y) and &x < &y and " ^
+		   "  all z (&x < &z and &z < &y -> not P(z));" ^
+		   "S(x, y) = x != y and tc x, y E(x, y)")
+	"S {(e2, e3); (e2, e5); (e2, e7); (e3, e5); (e3, e7); (e5, e7)}";
+    );
+
   "simple parsing and printing" >::
     (fun () ->
       let s = "PLAYERS white, black
@@ -93,3 +119,19 @@
     );
 ]
 
+let bigtests = "ArenaBig" >::: [
+  "structure with rels: 3 coloring" >::
+    (fun () ->
+      let test p s res = assert_equal ~printer:(fun x -> x) res (rel_str p s) in
+      test "C" ("START [ 1 - 3 | | - ] with E(x, y) = x != y; " ^ 
+		   "C(z) = ex R, G, B all x, y ( (x in R or x in G or x in B)"^
+		   " and ( E(x,y) -> not ( (x in R and y in R) or (x in G and"^
+		   "  y in G) or (x in B and y in B) ) ) )")
+	"C {e1; e2; e3}";
+      test "C" ("START [ 1 - 4 | | - ] with E(x, y) = x != y; " ^ 
+		   "C(z) = ex R, G, B all x, y ( (x in R or x in G or x in B)"^
+		   " and ( E(x,y) -> not ( (x in R and y in R) or (x in G and"^
+		   "  y in G) or (x in B and y in B) ) ) )")
+	"C:1 {}";
+    );
+]


Property changes on: trunk/Toss/Client
___________________________________________________________________
Modified: svn:ignore
   - # We are still using .cvsignore files as we find them easier to manage
# than svn properties. Therefore if you change .cvsignore do the following.
#     svn propset svn:ignore -F .cvsignore .

JsHandler.js
clientTestRender*.png
*.js.gz
*~

   + # We are still using .cvsignore files as we find them easier to manage
# than svn properties. Therefore if you change .cvsignore do the following.
#     svn propset svn:ignore -F .cvsignore .

JsHandler.js
JsEval.js
clientTestRender*.png
*.js.gz
*~


Modified: trunk/Toss/Client/.cvsignore
===================================================================
--- trunk/Toss/Client/.cvsignore	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Client/.cvsignore	2012-06-02 21:13:38 UTC (rev 1718)
@@ -3,6 +3,7 @@
 #     svn propset svn:ignore -F .cvsignore .
 
 JsHandler.js
+JsEval.js
 clientTestRender*.png
 *.js.gz
 *~

Modified: trunk/Toss/Client/JsEval.ml
===================================================================
--- trunk/Toss/Client/JsEval.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Client/JsEval.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -1,13 +1,11 @@
-open SimpleEvaluator
+(* Evaluating formulas on structures for JS. *)
 
-(* Boilerplate code for calling OCaml in the worker thread. *)
+(* --- Boilerplate code for calling OCaml in the worker thread. --- *)
 let js_object = Js.Unsafe.variable "Object"
 let js_handler = jsnew js_object ()
 let postMessage = Js.Unsafe.variable "postMessage"
+let js_any = Js.Unsafe.inject
 
-let log s = ignore (Js.Unsafe.call postMessage (Js.Unsafe.variable "self")
-		      [|Js.Unsafe.inject (Js.string s)|])
-
 let onmessage event =
   let fname = event##data##fname in
   let args = event##data##args in
@@ -16,17 +14,81 @@
   let response = jsnew js_object () in
   Js.Unsafe.set response (Js.string "fname") fname;
   Js.Unsafe.set response (Js.string "result") result;
-  Js.Unsafe.call postMessage (Js.Unsafe.variable "self") [|Js.Unsafe.inject response|]
+  Js.Unsafe.call postMessage (Js.Unsafe.variable "self") [|js_any response|]
 
-let _ = Js.Unsafe.set (Js.Unsafe.variable "self") (Js.string "onmessage") onmessage
+let _ = 
+  Js.Unsafe.set (Js.Unsafe.variable "self") (Js.string "onmessage") onmessage
 
+let set_handle name f =
+  Js.Unsafe.set js_handler (Js.string name) (Js.wrap_callback f)
+
+
+(* --- Main part: communication with JS and evaluation --- *)
+
+(* Translate a structure into an "info_obj" format used by State.js. *)
+let js_of_struc struc =
+  let elems = Structure.elements struc in
+  LOG 0 "js_of_struc: preparing structure elements...";
+  let get_pos e = Structure.fun_val struc "x" e,Structure.fun_val struc "y" e in
+  let minx, maxx, miny, maxy = 
+    let (posx, posy) = List.split (List.map get_pos elems) in
+    let mkfl f l = List.fold_left f (List.hd l) (List.tl l) in
+    let (minl, maxl, suml) = (mkfl min, mkfl max, mkfl (+.)) in
+    minl posx, maxl posx, minl posy, maxl posy in
+  (* elems in JS are arrays of element name and position *)
+  let elems = Array.of_list (List.map (fun e ->
+    let e0 = Js.string (Structure.elem_name struc e) in
+    let x, y = get_pos e in
+    Js.array [|js_any e0; js_any (Js.float x); js_any (Js.float y)|]
+  ) elems) in
+  (* rels in JS are arrays of element names, with additional "name" field *)
+  let num = Js.number_of_float in
+  LOG 0 "js_of_struc: preparing relations...";
+  let rels_all =
+    (Aux.concat_map
+       (fun (rel, _) ->
+         let tups = Structure.Tuples.elements
+           (Structure.rel_graph rel struc) in
+         let tups = List.map
+           (fun args -> Js.array
+             (Array.map (fun e-> Js.string (Structure.elem_name struc e)) args))
+           tups in
+         List.map (fun args -> (args, Js.string rel)) tups)
+       (Structure.rel_signature struc)) in
+  let rels, rel_names = List.split rels_all in
+  let info_obj = jsnew js_object () in
+  let js = Js.string in
+  Js.Unsafe.set info_obj (js"maxx") (num maxx);
+  Js.Unsafe.set info_obj (js"minx") (num minx);
+  Js.Unsafe.set info_obj (js"maxy") (num maxy);
+  Js.Unsafe.set info_obj (js"miny") (num miny);
+  Js.Unsafe.set info_obj (js"elems") (Js.array elems);
+  Js.Unsafe.set info_obj (js"rels") (Js.array (Array.of_list rels));
+  Js.Unsafe.set info_obj (js"rel_names") (Js.array (Array.of_list rel_names));
+  info_obj
+
+(* Parse a formula. *)
+let formula_of_string s = FormulaParser.parse_formula Lexer.lex 
+  (Lexing.from_string (Aux.normalize_spaces s))
+
+(* Parse a structure. *)
+let structure_of_string s = 
+  let str = "START " ^ (Aux.normalize_spaces s) in
+  match ArenaParser.parse_game_defs Lexer.lex (Lexing.from_string str) with
+    | Arena.StartStruc struc -> struc
+    | _ -> failwith "not a structure"
+
+(* Parse a structure from a JS string and return in "info_obj" format. *)
+let info_obj_of_string s = js_of_struc (structure_of_string (Js.to_string s))
+
+let _ = set_handle "info_obj" info_obj_of_string
+
+
 (* The Formula evaluation and registration in JS. *)
 let js_eval phi struc = 
-  log ("Evaluation of " ^ (Js.to_string phi) ^ " on " ^ (Js.to_string struc));
-  (**log( (SimpleEvaluator.show_satisfying (Js.to_string phi) (Js.to_string struc)));*)
-	Js.string (SimpleEvaluator.show_satisfying 
-			~structure:(Js.to_string struc) 
-			~formula:(Js.to_string phi)
-		)
+  let (phi, struc) = (Js.to_string phi, Js.to_string struc) in
+  LOG 0 "Evaluation of %s on %s" phi struc;
+  let (f, struc) = (formula_of_string phi, structure_of_string struc) in
+  Js.string (AssignmentSet.named_str struc (Solver.M.evaluate struc f))
 		
-let _ = Js.Unsafe.set js_handler (Js.string "eval") (Js.wrap_callback js_eval)
\ No newline at end of file
+let _ = set_handle "eval" js_eval

Modified: trunk/Toss/Client/Makefile
===================================================================
--- trunk/Toss/Client/Makefile	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Client/Makefile	2012-06-02 21:13:38 UTC (rev 1718)
@@ -2,6 +2,7 @@
 
 ClientTest:
 	make -C .. Client/JsHandler.js
+	make -C .. Client/JsEval.js
 	phantomjs clientTest.js
 
 JSFILES = $(notdir $(shell find . -maxdepth 1 -name '*.js'))

Deleted: trunk/Toss/Client/SimpleEvaluator.ml
===================================================================
--- trunk/Toss/Client/SimpleEvaluator.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Client/SimpleEvaluator.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -1,10 +0,0 @@
-let formula_of_string s = 
-  FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
-
-let structure_of_string s = 
-  StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
-
-let show_satisfying ~formula ~structure =
-  let (f, struc) = (formula_of_string formula, structure_of_string structure) in
-  AssignmentSet.named_str struc (Solver.M.evaluate struc f)
-	
\ No newline at end of file

Deleted: trunk/Toss/Client/SimpleEvaluator.mli
===================================================================
--- trunk/Toss/Client/SimpleEvaluator.mli	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Client/SimpleEvaluator.mli	2012-06-02 21:13:38 UTC (rev 1718)
@@ -1,4 +0,0 @@
-(** Simple module for evaluating formalas in a given structure *)
-
-(** Parse a formula and a structure and return the satisfying assignments. *)
-val show_satisfying : formula: string -> structure: string -> string
\ No newline at end of file

Deleted: trunk/Toss/Client/SimpleEvaluatorTest.ml
===================================================================
--- trunk/Toss/Client/SimpleEvaluatorTest.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Client/SimpleEvaluatorTest.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -1,12 +0,0 @@
-open OUnit
-
-let tests = "SimpleEvaluator" >::: [
-  "show_satisfying" >::
-    (fun () ->
-      assert_equal ~printer:(fun x -> x) 
-	"{ y->b, y->c }"
-	(SimpleEvaluator.show_satisfying 
-	   ~structure:"[ | R { (a, b); (a, c) } | ]"
-	   ~formula:"ex x R (x, y)");
-    );
-]

Added: trunk/Toss/Client/eval.html
===================================================================
--- trunk/Toss/Client/eval.html	                        (rev 0)
+++ trunk/Toss/Client/eval.html	2012-06-02 21:13:38 UTC (rev 1718)
@@ -0,0 +1,122 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xmlns:svg="http://www.w3.org/2000/svg" xml:lang="en" lang="en">
+<head>
+  <meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" />
+  <title>Toss Formula Evaluator</title>
+  <meta name="Description" content="Evaluate Formulas on Structures." />
+  <meta http-equiv="X-UA-Compatible" content="chrome=1" />
+  <link rel="icon" type="image/vnd.microsoft.icon" href="favicon.ico" />
+  <link rel="stylesheet" type="text/css" href="Style.css" media="screen" title="Default"/>
+  <script type="text/javascript" src="State.js">  </script>
+  <script type="text/javascript">
+<!--
+var worker = new Worker ("JsEval.js");
+var worker_handler = new Object ();
+
+worker.onmessage = function (m) {
+    if (typeof m.data == 'string') {
+        console.log("" + m.data);
+    } else {
+        console.log ("[ASYNCH] back from " + m.data.fname);
+        var handler = worker_handler[m.data.fname];
+        handler (m.data.result);
+    }
+}
+
+function ASYNCH (action_name, action_args, cont) {
+    worker_handler[action_name] = cont;
+    worker.postMessage ({fname: action_name, args: action_args});
+    console.log ("[ASYNCH] " + action_name + " (" + action_args + ")");
+}
+
+function eval () {
+  var phi = document.getElementById ("formula").value;
+  var struc = document.getElementById ("structure").value;
+  ASYNCH ("info_obj", [struc], function (obj) { 
+    var struc = new State ("nogame", obj, 0);
+    struc.draw_model ("nogame");
+  })
+  document.getElementById ("result").innerHTML = "Evaluating...";
+  ASYNCH ("eval", [phi, struc], function (resp) { 
+    var res = document.getElementById ("result");
+    res.innerHTML = resp;
+  })
+}
+
+function handle_elem_click (eid) { console.log (eid); }
+
+function example_primes () {
+  document.getElementById ("formula").value = "P(x)";
+  document.getElementById ("structure").value = "[ 1 - 10 | | - ] with " +
+     "\nP(z) = &z > 1 and all x, y \n    (&x * &y = &z -> (&x = 1 or &y = 1))";
+  eval ();
+}
+
+function example_tc () {
+  document.getElementById ("formula").value = "S(x, y)";
+  document.getElementById ("structure").value = 
+     "[ 1 - 3 | | - ] with " +
+     "\nE(x, y) = &y = &x + 1;" +
+     "\nS(x, y) = x != y and tc x, y E(x, y)";
+  eval ();
+}
+
+function example_3col () {
+  document.getElementById ("formula").value = 
+    "ex R, G, B all x, y ( \n  (x in R or x in G or x in B) and (" +
+    "\n    E(x,y) -> not ( (x in R and y in R) " +
+    "\n      or (x in G and y in G) or (x in B and y in B) ) ) )";
+  document.getElementById ("structure").value = 
+    "[ | E { (a, b); (b, c); (c, a) } | " + 
+    "\n  x { a -> 1, b -> 2, c -> 3 }; " +
+    "\n  y { a -> 0, b -> -1, c -> 0 } ]";
+  eval ();
+}
+//-->
+</script>
+</head>
+
+<body>
+<div id="main">
+
+<div id="top">
+<div id="logo">
+  <a id="leftupperlogo-link" href="eval.html">
+    <img id="leftupperlogo-img" src="img/logo.png" alt="back" />
+  </a>
+</div>
+</div>
+
+<div style="position: relative; top: 4em; left: 1em">
+
+<textarea id="formula" rows="3" cols="40">
+E(x, y)</textarea> 
+
+<textarea id="structure" rows="3" cols="40">
+[ 1 - 5 |  | - ] with
+E(x, y) = &x = &y + 1</textarea> 
+
+<button onclick="eval()">Eval and Draw</button>
+
+Examples:
+
+<button onclick="example_primes()">Primes</button>
+
+<button onclick="example_tc()">TC</button>
+
+<button onclick="example_3col()">3col</button>
+
+<p id="result"> </p>
+
+<div id="board"> </div>
+</div>
+
+<div id="bottom">
+  <div id="bottomright">
+    <a href="http://toss.sourceforge.net" id="toss-link">Contact</a>
+  </div>
+</div>
+
+</div>
+</body>
+</html>

Modified: trunk/Toss/Formula/FormulaParser.mly
===================================================================
--- trunk/Toss/Formula/FormulaParser.mly	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Formula/FormulaParser.mly	2012-06-02 21:13:38 UTC (rev 1718)
@@ -46,6 +46,8 @@
   | MINUS COLON ID            { Times (Const (-1.), RVar (":" ^ $3)) }
   | COLON ID OPEN ID CLOSE    { Fun ($2, fo_var_of_s $4) }
   | COLON ID OPEN INT CLOSE   { Fun ($2, fo_var_of_s (string_of_int $4)) }
+  | AMP ID                    { Fun ("nbr", fo_var_of_s $2) }
+  | AMP INT                   { Fun ("nbr", fo_var_of_s (string_of_int $2)) }
   | real_expr FLOAT           { Plus ($1, Const $2) } /* in x-1, "-1" is int */
   | real_expr INT             { Plus ($1, Const (float_of_int $2)) }
   | real_expr PLUS real_expr  { Plus ($1, $3) }

Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Makefile	2012-06-02 21:13:38 UTC (rev 1718)
@@ -2,7 +2,8 @@
 
 SHELL := /bin/bash
 
-TossServer: Server/Server.native
+TossServer:
+	make Server/Server.native
 	cp _build/Server/Server.native TossServer
 
 JSOCAML=js_of_ocaml
@@ -14,12 +15,12 @@
 	cat _build/$@ > $@
 	gzip --best -c $@ > $@.gz
 
-TossClient: Client/JsHandler.js
+TossClient: Client/JsHandler.js Client/JsEval.js
 	make -C Client alljsgz
 
 
 RELEASE=0.8
-Release: TossServer doc
+Release: TossClient Server/Server.native TossServer doc
 	rm -f *~ MenhirLib/*~ Formula/*~ Term/*~ Solver/*~ Arena/*~ Play/*~ \
 	  GGP/*~ Learn/*~ Server/*~ www/*~ WebClient/~
 	make -C www/reference
@@ -166,11 +167,11 @@
 
 # ---------- TESTS --------
 
-%Test: TossServer
+%Test: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 	  ./TossServer -fulltest $@
 
-%TestVerbose: TossServer
+%TestVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 	  ./TossServer -v -fulltest $(subst TestVerbose,Test,$@)
 
@@ -182,83 +183,83 @@
 	gprof _build/$< > $@.log
 
 # Formula tests
-FormulaTests: TossServer
+FormulaTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Formula
-FormulaTestsVerbose: TossServer
+FormulaTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Formula -v
 
 # Solver tests
-SolverTests: TossServer
+SolverTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Solver
-SolverTestsVerbose: TossServer
+SolverTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Solver -v
 
 # Term tests
-TermTests: TossServer
+TermTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Term
-TermTestsVerbose: TossServer
+TermTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Term -v
 
 # Arena tests
-ArenaTests: TossServer
+ArenaTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Arena
-ArenaTestsVerbose: TossServer
+ArenaTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Arena -v
 
 # Play tests
-PlayTests: TossServer
+PlayTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Play
-PlayTestsVerbose: TossServer
+PlayTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Play -v
 
 # GGP tests
-GGPTests: TossServer
+GGPTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest GGP
-GGPTestsVerbose: TossServer
+GGPTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest GGP -v
 
-GGPTestsExtra: TossServer
+GGPTestsExtra: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; ./TossServer -extratest GGP
 
 # Learn tests
-LearnTests: TossServer
+LearnTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Learn
-LearnTestsVerbose: TossServer
+LearnTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Learn -v
 
-LearnTestsExtra: TossServer
+LearnTestsExtra: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; ./TossServer -extratest Learn
 
 # Server tests
-ServerTests: TossServer
+ServerTests: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Server
-ServerTestsVerbose: TossServer
+ServerTestsVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
 		./TossServer -fulltest Server -v
 
 # All OCaml tests
-TossTest: TossServer
+TossTest: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; ./TossServer -test ""
-TossTestVerbose: TossServer
+TossTestVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; ./TossServer -v -test ""
-TossFullTest: TossServer
+TossFullTest: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; ./TossServer -fulltest ""
-TossFullTestVerbose: TossServer
+TossFullTestVerbose: Server/Server.native TossServer
 	OCAMLRUNPARAM=b; export OCAMLRUNPARAM; ./TossServer -v -fulltest ""
 
 # Client tests
@@ -276,7 +277,7 @@
 
 clean:
 	ocamlbuild -clean
-	rm -f Client/*~ Client/JsHandler.js
+	rm -f Client/*~ Client/JsEval.js Client/JsHandler.js
 	rm -f *.cmx *.cmi *.o *.cmo *.a *.cmxa *.cma *.annot *~ TossServer
 	rm -f Formula/*~ Solver/*~ Arena/*~ Learn/*~ Play/*~ GGP/*~ Server/*~
 	rm -f caml_extensions/*.cmo caml_extensions/*.cmi Formula/Resources.ml

Modified: trunk/Toss/Server/Tests.ml
===================================================================
--- trunk/Toss/Server/Tests.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Server/Tests.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -13,6 +13,16 @@
   "FFTNFTest",         [FFTNFTest.tests];
 ]
 
+let term_tests = "Term", [
+  "TermTypeTest",       [TermTypeTest.tests];
+  "SyntaxDefTest",      [SyntaxDefTest.tests];
+  "BuiltinLangTest",    [BuiltinLangTest.tests];
+  "TermTest",           [TermTest.tests];
+  "RewritingTest",      [RewritingTest.tests];
+  "ParseArcTest",       [ParseArcTest.tests];
+  "TRSTest",   		[TRSTest.tests; TRSTest.bigtests];
+]
+
 let solver_tests = "Solver", [
   "NaturalsTest",       [NaturalsTest.tests];
   "IntegersTest",       [IntegersTest.tests; IntegersTest.bigtests];
@@ -33,19 +43,9 @@
 let arena_tests = "Arena", [
   "DiscreteRuleTest",   [DiscreteRuleTest.tests];
   "ContinuousRuleTest", [ContinuousRuleTest.tests];
-  "ArenaTest",          [ArenaTest.tests];
+  "ArenaTest",          [ArenaTest.tests; ArenaTest.bigtests];
 ]
 
-let term_tests = "Term", [
-  "TermTypeTest",       [TermTypeTest.tests];
-  "SyntaxDefTest",      [SyntaxDefTest.tests];
-  "BuiltinLangTest",    [BuiltinLangTest.tests];
-  "TermTest",           [TermTest.tests];
-  "RewritingTest",      [RewritingTest.tests];
-  "ParseArcTest",       [ParseArcTest.tests];
-  "TRSTest",   		[TRSTest.tests; TRSTest.bigtests];
-]
-
 let play_tests = "Play", [
   "HeuristicTest",  [HeuristicTest.tests; HeuristicTest.bigtests];
   "GameTreeTest",   [GameTreeTest.tests];
@@ -70,9 +70,9 @@
 
 let tests_l = [
   formula_tests;
+  term_tests;
   solver_tests;
   arena_tests;
-  term_tests;
   play_tests;
   ggp_tests;
   learn_tests;
@@ -90,4 +90,3 @@
   let fts = if dirs = [] then tests_l else
       List.filter (fun (d, _) -> List.mem d dirs) tests_l in
   "T" >::: (List.flatten (List.map filter_tst fts))
-

Modified: trunk/Toss/Solver/AssignmentSet.ml
===================================================================
--- trunk/Toss/Solver/AssignmentSet.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/AssignmentSet.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -122,23 +122,23 @@
     List.rev_map Array.of_list 
       (Aux.product
 	 (List.rev_map (fun _ -> Structure.Elems.elements elems) vars))
-  | FO (v, (e,other_aset)::asg_list) when e < 0 ->
+  | FO (v, (e,other_aset)::asg_list) as asg when e < 0 ->
     let asg_list = List.map (fun e ->
       e, try List.assoc e asg_list with Not_found -> other_aset)
       (Structure.Elems.elements elems) in
     let (idx, vs) = 
       try (Aux.find_index v vars, Aux.remove_one v vars) 
-      with Not_found -> failwith ("assigned var " ^ v ^ " not in " ^ 
-				     (String.concat "," vars)) in
+      with Not_found -> failwith ("tuples: in " ^ (str asg) ^ " assigned var "^
+				     v ^" not in "^ (String.concat "," vars)) in
     let prolong e asg =
       Array.of_list (Aux.insert_nth idx e (Array.to_list asg)) in
     List.concat (List.rev_map (fun (e, asg) -> 
       List.rev_map (prolong e) (tuples elems vs asg)) asg_list)
-  | FO (v, asg_list) ->
+  | FO (v, asg_list) as asg ->
     let (idx, vs) = 
       try (Aux.find_index v vars, Aux.remove_one v vars) 
-      with Not_found -> failwith ("assigned var " ^ v ^ " not in " ^
-				     (String.concat "," vars)) in
+      with Not_found -> failwith ("tuples: in " ^ (str asg) ^ " assigned var "^
+				     v ^" not in "^ (String.concat "," vars)) in
     let prolong e asg =
       Array.of_list (Aux.insert_nth idx e (Array.to_list asg)) in
     List.concat (List.rev_map (fun (e, asg) -> 

Modified: trunk/Toss/Solver/Assignments.mli
===================================================================
--- trunk/Toss/Solver/Assignments.mli	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/Assignments.mli	2012-06-02 21:13:38 UTC (rev 1718)
@@ -10,7 +10,10 @@
    If an assignment set is not Empty, then it cannot contain Empty leafs. *)
 type assignment_set = AssignmentSet.assignment_set
 
+(* The order on variables we use; might differ from Formula.compare_vars! *)
+val compare_vars : string -> string -> int
 
+
 (** {2 List or Set Type} *)
 
 

Modified: trunk/Toss/Solver/Solver.ml
===================================================================
--- trunk/Toss/Solver/Solver.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/Solver.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -272,8 +272,9 @@
     | Sum (vl, _, r) ->
       List.filter (fun w -> not (List.mem w vl)) (fo_vars_r_rec r)
     | RLet _ as re -> fo_vars_r_rec (FormulaSubst.expand_real_expr re) in
+  let cmp_vars v1 v2 = Assignments.compare_vars (var_str v1) (var_str v2) in
   let fo_vars_real re = 
-    remove_dup_vars [] (List.sort compare_vars (fo_vars_r_rec re)) in
+    remove_dup_vars [] (List.sort cmp_vars (fo_vars_r_rec re)) in
   let rec sum_polys = function
     | Empty -> Poly.Const 0.
     | Any -> failwith "absolute assignement for sum,impossible to calc"
@@ -330,7 +331,7 @@
       let asg_list = List.fold_left append_elem_asg [] (slist elems) in
       if asg_list = [] then Empty else
         FO (var_str v, List.rev asg_list) in
-  process_vars [] (List.sort Formula.compare_vars (fo_vars_real p))
+  process_vars [] (List.sort cmp_vars (fo_vars_real p))
 
 let eval_counter = ref 0
 

Modified: trunk/Toss/Solver/SolverTest.ml
===================================================================
--- trunk/Toss/Solver/SolverTest.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/SolverTest.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -160,7 +160,10 @@
 	"{ x->3 }";
       eval_eq "[ | R { (a, a); (a, b) } | ] " ":(all y (R (x, y))) > 0"
 	"{ x->1 }";
-    ); 
+      eval_eq "[ 1 - 4 | | - ]" 
+	"all a, b( :nbr(a) * :nbr(b) = :nbr(z) ->(:nbr(a) = 1 or :nbr(b) = 1) )"
+	"{ z->1, z->2, z->3 }";
+    );
 
   "eval: game heuristic tests" >::
     (fun () ->
@@ -349,6 +352,19 @@
 \"" (chess_phi ^ "IsA8(x) and not CheckW()") "{ x->57 }";
     );
 
+  "eval: three coloring" >::
+    (fun () ->
+      eval_eq "[ | E { (a, b); (b, a); (a, c); (c, a); (b, c); (c, b) } | ]"
+	("ex R, G, B all x, y ( (x in R or x in G or x in B) and  ( E(x,y) -> "^
+	    "not( (x in R and y in R) or (x in G and y in G) or " ^
+	    "     (x in B and y in B) ) ) )") "T";
+      eval_eq ("[ | E { (a, b); (b, a); (a, c); (c, a); (b, c); (c, b); " ^ 
+		  " (a, d); (d, a); (b, d); (d, b); (c, d); (d, c) } | ]")
+	("ex R, G, B all x, y ( (x in R or x in G or x in B) and  ( E(x,y) -> "^
+	    "not( (x in R and y in R) or (x in G and y in G) or " ^
+	    "     (x in B and y in B) ) ) )") "{}";
+    );
+
   (*"eval: four points problem" >::
     (fun () ->
       eval_eq "[ | P {x}; Q {y}; Z {z}; S {v} | ]"

Modified: trunk/Toss/Solver/Structure.ml
===================================================================
--- trunk/Toss/Solver/Structure.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/Structure.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -403,13 +403,25 @@
     
 let create_from_lists_position ?struc els rels =
   let s = create_from_lists ?struc els rels [] in
-  let elems = Elems.elements s.elements in
+  let elems = List.sort (fun x y -> x - y) (Elems.elements s.elements) in
   let zero = List.map (fun e -> (e, 0.)) elems in
-  let next = List.map (fun e -> (e, cBOARD_DX*. (float_of_int (e-1)))) elems in
+  let (_, next) = List.fold_left (fun (cur, acc) e -> 
+    (cur +. cBOARD_DX, (e, cur) :: acc)) (0., []) elems in
   let afuns s (fn, asg) = add_funs s fn asg in
   List.fold_left afuns s [("x", next); ("y", zero); ("vx", zero); ("vy", zero)]
 
+let create_from_lists_range start ?struc els rels =
+  let s = create_from_lists ?struc els rels [] in
+  let elems = List.sort (fun x y -> x - y) (Elems.elements s.elements) in
+  let zero = List.map (fun e -> (e, 0.)) elems in
+  let (_, nextnbr) = List.fold_left (fun (cur, acc) e -> 
+    (cur +. 1., (e, cur) :: acc)) (start, []) elems in
+  let (_, nextx) = List.fold_left (fun (cur, acc) e -> 
+    (cur +. cBOARD_DX, (e, cur) :: acc)) (0., []) elems in
+  let afuns s (fn, asg) = add_funs s fn asg in
+  List.fold_left afuns s [("x", nextx); ("y", zero); ("nbr", nextnbr);]
 
+
 (* ---------- REMOVING RELATION TUPLES AND ELEMENTS FROM A STRUCTURE -------- *)
 
 (* Remove the tuple [tp] from relation [rn] in structure [struc]. *)

Modified: trunk/Toss/Solver/Structure.mli
===================================================================
--- trunk/Toss/Solver/Structure.mli	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/Structure.mli	2012-06-02 21:13:38 UTC (rev 1718)
@@ -237,10 +237,13 @@
   (string * int option * string array list) list ->
   (string * (string * float) list) list -> structure
 
-val create_from_lists_position : ?struc:structure -> string list ->
-  (string * int option * string array list) list -> structure
+val create_from_lists_position: ?struc:structure ->
+  string list -> (string * int option * string array list) list -> structure
 
+val create_from_lists_range: float -> ?struc:structure ->
+  string list -> (string * int option * string array list) list -> structure
 
+
 (** {2 Removing relation tuples and elements from a structure} *)
 
 (** Remove the tuple [tp] from relation [rn] in structure [struc]. *)

Modified: trunk/Toss/Solver/StructureParser.mly
===================================================================
--- trunk/Toss/Solver/StructureParser.mly	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/StructureParser.mly	2012-06-02 21:13:38 UTC (rev 1718)
@@ -70,6 +70,23 @@
     rels = separated_list (SEMICOLON, rel_expr)
     MID MINUS CLOSESQ
     { fun struc -> create_from_lists_position ~struc elems rels }
+  | OPENSQ n = INT MINUS k = INT
+    MID
+    rels = separated_list (SEMICOLON, rel_expr)
+    MID
+    funs = separated_list (SEMICOLON, fun_expr)
+    CLOSESQ
+    { let elems = 
+	List.map (fun i -> "e" ^ (string_of_int i)) (Aux.range ~from:n (k+1)) in
+      fun struc -> create_from_lists ~struc elems rels funs }
+  | OPENSQ n = INT MINUS k = INT
+    MID
+    rels = separated_list (SEMICOLON, rel_expr)
+    MID MINUS CLOSESQ
+    { let elems = 
+	List.map (fun i -> "e" ^ (string_of_int i)) (Aux.range ~from:n (k+1)) in
+      fun struc -> 
+	create_from_lists_range (float n) ~struc elems rels }
   | OPENSQ
       separated_list (COMMA, ID)
     MID

Modified: trunk/Toss/Solver/StructureTest.ml
===================================================================
--- trunk/Toss/Solver/StructureTest.ml	2012-06-01 21:20:46 UTC (rev 1717)
+++ trunk/Toss/Solver/StructureTest.ml	2012-06-02 21:13:38 UTC (rev 1718)
@@ -63,6 +63,14 @@
         "[ | R (a, b) | f { a-> 1.3, b->2, c->3.3 } ; g { b -> 2 } ]"
     );
 
+  "parse range" >::
+    (fun () ->
+      test_parse
+        ~result:("[e2, e3, e4 |  | nbr {e2->2., e3->3., e4->4.}; "^
+		    "x {e2->0., e3->15., e4->30.}; y {e2->0., e3->0., e4->0.}]")
+	"[ 2 - 4 | | - ]";
+    );
+
   "incident" >::
     (fun () ->
       test_incident "[a, b | R (a, b) | ]"

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