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

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

Revision: 1629
          http://toss.svn.sourceforge.net/toss/?rev=1629&view=rev
Author:   lukaszkaiser
Date:     2011-11-11 22:57:56 +0000 (Fri, 11 Nov 2011)
Log Message:
-----------
A few more small changes, all GDL translation tests go through.

Modified Paths:
--------------
    trunk/Toss/Formula/Aux.ml
    trunk/Toss/Formula/Aux.mli
    trunk/Toss/GGP/TranslateGame.ml

Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml	2011-11-11 22:08:39 UTC (rev 1628)
+++ trunk/Toss/Formula/Aux.ml	2011-11-11 22:57:56 UTC (rev 1629)
@@ -254,7 +254,7 @@
 
 let rec power ?(timeout = fun () -> false) dom img =
   List.fold_left (fun sbs v ->
-    concat_map (fun e -> if timeout () then raise (Timeout "Aux.product") else
+    concat_map (fun e -> if timeout () then raise (Timeout "Aux.power") else
 	List.rev (List.rev_map (fun sb -> (v,e)::sb) sbs)) img)
     [[]] (List.rev dom)
 
@@ -275,9 +275,10 @@
   if n <= 0 then accu
   else fold_n f (f accu) (n-1)
 
-let all_ntuples elems arity =
+let all_ntuples ?(timeout = fun () -> false) elems arity =
   fold_n (fun tups ->
-    concat_map (fun e -> (List.map (fun tup -> e::tup) tups))
+    concat_map (fun e -> if timeout () then raise (Timeout "Aux.all_ntuples") 
+		    else List.rev (List.rev_map (fun tup -> e::tup) tups))
       elems) [[]] arity
 
 let rec remove_one e = function

Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli	2011-11-11 22:08:39 UTC (rev 1628)
+++ trunk/Toss/Formula/Aux.mli	2011-11-11 22:57:56 UTC (rev 1629)
@@ -170,7 +170,7 @@
 val pairs : 'a list -> ('a * 'a) list
 
 (** An [n]th cartesian power of the list. Tail recursive. *)
-val all_ntuples : 'a list -> int -> 'a list list
+val all_ntuples : ?timeout:(unit -> bool) -> 'a list -> int -> 'a list list
 
 (** All subsets of a given [set] of size up to [max_size]. *)
 val all_subsets : ?max_size: int -> 'a list -> 'a list list

Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml	2011-11-11 22:08:39 UTC (rev 1628)
+++ trunk/Toss/GGP/TranslateGame.ml	2011-11-11 22:57:56 UTC (rev 1629)
@@ -1056,9 +1056,10 @@
       match List.assoc rel argpaths with
         | Aux.Left argpaths ->
           let arity = List.assoc rel arities in
-          let elem_tups = Aux.all_ntuples element_reps arity in
+          let elem_tups =
+            Aux.all_ntuples ~timeout:!timeout element_reps arity in
           let path_tups =
-            Aux.product (Array.to_list argpaths) in
+            Aux.product ~timeout:!timeout (Array.to_list argpaths) in
           List.fold_left (fun struc ptup ->
             Aux.fold_left_try (fun struc etup ->
               let rname = rel_on_paths rel ptup in

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