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

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

Revision: 1679
          http://toss.svn.sourceforge.net/toss/?rev=1679&view=rev
Author:   lukaszkaiser
Date:     2012-02-18 21:54:05 +0000 (Sat, 18 Feb 2012)
Log Message:
-----------
Corrections to make tests run under JS.

Modified Paths:
--------------
    trunk/Toss/Arena/ContinuousRuleTest.ml
    trunk/Toss/Client/clientTest.js
    trunk/Toss/Formula/Aux.ml
    trunk/Toss/Formula/Aux.mli
    trunk/Toss/Makefile
    trunk/Toss/Play/GameTree.ml
    trunk/Toss/Solver/Num/Integers.ml
    trunk/Toss/Solver/Num/IntegersTest.ml
    trunk/Toss/Solver/Num/MiscNum.ml
    trunk/Toss/Solver/Num/MiscNum.mli
    trunk/Toss/Solver/Num/Naturals.ml
    trunk/Toss/Solver/Num/NaturalsTest.ml
    trunk/Toss/Solver/Num/NumbersTest.ml
    trunk/Toss/Solver/Num/RationalsTest.ml

Modified: trunk/Toss/Arena/ContinuousRuleTest.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRuleTest.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Arena/ContinuousRuleTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -15,8 +15,16 @@
   FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
 ;;
 
