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

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

Revision: 1642
          http://toss.svn.sourceforge.net/toss/?rev=1642&view=rev
Author:   lukaszkaiser
Date:     2012-01-17 02:25:49 +0000 (Tue, 17 Jan 2012)
Log Message:
-----------
Testing js_of_ocaml, some refactoring for that.

Modified Paths:
--------------
    trunk/Toss/Arena/ArenaTest.ml
    trunk/Toss/Arena/ContinuousRuleTest.ml
    trunk/Toss/Arena/DiscreteRuleTest.ml
    trunk/Toss/Arena/TermTest.ml
    trunk/Toss/Formula/Aux.ml
    trunk/Toss/Formula/Aux.mli
    trunk/Toss/Formula/AuxTest.ml
    trunk/Toss/Formula/BoolFormulaTest.ml
    trunk/Toss/Formula/BoolFunctionTest.ml
    trunk/Toss/Formula/FFTNFTest.ml
    trunk/Toss/Formula/FormulaMapTest.ml
    trunk/Toss/Formula/FormulaOpsTest.ml
    trunk/Toss/Formula/FormulaSubstTest.ml
    trunk/Toss/Formula/FormulaTest.ml
    trunk/Toss/Formula/Sat/Sat.ml
    trunk/Toss/Formula/Sat/SatTest.ml
    trunk/Toss/GGP/GDLTest.ml
    trunk/Toss/GGP/GameSimplTest.ml
    trunk/Toss/GGP/TranslateFormulaTest.ml
    trunk/Toss/GGP/TranslateGameTest.ml
    trunk/Toss/Makefile
    trunk/Toss/Play/GameTree.ml
    trunk/Toss/Play/GameTreeTest.ml
    trunk/Toss/Play/HeuristicTest.ml
    trunk/Toss/Play/MoveTest.ml
    trunk/Toss/Play/PlayTest.ml
    trunk/Toss/Server/DB.ml
    trunk/Toss/Server/PictureTest.ml
    trunk/Toss/Server/ReqHandler.ml
    trunk/Toss/Server/ReqHandlerTest.ml
    trunk/Toss/Server/Server.ml
    trunk/Toss/Solver/AssignmentsTest.ml
    trunk/Toss/Solver/ClassTest.ml
    trunk/Toss/Solver/SolverTest.ml
    trunk/Toss/Solver/StructureTest.ml

Added Paths:
-----------
    trunk/Toss/Formula/AuxIO.ml
    trunk/Toss/Formula/AuxIO.mli
    trunk/Toss/js_of_ocaml_test.html
    trunk/Toss/js_of_ocaml_test.ml

Modified: trunk/Toss/Arena/ArenaTest.ml
===================================================================
--- trunk/Toss/Arena/ArenaTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/ArenaTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -116,7 +116,7 @@
       (* skip_if true "Change to simpler and stable example."; *)
       let fname = "./examples/rewriting_example.toss" in
       let file = open_in fname in
-      let contents = Aux.input_file file in
+      let contents = AuxIO.input_file file in
       let s = "SET STATE #" ^ fname ^ "#" ^ contents in
       let (gs,_) = Arena.handle_request Arena.empty_state (req_of_str s) in
       let (_, msg) =
@@ -126,5 +126,4 @@
     );
 ]
 
-let a =
-  Aux.run_test_if_target "ArenaTest" tests
+let a = AuxIO.run_test_if_target "ArenaTest" tests

Modified: trunk/Toss/Arena/ContinuousRuleTest.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRuleTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/ContinuousRuleTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -171,5 +171,4 @@
 
 ]
 
-let a =
-  Aux.run_test_if_target "ContinuousRuleTest" tests
+let a = AuxIO.run_test_if_target "ContinuousRuleTest" tests

Modified: trunk/Toss/Arena/DiscreteRuleTest.ml
===================================================================
--- trunk/Toss/Arena/DiscreteRuleTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/DiscreteRuleTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -801,8 +801,7 @@
 
 ]
 
-let a =
-  Aux.run_test_if_target "DiscreteRuleTest" tests
+let a = AuxIO.run_test_if_target "DiscreteRuleTest" tests
 
 let a () = DiscreteRule.debug_level := 7
 

Modified: trunk/Toss/Arena/TermTest.ml
===================================================================
--- trunk/Toss/Arena/TermTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/TermTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -67,5 +67,4 @@
     );
 ];;
 
-let a =
-  Aux.run_test_if_target "TermTest" tests
+let a = AuxIO.run_test_if_target "TermTest" tests

Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Aux.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -1,6 +1,9 @@
 (* Auxiliary functions that operate on standard library data
    structures and standard library-like definitions. *)
 
+let gettimeofday () = Unix.gettimeofday (); (* 1. *)
+
+
 exception Timeout of string
 
 type ('a,'b) choice = Left of 'a | Right of 'b
@@ -50,6 +53,15 @@
   (c = '0') || (c = '1') || (c = '2') || (c = '3') || (c = '4') || 
     (c = '5') || (c = '6') || (c = '7') || (c = '8') || (c = '9') 
 