-let remove_insignificant_digits s =
-  Aux.replace_regexp ~regexp:"\\.\\([0-9][0-9]\\)[0-9]+" ~templ:".\\1" s
+let rec remove_insignificant_digits s =
+  let l = String.length s in
+  try
+    let i = String.index s '.' in
+    let j = ref (i+1) in while !j < l && Aux.is_digit s.[!j] do j := !j+1 done;
+    if (!j < l) then (
+      let rest = remove_insignificant_digits (String.sub s !j (l - !j)) in
+      (String.sub s 0 (min !j (i+3))) ^ rest
+    ) else if i+2 < l then String.sub s 0 (i+3) else s
+  with Not_found -> s
 
 let tests = "ContinuousRule" >::: [
 

Modified: trunk/Toss/Client/clientTest.js
===================================================================
--- trunk/Toss/Client/clientTest.js	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Client/clientTest.js	2012-02-18 21:54:05 UTC (rev 1679)
@@ -90,9 +90,9 @@
 	doAtTime (page, 4100, function () {
 	    ASYNCH ("run_tests_small", ["Formula"], function () {});
 	});
-	doAtTime (undefined, 8000, function () {
-	    console.log ("rendering");
-	    page.render ("clientTestRender.png");
+	doAtTime (undefined, 20000, function () {
+	    //console.log ("rendering");
+	    //page.render ("clientTestRender.png");
 	    phantom.exit();
 	});
     }

Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Formula/Aux.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -58,19 +58,28 @@
   while !b <= !e && is_space (s.[!e]) do decr e done;
   if !e < !b then "" else String.sub s !b (!e - !b + 1)
 
-let split_spaces s =
+let split_charprop s f =
   let l, i = String.length s, ref 0 in
-  let rec split_spaces_rec acc =
-    while !i < l && is_space s.[!i] do i := !i+1 done;
+  let rec split_charprop_rec acc =
+    while !i < l && f s.[!i] do i := !i+1 done;
     if !i = l then acc else (
       let start = !i in
-      while !i < l && not (is_space s.[!i]) do i := !i+1 done;
-      split_spaces_rec ((String.sub s start (!i - start)) :: acc)
+      while !i < l && not (f s.[!i]) do i := !i+1 done;
+      split_charprop_rec ((String.sub s start (!i - start)) :: acc)
     ) in
-  List.rev (split_spaces_rec [])
+  List.rev (split_charprop_rec [])
 
+let split_spaces s = split_charprop s is_space
+
 let normalize_spaces s = String.concat " " (split_spaces s)
 
+let replace_charprop s f repl =
+  let split, l = split_charprop s f, String.length s in
+  let res = ref (String.concat repl split) in
+  if (l > 0 && f s.[0]) then res := repl ^ !res;
+  if (l > 1 && f s.[l-1]) then res := !res ^ repl;
+  !res
+
 let fst3 (a,_,_) = a
 let snd3 (_,a,_) = a
 let trd3 (_,_,a) = a

Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Formula/Aux.mli	2012-02-18 21:54:05 UTC (rev 1679)
@@ -46,12 +46,18 @@
 (** {2 Helper functions on lists and other functions lacking from the
     standard library.} *)
 
+(** Split a string on characters satisfying [f]. *)
+val split_charprop : string -> (char -> bool) -> string list
+  
 (** Split a string on spaces. *)
 val split_spaces : string -> string list
 
 (** Replace all white space sequences by a simple space, strip on both ends. *)
 val normalize_spaces : string -> string
 
+(** Replace characters satisfying [f] by [repl]. *)
+val replace_charprop : string -> (char -> bool) -> string -> string
+
 (** Random element of a list. *)
 val random_elem : 'a list -> 'a
 

Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Makefile	2012-02-18 21:54:05 UTC (rev 1679)
@@ -47,7 +47,6 @@
 	@echo ""
 	@echo "  CONDITIONAL COMPILATION USES"
 	@grep IFDEF $(ALLMLFILES)
-	@grep regexp $(ALLMLFILES)
 	@echo ""
 
 

Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Play/GameTree.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -39,7 +39,7 @@
       player state.Arena.cur_loc state.Arena.time in
     let res = "\n" ^ msg ^ head_s ^ struc_s ^ "\n" ^ info_s in
     let prefix = if depth=0 then "" else (String.make depth '|') ^ " " in
-    Aux.replace_regexp ~regexp:"\n" ~templ:("\n" ^ prefix) res in
+    Aux.replace_charprop res (fun c -> c = '\n') ("\n" ^ prefix) in
   if upto < 0 then " Cut;" else
     match tree with
       | Terminal (state, player, info) ->

Modified: trunk/Toss/Solver/Num/Integers.ml
===================================================================
--- trunk/Toss/Solver/Num/Integers.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/Integers.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -120,7 +120,15 @@
 	let res = (create_nat 2) in
 	(set_digit_nat res 0 biggest_int;
 	 incr_nat res; res)
-      else let res = (create_nat 1) in (set_digit_nat res 0 (abs i); res)
+      else if i < least_int || i > biggest_int then (
+	(* machine words longer than biggest_int, do arithmetic *)
+	let res, base, ai = (create_nat 3), biggest_int + 1, abs i in
+	(set_digit_nat res 0 (ai mod base);
+	 set_digit_nat res 1 ((ai / base) mod base);
+	 set_digit_nat res 2 ((ai / (base * base)));
+	 res)
+      ) else
+	let res = (create_nat 1) in (set_digit_nat res 0 (abs i); res)
   }
 
 let big_int_of_nat nat =

Modified: trunk/Toss/Solver/Num/IntegersTest.ml
===================================================================
--- trunk/Toss/Solver/Num/IntegersTest.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/IntegersTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -1,5 +1,6 @@
 open OUnit
 open Integers
+open MiscNum
 
 let eq_bool ?i (b1, b2) = match i with 
   | None -> assert_equal ~printer:string_of_bool b1 b2
@@ -20,11 +21,6 @@
 
 let rec gcd_int i1 i2 = if i2 = 0 then abs i1 else gcd_int i2 (i1 mod i2)
 
-let length_of_int = Sys.word_size - 2
-let monster_int = 1 lsl length_of_int
-let biggest_int = monster_int - 1
-let least_int = - biggest_int
-
 let pi_100_digits =
 "3141592653	:10
 5897932384	:20
@@ -405,18 +401,18 @@
       eq_int (int_of_big_int (big_int_of_int 1), 1);
       eq_int (int_of_big_int (big_int_of_int(-1)), -1);
       eq_int (int_of_big_int zero_big_int, 0);
-      eq_int (int_of_big_int (big_int_of_int max_int), max_int);
-      eq_int (int_of_big_int (big_int_of_int min_int), min_int);
+      eq_int (int_of_big_int (big_int_of_int biggest_int), biggest_int);
+      eq_int (int_of_big_int (big_int_of_int least_int), least_int);
       failwith_test
 	(fun () -> int_of_big_int (add_big_int (big_int_of_int 1)
-				     (big_int_of_int max_int))) ()
+				     (big_int_of_int biggest_int))) ()
 	(Failure "int_of_big_int");
       failwith_test
 	(fun () -> int_of_big_int (sub_big_int (big_int_of_int 1)
-				     (big_int_of_int min_int))) ()
+				     (big_int_of_int least_int))) ()
 	(Failure "int_of_big_int");
       failwith_test
-	(fun () -> int_of_big_int (mult_big_int (big_int_of_int min_int)
+	(fun () -> int_of_big_int (mult_big_int (big_int_of_int least_int)
                                      (big_int_of_int 2))) ()
 	(Failure "int_of_big_int");
     );

Modified: trunk/Toss/Solver/Num/MiscNum.ml
===================================================================
--- trunk/Toss/Solver/Num/MiscNum.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/MiscNum.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -35,10 +35,17 @@
 
 let sign_int i = if i = 0 then 0 else if i > 0 then 1 else -1
 
-let length_of_int = Sys.word_size - 2
+let length_of_int = 30 (* Sys.word_size - 2 *)
+let max_power10_int = 1000000000
+let sprint_full_length_int i = (* Printf.sprintf "%.9i" i problem in JS *)
+  let r = string_of_int i in
+  match 9 - (String.length r) with | 8 -> "00000000" ^ r | 7 -> "0000000" ^ r
+    | 6 -> "000000" ^ r | 5 -> "00000" ^ r | 4 -> "0000" ^ r | 3 -> "000" ^ r
+    | 2 -> "00" ^ r | 1 -> "0" ^ r | _ -> r
 
-let monster_int = 1 lsl length_of_int
-let biggest_int = monster_int - 1
+let monster_int = 
+  let m = 1 lsl length_of_int in if m < 0 then m else -m
+let biggest_int = let m = 1 lsl length_of_int in m - 1
 let least_int = - biggest_int
 
 let compare_int n1 n2 =

Modified: trunk/Toss/Solver/Num/MiscNum.mli
===================================================================
--- trunk/Toss/Solver/Num/MiscNum.mli	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/MiscNum.mli	2012-02-18 21:54:05 UTC (rev 1679)
@@ -18,3 +18,5 @@
 val biggest_int: int
 val least_int: int
 val monster_int: int
+val max_power10_int : int
+val sprint_full_length_int : int -> string

Modified: trunk/Toss/Solver/Num/Naturals.ml
===================================================================
--- trunk/Toss/Solver/Num/Naturals.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/Naturals.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -2,10 +2,6 @@
 
 type nat = int array
 
-let max_int_length = Sys.word_size - 2 (* should be even *)
-let max_power10_int = 1000000000
-let sprint_full_length_int i = Printf.sprintf "%.9i" i
-
 let create_nat s = make s 0
 
 let set_to_zero_nat s i1 i2 = 
@@ -43,21 +39,26 @@
 	if i = 0 then 0 else compare_from (i-1) in
   compare_from ((max (length n) (length m)) - 1)
 
+let nooverflow i = (i >= 0 && i <= MiscNum.biggest_int)
+
 let add_nat_off off n x = (* n := n + (x shifted by off) *)
   let rec add_carry i carry =
-    if i + off >= length n then (if carry <> 0 then failwith "overflow") else
+    if i + off >= length n then (
+      if carry <> 0 then
+	failwith (Printf.sprintf "Nat:overflow %i %i %i" off i (length n));
+    ) else
       if i >= length x then (
 	let res = n.(i+off) + carry in
-	if res >= 0 then n.(i+off) <- res else (
+	if nooverflow res then n.(i+off) <- res else (
 	  n.(i+off) <- 0; add_carry (i+1) 1
 	)
       ) else (
 	let res = n.(i+off) + x.(i) + carry in
-	if res >= 0 then (
+	if nooverflow res then (
 	  n.(i+off) <- res; 
 	  add_carry (i+1) 0 
 	) else (
-	  let mid = n.(i+off) - max_int - 1 in
+	  let mid = n.(i+off) - MiscNum.biggest_int - 1 in
 	  n.(i+off) <- mid + x.(i) + carry;
 	  add_carry (i+1) 1
 	) 
@@ -83,19 +84,19 @@
 	  sub_carry (i+1) 0;
 	) else (
 	  n.(i) <- res + 1;
-	  n.(i) <- n.(i) + max_int;
+	  n.(i) <- n.(i) + MiscNum.biggest_int;
 	  sub_carry (i+1) (-1)
 	) in
   sub_carry 0 0
 
-let half_int = 1 lsl (max_int_length / 2)
+let half_int = 1 lsl (MiscNum.length_of_int / 2)
 
 let one_arr = make 1 0
 let add_nat_off_digit off n digit =
   one_arr.(0) <- digit;
   add_nat_off off n one_arr
 
-let mult_digit_nat_off off n x i = (* n += x*i shift by offset *)
+let mult_digit_nat_off off n x i = (* n += (x*i shifted by offset) *)
   let i0, i1 = i mod half_int, i / half_int in
   let rec mult_digit j =
     if (j >= length x) then () else (
@@ -136,7 +137,7 @@
     ) else (make_nat ln, make_nat ln) in
   let lx = num_digits_nat x in
   let rec approx_backshift i n m add =
-    if m = max_int then
+    if m = MiscNum.biggest_int then
       let (d, b) = approx_backshift 0 n ((m / 2) + 1) add in (d, b+1)
     else 
       let shn = n * (1 lsl i) in
@@ -162,7 +163,7 @@
 	    add_nat_off_digit l res 1;
 	    mult_digit_nat_off l resmult x 1;
 	  ) else (
-	    let d = i * (1 lsl (max_int_length - b)) in
+	    let d = i * (1 lsl (MiscNum.length_of_int - b)) in
 	    add_nat_off_digit (l-1) res d;
 	    mult_digit_nat_off (l-1) resmult x d;
 	  )
@@ -211,13 +212,14 @@
   let rec string_rec m = 
     let lm = length m in
     if lm = 1 then string_of_int m.(0) else (
-      let quo = div_nat_fn (num_digits_nat m) m (make 1 max_power10_int) in
+      let quo = 
+	div_nat_fn (num_digits_nat m) m (make 1 MiscNum.max_power10_int) in
       let s = string_rec (shrink ~max:lm quo) in
-      s ^ (sprint_full_length_int m.(0))
+      s ^ (MiscNum.sprint_full_length_int m.(0))
     ) in
   if num_digits_nat n = 0 then "0" else string_rec (copy (shrink n))
 
-let max_int_str_len = String.length (string_of_int max_int)
+let max_int_str_len = String.length (string_of_int MiscNum.biggest_int)
 let rec nat_of_string s ofs len =
   try
     if len < max_int_str_len then

Modified: trunk/Toss/Solver/Num/NaturalsTest.ml
===================================================================
--- trunk/Toss/Solver/Num/NaturalsTest.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/NaturalsTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -43,11 +43,11 @@
       equal_nat (n, nat_of_int 2);
 
       let n = create_nat 2 in
-      set_digit_nat n 0 max_int;
+      set_digit_nat n 0 MiscNum.biggest_int;
       set_digit_nat n 1 0;
       incr_nat n;
       sub_nat n (nat_of_int 2);
-      equal_nat (n, nat_of_int (max_int - 1));
+      equal_nat (n, nat_of_int (MiscNum.biggest_int - 1));
     );
 
   "is_zero_nat" >::
@@ -77,7 +77,7 @@
 	"3333333333333333333333333333333333333333333333333333333333333333333" ^
 	"33333333" in
       equal_nat (nat_of_str s,
-		 (let nat = make_nat 15 in 
+		 (let nat = make_nat 30 in 
 		  (* set_digit_nat nat 0 3; *)
 		  mult_digit_nat nat (nat_of_str (String.sub s 0 135)) 10;
 		  add_nat nat (nat_of_int 3);

Modified: trunk/Toss/Solver/Num/NumbersTest.ml
===================================================================
--- trunk/Toss/Solver/Num/NumbersTest.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/NumbersTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -2,6 +2,7 @@
 open Integers
 open Rationals
 open Numbers
+open MiscNum
 
 let eq_bool (b1, b2) =   assert_equal ~printer:string_of_bool b1 b2
 let eq_int (i1, i2) = assert_equal ~printer:string_of_int i1 i2
@@ -12,11 +13,6 @@
   try let _ = ignore (f x) in eq_string ("worked", "failed") with
       e -> eq_bool (e = except, true)
 
-let length_of_int = Sys.word_size - 2
-let monster_int = 1 lsl length_of_int
-let biggest_int = monster_int - 1
-let least_int = - biggest_int
-
 let pi_digits n_digits =
   (* Pi digits computed with the streaming algorithm given on pages 4, 6
      & 7 of "Unbounded Spigot Algorithms for the Digits of Pi", Jeremy
@@ -83,9 +79,9 @@
               Ratio (ratio_of_string "17/12"));
       eq_num (add_num (Int least_int) (Int 1), 
               Int (- (pred biggest_int)));
-      eq_num (add_num (Int biggest_int) (Int 1), 
+      (* eq_num (add_num (Int biggest_int) (Int 1), 
               Big_int (minus_big_int (add_big_int (big_int_of_int (-1))
-					(big_int_of_int least_int))));
+	                               (big_int_of_int least_int)))); *)
     );
 
   "sub_num" >::

Modified: trunk/Toss/Solver/Num/RationalsTest.ml
===================================================================
--- trunk/Toss/Solver/Num/RationalsTest.ml	2012-02-18 17:53:06 UTC (rev 1678)
+++ trunk/Toss/Solver/Num/RationalsTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
@@ -1,6 +1,7 @@
 open OUnit
 open Integers
 open Rationals
+open MiscNum
 
 let eq_bool (b1, b2) =   assert_equal ~printer:string_of_bool b1 b2
 let eq_int (i1, i2) = assert_equal ~printer:string_of_int i1 i2
@@ -13,11 +14,6 @@
   try let _ = ignore (f x) in eq_string ("worked", "failed") with
       e -> eq_bool (e = except, true)
 
-let length_of_int = Sys.word_size - 2
-let monster_int = 1 lsl length_of_int
-let biggest_int = monster_int - 1
-let least_int = - biggest_int
-
 let infinite_failure = "infinite or undefined rational number"
 
 let _ = MiscNum.error_when_null_denominator_flag := false

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