+let is_space c =
+  c = '\n' || c = '\r' || c = ' ' || c = '\t'
+
+let strip_spaces s =
+  let (b, e) = (ref 0, ref ((String.length s) - 1)) in
+  while !b < !e && is_space (s.[!b]) do incr b done;
+  while !b <= !e && is_space (s.[!e]) do decr e done;
+  if !e < !b then "" else String.sub s !b (!e - !b + 1)
+
 let fst3 (a,_,_) = a
 let snd3 (_,a,_) = a
 let trd3 (_,_,a) = a
@@ -259,10 +271,11 @@
     ) img) [[]] (List.rev dom)
 
 
-let product_size l = 
-  let size = List.fold_left (fun size subl -> 
-    Big_int.mult_int_big_int (List.length subl) size) Big_int.unit_big_int l in
-  try Big_int.int_of_big_int size with _ -> max_int
+let product_size l =
+  let safe_mul size sublist =
+    let l = List.length sublist in
+    if l = 0 || max_int / l > size then l * size else max_int in
+  List.fold_left safe_mul 1 l
 
 let product ?upto ?(timeout = fun () -> false) l =
   let _ = match upto with None -> () | Some n -> 
@@ -716,112 +729,9 @@
       Format.fprintf f "%a%a" f_el hd pr_tail tl
 
 
-let run_if_target target_name f =
-  let file_from_path p =
-    String.sub p (String.rindex p '/'+1)
-      (String.length p - String.rindex p '/' - 1) in
-  let test_fname =
-    let fname = file_from_path Sys.executable_name in
-    String.length fname >= String.length target_name &&
-    String.sub fname 0 (String.length target_name) = target_name in
-  if test_fname then f ()
-
-let run_test_if_target target_name tests =
-  let f () = ignore (OUnit.run_test_tt ~verbose:true tests) in
-  (* So that the tests are not run twice while building TossTest. *)
-  run_if_target target_name f
-
 let set_optimized_gc () =
   Gc.set { (Gc.get()) with
     Gc.space_overhead = 300;  (* 300% instead of 80% std *)
     Gc.minor_heap_size = 160*1024; (* 4*std, opt ~= L2 cache/proc *)
     Gc.major_heap_increment = 8*124*1024 (* 8*std ok *) 
   }
-
-let rec input_file file =
-  let buf = Buffer.create 256 in
-  (try
-     while true do Buffer.add_channel buf file 1 done
-   with End_of_file -> ());
-  Buffer.contents buf
-
-let list_dir dirname =
-  let files, dir_handle = (ref [], Unix.opendir dirname) in
-  let rec add () = files := (Unix.readdir dir_handle) :: !files; add () in
-  try add () with End_of_file -> Unix.closedir dir_handle; !files
-
-let is_space c =
-  c = '\n' || c = '\r' || c = ' ' || c = '\t'
-
-let strip_spaces s =
-  let (b, e) = (ref 0, ref ((String.length s) - 1)) in
-  while !b < !e && is_space (s.[!b]) do incr b done;
-  while !b <= !e && is_space (s.[!e]) do decr e done;
-  if !e < !b then "" else String.sub s !b (!e - !b + 1)
-
-let rec input_http_message file =
-  let buf = Buffer.create 256 in
-  let get_pair s = 
-    let i, l = String.index s '=', String.length s in
-    (String.sub s 0 i, String.sub s (i+1) (l-i-1)) in
-  let rec get_cookies s = 
-    try
-      let i, l = String.index s ';', String.length s in
-      (get_pair (String.sub s 0 i)) :: get_cookies (String.sub s (i+1) (l-i-1))
-    with Not_found -> [] in
-  let line, head, cookies, msg_len = ref "HTTP", ref [], ref [], ref 0 in
-  while !line <> "" do
-    line := strip_spaces (input_line file);
-    head := !line :: !head;
-    let line_len = String.length !line in
-    if line_len > 6 && String.lowercase (String.sub !line 0 6) = "cookie" then (
-      let start = (String.index !line ' ') + 1 in
-      let ck_str = String.sub !line start (line_len - start) in
-      cookies := get_cookies (ck_str ^ ";") @ !cookies
-    );
-    if line_len > 16 && 
-      String.lowercase (String.sub !line 0 15) = "content-length:" then (
-	msg_len := int_of_string (String.sub !line 16 (line_len - 16));
-      )
-  done;
-  Buffer.add_channel buf file !msg_len;
-  (String.concat "\n" !head, Buffer.contents buf, !cookies)
-
-let input_if_http_message line in_ch =
-  let ht1, ht2 = "GET /", "POST /" in
-  let l1, l2, l = String.length ht1, String.length ht2, String.length line in
-  if ((l > l1 && String.sub line 0 l1 = ht1) ||
-	 (l > l2 && String.sub line 0 l2 = ht2)) then
-    Some (input_http_message in_ch)
-  else None
-
-exception Host_not_found
-
-let get_inet_addr addr_s =
-  try
-    Unix.inet_addr_of_string addr_s
-  with Failure _ ->
-    try
-      let addr_arr = (Unix.gethostbyname addr_s).Unix.h_addr_list in
-      if Array.length addr_arr < 1 then raise Host_not_found else
-        addr_arr.(0)
-    with Not_found -> raise Host_not_found
-
-let toss_call (client_port, client_addr_s) f_in x =
-  try
-    let client_addr = get_inet_addr client_addr_s in
-    let client_sock = Unix.ADDR_INET (client_addr, client_port) in
-    let (cl_in_ch, cl_out_ch) = Unix.open_connection client_sock in
-    output_string cl_out_ch "COMP\n";
-    flush cl_out_ch;
-    let f a = try `Res (f_in a) with exn -> `Exn exn in
-    Marshal.to_channel cl_out_ch (f, x) [Marshal.Closures];
-    flush cl_out_ch;
-    (fun () ->
-      let res = Marshal.from_channel cl_in_ch in
-      Unix.shutdown_connection cl_in_ch;
-      match res with `Res r -> r | `Exn e -> raise e)
-  with Unix.Unix_error (e, f, s) ->
-    Printf.printf "Toss call failed: %s; %s %s\n%!" (Unix.error_message e) f s;
-    (fun () -> f_in x)
-    

Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Aux.mli	2012-01-17 02:25:49 UTC (rev 1642)
@@ -1,6 +1,10 @@
 (** Auxiliary functions that operate on standard library data
     structures and standard library-like definitions. *)
 
+(** Replacement for Unix.gettimeofday. *)
+val gettimeofday: unit -> float
+
+
 exception Timeout of string
 
 type ('a, 'b) choice = Left of 'a | Right of 'b
@@ -349,37 +353,5 @@
   ?newline : int -> string -> (Format.formatter -> 'a -> unit) ->
   Format.formatter -> 'a list -> unit
 
-(** Run a function if the executable name matches the given prefix. *)
-val run_if_target : string -> (unit -> unit) -> unit
-
-(** Run a test suite if the executable name matches the given prefix. *)
-val run_test_if_target : string -> OUnit.test -> unit
-
 (** Set more agressive Gc values optimized for heavier computations. *)
 val set_optimized_gc : unit -> unit
-
-(** Input a file to a string. *)
-val input_file : in_channel -> string
-
-(** List the contents of a directory *)
-val list_dir : string -> string list
-
-(** Extracting the [Content-length] field and input the content of
-    an HTTP message. Return the pair: header first, content next. *)
-val input_http_message : in_channel -> string * string * (string * string) list
-
-(** Input HTTP message if [line] is a http header, ie. "GET /" or "POST /".*)
-val input_if_http_message : string -> in_channel ->
-  (string * string * (string * string) list) option
-
-(** Exception used in connections when the host is not found. *)
-exception Host_not_found
-
-(** Determine the internet address or raise Host_not_found. *)
-val get_inet_addr : string -> Unix.inet_addr
-
-(** Call a Toss Server on [port, server] to compute [f] on [x]. BEWARE: 
-    (1) references are not sent, e.g. you must redo timeouts.
-    (2) on single-threaded servers handling calls (older Toss versions),
-        you have to collect the results, even on Exception in caller *)
-val toss_call : int * string -> ('a -> 'b) -> 'a -> (unit -> 'b)

Added: trunk/Toss/Formula/AuxIO.ml
===================================================================
--- trunk/Toss/Formula/AuxIO.ml	                        (rev 0)
+++ trunk/Toss/Formula/AuxIO.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,99 @@
+(* Auxiliary functions that operate on standard library data
+   structures and standard library-like definitions. *)
+open Aux
+
+
+let run_if_target target_name f =
+  let file_from_path p =
+    String.sub p (String.rindex p '/'+1)
+      (String.length p - String.rindex p '/' - 1) in
+  let test_fname =
+    let fname = file_from_path Sys.executable_name in
+    String.length fname >= String.length target_name &&
+    String.sub fname 0 (String.length target_name) = target_name in
+  if test_fname then f ()
+
+let run_test_if_target target_name tests =
+  let f () = ignore (OUnit.run_test_tt ~verbose:true tests) in
+  (* So that the tests are not run twice while building TossTest. *)
+  run_if_target target_name f
+
+
+
+let rec input_file file =
+  let buf = Buffer.create 256 in
+  (try
+     while true do Buffer.add_channel buf file 1 done
+   with End_of_file -> ());
+  Buffer.contents buf
+
+let list_dir dirname =
+  let files, dir_handle = (ref [], Unix.opendir dirname) in
+  let rec add () = files := (Unix.readdir dir_handle) :: !files; add () in
+  try add () with End_of_file -> Unix.closedir dir_handle; !files
+
+let rec input_http_message file =
+  let buf = Buffer.create 256 in
+  let get_pair s = 
+    let i, l = String.index s '=', String.length s in
+    (String.sub s 0 i, String.sub s (i+1) (l-i-1)) in
+  let rec get_cookies s = 
+    try
+      let i, l = String.index s ';', String.length s in
+      (get_pair (String.sub s 0 i)) :: get_cookies (String.sub s (i+1) (l-i-1))
+    with Not_found -> [] in
+  let line, head, cookies, msg_len = ref "HTTP", ref [], ref [], ref 0 in
+  while !line <> "" do
+    line := strip_spaces (input_line file);
+    head := !line :: !head;
+    let line_len = String.length !line in
+    if line_len > 6 && String.lowercase (String.sub !line 0 6) = "cookie" then (
+      let start = (String.index !line ' ') + 1 in
+      let ck_str = String.sub !line start (line_len - start) in
+      cookies := get_cookies (ck_str ^ ";") @ !cookies
+    );
+    if line_len > 16 && 
+      String.lowercase (String.sub !line 0 15) = "content-length:" then (
+	msg_len := int_of_string (String.sub !line 16 (line_len - 16));
+      )
+  done;
+  Buffer.add_channel buf file !msg_len;
+  (String.concat "\n" !head, Buffer.contents buf, !cookies)
+
+let input_if_http_message line in_ch =
+  let ht1, ht2 = "GET /", "POST /" in
+  let l1, l2, l = String.length ht1, String.length ht2, String.length line in
+  if ((l > l1 && String.sub line 0 l1 = ht1) ||
+	 (l > l2 && String.sub line 0 l2 = ht2)) then
+    Some (input_http_message in_ch)
+  else None
+
+exception Host_not_found
+
+let get_inet_addr addr_s =
+  try
+    Unix.inet_addr_of_string addr_s
+  with Failure _ ->
+    try
+      let addr_arr = (Unix.gethostbyname addr_s).Unix.h_addr_list in
+      if Array.length addr_arr < 1 then raise Host_not_found else
+        addr_arr.(0)
+    with Not_found -> raise Host_not_found
+
+let toss_call (client_port, client_addr_s) f_in x =
+  try
+    let client_addr = get_inet_addr client_addr_s in
+    let client_sock = Unix.ADDR_INET (client_addr, client_port) in
+    let (cl_in_ch, cl_out_ch) = Unix.open_connection client_sock in
+    output_string cl_out_ch "COMP\n";
+    flush cl_out_ch;
+    let f a = try `Res (f_in a) with exn -> `Exn exn in
+    Marshal.to_channel cl_out_ch (f, x) [Marshal.Closures];
+    flush cl_out_ch;
+    (fun () ->
+      let res = Marshal.from_channel cl_in_ch in
+      Unix.shutdown_connection cl_in_ch;
+      match res with `Res r -> r | `Exn e -> raise e)
+  with Unix.Unix_error (e, f, s) ->
+    Printf.printf "Toss call failed: %s; %s %s\n%!" (Unix.error_message e) f s;
+    (fun () -> f_in x)

Added: trunk/Toss/Formula/AuxIO.mli
===================================================================
--- trunk/Toss/Formula/AuxIO.mli	                        (rev 0)
+++ trunk/Toss/Formula/AuxIO.mli	2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,36 @@
+(** Auxiliary functions that operate on standard library data
+    structures and standard library-like definitions. *)
+
+
+(** Run a function if the executable name matches the given prefix. *)
+val run_if_target : string -> (unit -> unit) -> unit
+
+(** Run a test suite if the executable name matches the given prefix. *)
+val run_test_if_target : string -> OUnit.test -> unit
+
+
+(** Input a file to a string. *)
+val input_file : in_channel -> string
+
+(** List the contents of a directory *)
+val list_dir : string -> string list
+
+(** Extracting the [Content-length] field and input the content of
+    an HTTP message. Return the pair: header first, content next. *)
+val input_http_message : in_channel -> string * string * (string * string) list
+
+(** Input HTTP message if [line] is a http header, ie. "GET /" or "POST /".*)
+val input_if_http_message : string -> in_channel ->
+  (string * string * (string * string) list) option
+
+(** Exception used in connections when the host is not found. *)
+exception Host_not_found
+
+(** Determine the internet address or raise Host_not_found. *)
+val get_inet_addr : string -> Unix.inet_addr
+
+(** Call a Toss Server on [port, server] to compute [f] on [x]. BEWARE: 
+    (1) references are not sent, e.g. you must redo timeouts.
+    (2) on single-threaded servers handling calls (older Toss versions),
+        you have to collect the results, even on Exception in caller *)
+val toss_call : int * string -> ('a -> 'b) -> 'a -> (unit -> 'b)

Modified: trunk/Toss/Formula/AuxTest.ml
===================================================================
--- trunk/Toss/Formula/AuxTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/AuxTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -483,5 +483,4 @@
 
 ]
 
-let a =
-  Aux.run_test_if_target "AuxTest" tests
+let _ = AuxIO.run_test_if_target "AuxTest" tests

Modified: trunk/Toss/Formula/BoolFormulaTest.ml
===================================================================
--- trunk/Toss/Formula/BoolFormulaTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/BoolFormulaTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -410,9 +410,9 @@
     );
 ]
 
-let exec () = Aux.run_test_if_target "BoolFormulaTest" tests
+let exec () = AuxIO.run_test_if_target "BoolFormulaTest" tests
 
-let execbig ()= Aux.run_test_if_target "BoolFormulaTest" bigtests
+let execbig ()= AuxIO.run_test_if_target "BoolFormulaTest" bigtests
 
 
 let main () =
@@ -431,4 +431,4 @@
     print_endline (BoolFormula.str (elim_quant qbf))
   )
 
-let _ = Aux.run_if_target "BoolFormulaTest" main
+let _ = AuxIO.run_if_target "BoolFormulaTest" main

Modified: trunk/Toss/Formula/BoolFunctionTest.ml
===================================================================
--- trunk/Toss/Formula/BoolFunctionTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/BoolFunctionTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -127,7 +127,7 @@
   Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
   if !file = "" then ignore (OUnit.run_test_tt ~verbose:true tests) else
     let f = open_in !file in
-    let file_s = Aux.input_file f in
+    let file_s = AuxIO.input_file f in
     close_in f;
     let cleaned_s1 = Str.global_replace (Str.regexp "bool") "" file_s in
     let cleaned_s2 = Str.global_replace (Str.regexp "^.*<.*$") "" cleaned_s1 in
@@ -157,4 +157,4 @@
     )
       
 
-let _ = Aux.run_if_target "BoolFunctionTest" main
+let _ = AuxIO.run_if_target "BoolFunctionTest" main

Modified: trunk/Toss/Formula/FFTNFTest.ml
===================================================================
--- trunk/Toss/Formula/FFTNFTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FFTNFTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -346,8 +346,7 @@
 
 ]
 
-let a =
-  Aux.run_test_if_target "FFTNFTest" tests
+let a = AuxIO.run_test_if_target "FFTNFTest" tests
 
 let a () = FFTNF.debug_level := 7
 

Modified: trunk/Toss/Formula/FormulaMapTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaMapTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaMapTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -42,4 +42,4 @@
     );
 ]
 
-let exec = Aux.run_test_if_target "FormulaMapTest" tests
+let exec = AuxIO.run_test_if_target "FormulaMapTest" tests

Modified: trunk/Toss/Formula/FormulaOpsTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaOpsTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaOpsTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -310,7 +310,7 @@
 
 ]
 
-let exec = Aux.run_test_if_target "FormulaOpsTest" tests
+let exec = AuxIO.run_test_if_target "FormulaOpsTest" tests
 
 
 (* --------------------------- Reals separation  test ----------------------- *)

Modified: trunk/Toss/Formula/FormulaSubstTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubstTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaSubstTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -155,4 +155,4 @@
 
 ]
 
-let exec = Aux.run_test_if_target "FormulaSubstTest" tests
+let exec = AuxIO.run_test_if_target "FormulaSubstTest" tests

Modified: trunk/Toss/Formula/FormulaTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -40,4 +40,4 @@
 ]
 
 
-let exec = Aux.run_test_if_target "FormulaTest" tests
+let exec = AuxIO.run_test_if_target "FormulaTest" tests

Modified: trunk/Toss/Formula/Sat/Sat.ml
===================================================================
--- trunk/Toss/Formula/Sat/Sat.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Sat/Sat.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -6,12 +6,12 @@
 let timeout = ref 0.
 let minisat_timeout = ref 900.
 let check_timeout msg = 
-  if !timeout > 0.5 && Unix.gettimeofday () > !timeout then
+  if !timeout > 0.5 && Aux.gettimeofday () > !timeout then
     (timeout := 0.; raise (Aux.Timeout msg))
 
 let set_timeout t = 
   minisat_timeout := 5. *. t; (* if MiniSat does it, it's important *)
-  timeout := Unix.gettimeofday () +. t
+  timeout := Aux.gettimeofday () +. t
 
 let clear_timeout () = (timeout := 0.; minisat_timeout := 900.)
 

Modified: trunk/Toss/Formula/Sat/SatTest.ml
===================================================================
--- trunk/Toss/Formula/Sat/SatTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Sat/SatTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -215,6 +215,6 @@
 
 
 let exec = (
-  Aux.run_test_if_target "SatTest" tests;
-  Aux.run_test_if_target "SatTest" bigtests;
+  AuxIO.run_test_if_target "SatTest" tests;
+  AuxIO.run_test_if_target "SatTest" bigtests;
 )

Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/GDLTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -511,4 +511,4 @@
   (* failwith "tested"; *)
   ()
 
-let exec = Aux.run_test_if_target "GDLTest" tests
+let exec = AuxIO.run_test_if_target "GDLTest" tests

Modified: trunk/Toss/GGP/GameSimplTest.ml
===================================================================
--- trunk/Toss/GGP/GameSimplTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/GameSimplTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -14,8 +14,7 @@
 ]
 
 
-let a () =
-  Aux.run_test_if_target "GameSimplTest" tests
+let a () = AuxIO.run_test_if_target "GameSimplTest" tests
 
 let a () =
   match test_filter

Modified: trunk/Toss/GGP/TranslateFormulaTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormulaTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/TranslateFormulaTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -108,4 +108,4 @@
 let a () =
   ()
 
-let exec = Aux.run_test_if_target "TranslateFormulaTest" tests
+let exec = AuxIO.run_test_if_target "TranslateFormulaTest" tests

Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/TranslateGameTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -51,7 +51,7 @@
     TranslateGame.translate_game ~playing_as:(Const player) game in
   let goal_name = game_name^"-simpl.toss" in
   (* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
-  let goal_str = Aux.input_file (open_in ("./GGP/tests/"^goal_name)) in
+  let goal_str = AuxIO.input_file (open_in ("./GGP/tests/"^goal_name)) in
   let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
   let res_str = Arena.state_str (r_game, r_struc) in
   output_string resf res_str;
@@ -151,7 +151,7 @@
     TranslateGame.translate_game ~playing_as:(Const player) game in
   let goal_name = game_name^"-simpl.toss" in
   (* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
-  let goal_str = Aux.input_file (open_in ("./GGP/tests/"^goal_name)) in
+  let goal_str = AuxIO.input_file (open_in ("./GGP/tests/"^goal_name)) in
   let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
   let res_str = Arena.state_str (r_game, r_struc) in
   output_string resf res_str;
@@ -461,7 +461,7 @@
 let translate_dir_tests dirname from_file timeout =
   let is_gdl fn = (String.length fn > 4) &&
     String.sub fn ((String.length fn) - 4) 4 = ".gdl" in
-  let files = List.sort compare (List.filter is_gdl (Aux.list_dir dirname)) in
+  let files = List.sort compare (List.filter is_gdl (AuxIO.list_dir dirname)) in
   let from_file = 
     try let r = String.rindex from_file '/' in
 	String.sub from_file (r+1) ((String.length from_file)-r-1)
@@ -484,7 +484,7 @@
   ("TranslateGame " ^ dirname) >::: (List.map mk_tst files)
 
 let exec () =
-  Aux.run_test_if_target "TranslateGameTest"
+  AuxIO.run_test_if_target "TranslateGameTest"
     ("TranslateGame" >::: [tests; bigtests])
 
 
@@ -503,8 +503,8 @@
   if !file <> "" && !testdir = "" then 
     print_endline (snd (translate_file !file (Some !timeout)))
   else if !testdir <> "" then
-    Aux.run_test_if_target "TranslateGameTest"
+    AuxIO.run_test_if_target "TranslateGameTest"
       (translate_dir_tests !testdir !file !timeout)
   else exec ()
       
-let _ = Aux.run_if_target "TranslateGameTest" main
+let _ = AuxIO.run_if_target "TranslateGameTest" main

Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Makefile	2012-01-17 02:25:49 UTC (rev 1642)
@@ -3,6 +3,9 @@
 TossServer: Server/Server.native
 	cp _build/Server/Server.native TossServer
 
+js_of_ocaml_test.js: js_of_ocaml_test.byte
+	js_of_ocaml js_of_ocaml_test.byte
+
 RELEASE=0.6
 Release: TossServer doc
 	rm -f *~ Formula/*~ Solver/*~ Arena/*~ Play/*~ GGP/*~ \
@@ -32,12 +35,15 @@
 
 # -------- MAIN OCAMLBUILD PART --------
 
-OCB_LFLAG=-lflags -I,+oUnit,-I,+sqlite3,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
-OCB_CFLAG=-cflags -I,+oUnit,-I,+sqlite3,-I,+site-lib/oUnit,-I,+site-lib/sqlite3,-g
+OCB_LFLAG=-lflags -I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
+OCB_CFLAG=-cflags -I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3,-g
 OCB_LIB=-libs str,nums,unix,oUnit,sqlite3
-OCB_PP=-pp "camlp4o ../caml_extensions/pa_let_try.cmo"
+OCB_LIBJS=-libs str,js_of_ocaml
+OCB_PP=-pp "camlp4o ../caml_extensions/pa_let_try.cmo js_of_ocaml/pa_js.cmo"
 OCAMLBUILD=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
 	$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
+OCAMLBUILDJS=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
+	$(OCB_LIBJS) $(OCB_CFLAG) $(OCB_LFLAG)
 OCAMLBUILDNOPP=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf \
 	$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
 
@@ -49,7 +55,7 @@
 LearnINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena
 GGPINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play
 ServerINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Learn
-.INC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Server
+.INC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Learn,Server
 
 %.native: %.ml caml_extensions/pa_let_try.cmo
 	$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
@@ -58,7 +64,7 @@
 	$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
 
 %.byte: %.ml caml_extensions/pa_let_try.cmo
-	$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
+	$(OCAMLBUILDJS) -Is $($(subst /,INC,$(dir $@))) $@
 
 %.d.byte: %.ml caml_extensions/pa_let_try.cmo
 	$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@

Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/GameTree.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -13,7 +13,7 @@
     let l = Array.length a in
     if l = 0 then [||] else if l = 1 then [|f a.(0)|] else (
       let (a1, a2) = (Array.sub a 0 (l/2+1), Array.sub a (l/2+1) (l-(l/2+1))) in
-      let r1 = Aux.toss_call !parallel_toss (Array.map f) a1 in
+      let r1 = AuxIO.toss_call !parallel_toss (Array.map f) a1 in
       (* If the server handling COMP is single-threaded, they must wait for it!
 	 In such case replace the last line with the two lines below.
 	 try let r2 = Array.map f a2 in Array.append (r1 ()) (r2) with exn ->

Modified: trunk/Toss/Play/GameTreeTest.ml
===================================================================
--- trunk/Toss/Play/GameTreeTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/GameTreeTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -72,4 +72,4 @@
 ]
 
 
-let exec = Aux.run_test_if_target "GameTreeTest" tests
+let exec = AuxIO.run_test_if_target "GameTreeTest" tests

Modified: trunk/Toss/Play/HeuristicTest.ml
===================================================================
--- trunk/Toss/Play/HeuristicTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/HeuristicTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -478,11 +478,9 @@
 ]
 
 
-let a =
-  Aux.run_test_if_target "HeuristicTest" tests
+let a = AuxIO.run_test_if_target "HeuristicTest" tests
 
-let a =
-  Aux.run_test_if_target "HeuristicTest" bigtests
+let a = AuxIO.run_test_if_target "HeuristicTest" bigtests
 
 let a () =
   DiscreteRule.debug_level := 4;

Modified: trunk/Toss/Play/MoveTest.ml
===================================================================
--- trunk/Toss/Play/MoveTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/MoveTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -14,8 +14,6 @@
       assert_equal ~printer:(fun x -> x) (Move.move_str_short s mv)
 	"rule{x:1}"
     );
-] ;;
+]
 
-let a =
-  Aux.run_test_if_target "MoveTest" tests
-;;
+let a = AuxIO.run_test_if_target "MoveTest" tests

Modified: trunk/Toss/Play/PlayTest.ml
===================================================================
--- trunk/Toss/Play/PlayTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/PlayTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -718,6 +718,6 @@
 
 (* ----------------- RUN THE TESTS ------------- *)
 
-let exec = Aux.run_test_if_target "PlayTest" tests
+let exec = AuxIO.run_test_if_target "PlayTest" tests
 
-let execbig = Aux.run_test_if_target "PlayTest" bigtests
+let execbig = AuxIO.run_test_if_target "PlayTest" bigtests

Modified: trunk/Toss/Server/DB.ml
===================================================================
--- trunk/Toss/Server/DB.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/DB.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -43,7 +43,7 @@
             "('computer', 'Computer', 'tPlay', 'co...@tp...', 'xxx')");
   let insert_game g =
     let f = open_in (games_path ^ "/" ^ g ^ ".toss") in
-    let toss = Aux.input_file f in
+    let toss = AuxIO.input_file f in
     close_in f;
     exec ("insert into games(game, toss) values ('" ^ g ^ "','" ^ toss ^ "')");
     print_endline ("Added " ^ g) in
@@ -59,7 +59,7 @@
   print_endline "Deleted old games";
   let reload_game g =
     let f = open_in (games_path ^ "/" ^ g ^ ".toss") in
-    let toss = Aux.input_file f in
+    let toss = AuxIO.input_file f in
     close_in f;
     exec ("insert into games(game, toss) values ('" ^ g ^ "','" ^ toss ^ "')");
     print_endline ("Reloading games: added " ^ g) in

Modified: trunk/Toss/Server/PictureTest.ml
===================================================================
--- trunk/Toss/Server/PictureTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/PictureTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -48,4 +48,4 @@
   ) else ignore (OUnit.run_test_tt ~verbose:true tests)
 
 
-let _ = Aux.run_if_target "PictureTest" main
+let _ = AuxIO.run_if_target "PictureTest" main

Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/ReqHandler.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -454,7 +454,7 @@
   if !debug_level > 1 then Printf.printf "SERVING FILE: %s;\n%!" fname;
   if Sys.file_exists fname && not (Sys.is_directory fname) then (
     let f = open_in fname in
-    let content = Aux.input_file f in
+    let content = AuxIO.input_file f in
     close_in f;
     let tp = match String.sub fname ((String.index fname '.') + 1) 2 with
       | "ht" -> "text/html; charset=utf-8"
@@ -841,7 +841,7 @@
       (* String.escaped *) line_in 
       else
       (* String.escaped *) (String.sub line_in 0 (line_in_len-1)) in
-    match Aux.input_if_http_message line_in in_ch with
+    match AuxIO.input_if_http_message line_in in_ch with
       | Some (head, msg, cookies) ->
 	if !debug_level > 0 then Printf.printf "Rcvd: %s\n%!" msg;
 	let ck = List.map (fun (k, v) -> (strip_ws k, strip_ws v)) cookies in

Modified: trunk/Toss/Server/ReqHandlerTest.ml
===================================================================
--- trunk/Toss/Server/ReqHandlerTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/ReqHandlerTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -13,9 +13,9 @@
        with End_of_file -> ());
       close_in in_ch; close_out out_ch;
       let result =
-        Aux.input_file (open_in "./Server/ServerTest.temp") in
+        AuxIO.input_file (open_in "./Server/ServerTest.temp") in
       let target =
-        Aux.input_file (open_in "./Server/ServerTest.out") in
+        AuxIO.input_file (open_in "./Server/ServerTest.out") in
       Sys.remove "./Server/ServerTest.temp";
       assert_equal ~printer:(fun x->x)
         (strip_spaces target) (strip_spaces result)
@@ -37,9 +37,9 @@
        with End_of_file -> ());
       close_in in_ch; close_out out_ch;
       let result =
-        Aux.input_file (open_in "./Server/ServerGDLTest.temp") in
+        AuxIO.input_file (open_in "./Server/ServerGDLTest.temp") in
       let target =
-        Aux.input_file (open_in "./Server/ServerGDLTest.out2") in
+        AuxIO.input_file (open_in "./Server/ServerGDLTest.out2") in
       Sys.remove "./Server/ServerGDLTest.temp";
       assert_equal ~printer:(fun x->x)
         (strip_spaces target) (strip_spaces result);
@@ -49,8 +49,7 @@
 
 ] 
 
-let a =
-  Aux.run_test_if_target "ReqHandlerTest" tests
+let a = AuxIO.run_test_if_target "ReqHandlerTest" tests
 
 let a () =
   GDL.debug_level := 4

Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/Server.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -35,7 +35,7 @@
   Unix.setsockopt_optint sock Unix.SO_LINGER (Some 2);
   Unix.setsockopt_float sock Unix.SO_RCVTIMEO (120.);
   Unix.setsockopt sock Unix.SO_REUSEADDR true;
-  Unix.bind sock (Unix.ADDR_INET (Aux.get_inet_addr (addr_s), port));
+  Unix.bind sock (Unix.ADDR_INET (AuxIO.get_inet_addr (addr_s), port));
   Unix.listen sock 9; (* maximally 9 pending requests *)
   let continue = ref true in
   while !continue do
@@ -243,7 +243,7 @@
     );
     try
       start_server req_handle !port !server
-    with Aux.Host_not_found ->
+    with AuxIO.Host_not_found ->
       print_endline "The host you specified was not found."
   )
 

Modified: trunk/Toss/Solver/AssignmentsTest.ml
===================================================================
--- trunk/Toss/Solver/AssignmentsTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/AssignmentsTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -141,4 +141,4 @@
 ]
 
 
-let exec = Aux.run_test_if_target "AssignmentsTest" tests
+let exec = AuxIO.run_test_if_target "AssignmentsTest" tests

Modified: trunk/Toss/Solver/ClassTest.ml
===================================================================
--- trunk/Toss/Solver/ClassTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/ClassTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -449,7 +449,7 @@
     ignore (OUnit.run_test_tt ~verbose:true bigtests);
   ) else (
     let f = open_in !file in
-    let s = Aux.input_file f in
+    let s = AuxIO.input_file f in
     close_in f;
     let i = Str.search_forward (Str.regexp_string "|=") s 0 in
     let cl_s = String.sub s 0 i in
@@ -464,4 +464,4 @@
   )
 
 
-let _ = Aux.run_if_target "ClassTest" main
+let _ = AuxIO.run_if_target "ClassTest" main

Modified: trunk/Toss/Solver/SolverTest.ml
===================================================================
--- trunk/Toss/Solver/SolverTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/SolverTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -405,6 +405,6 @@
 ]
 
 
-let exec = Aux.run_test_if_target "SolverTest" tests
+let exec = AuxIO.run_test_if_target "SolverTest" tests
 
-let execbig = Aux.run_test_if_target "SolverTest" bigtests
+let execbig = AuxIO.run_test_if_target "SolverTest" bigtests

Modified: trunk/Toss/Solver/StructureTest.ml
===================================================================
--- trunk/Toss/Solver/StructureTest.ml	2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/StructureTest.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -426,5 +426,4 @@
 ]
 
 
-let a =
-  Aux.run_test_if_target "StructureTest" tests
+let a = AuxIO.run_test_if_target "StructureTest" tests

Added: trunk/Toss/js_of_ocaml_test.html
===================================================================
--- trunk/Toss/js_of_ocaml_test.html	                        (rev 0)
+++ trunk/Toss/js_of_ocaml_test.html	2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,13 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+	  "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+  <head>
+    <title>Test</title>
+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+    <script type="text/javascript" src="js_of_ocaml_test.js"></script>
+  </head>
+  <body>
+  <p id="testp"></p>
+  </body>
+</html>

Added: trunk/Toss/js_of_ocaml_test.ml
===================================================================
--- trunk/Toss/js_of_ocaml_test.ml	                        (rev 0)
+++ trunk/Toss/js_of_ocaml_test.ml	2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,17 @@
+let rec fib n = if n < 2 then 1 else fib (n-1) + fib (n-2)
+
+let formula_of_string s = 
+  FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
+
+let nnf s = Formula.str (FormulaOps.nnf (formula_of_string s))
+
+let fibstr () = Js.string (nnf "not (P(x) and Q(x))")
+
+let onload _ =
+  let d = Dom_html.document in
+  let div = Js.Opt.get (d##getElementById (Js.string "testp"))
+    (fun () -> assert false) in
+  Dom.appendChild div (d##createTextNode (fibstr ()));
+  Js._false
+
+let _ = Dom_html.window##onload <- Dom_html.handler onload

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