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

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

Revision: 1627
          http://toss.svn.sourceforge.net/toss/?rev=1627&view=rev
Author:   lukaszkaiser
Date:     2011-11-11 00:56:17 +0000 (Fri, 11 Nov 2011)
Log Message:
-----------
Making Aux.unique_sorted tail-recursive, corrects segfault in GDL translation of satlike.

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

Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml	2011-11-10 23:59:43 UTC (rev 1626)
+++ trunk/Toss/Formula/Aux.ml	2011-11-11 00:56:17 UTC (rev 1627)
@@ -340,13 +340,12 @@
     | [] -> acc in
   List.rev (aux (List.rev l2) l1)
 
-(* Not tail-recursive. *)
 let unique_sorted ?(cmp = Pervasives.compare) l =
-  let rec idemp = function
-    | e1::(e2::_ as tl) when cmp e1 e2 = 0 -> idemp tl
-    | e::tl -> e::idemp tl
-    | [] -> [] in
-  idemp (List.sort cmp l)
+  let rec idemp acc = function
+    | e1::(e2::_ as tl) when cmp e1 e2 = 0 -> idemp acc tl
+    | e::tl -> idemp (e::acc) tl
+    | [] -> acc in
+  idemp [] (List.sort (fun x y -> - (cmp x y)) l)
 
 let all_subsets ?max_size set =
   let size = match max_size with Some i -> i | None -> List.length set in

Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml	2011-11-10 23:59:43 UTC (rev 1626)
+++ trunk/Toss/GGP/GDL.ml	2011-11-11 00:56:17 UTC (rev 1627)
@@ -637,15 +637,16 @@
         (rel_atoms_str new_base3)  
     );
     (* }}} *)
-    let new_base = build_graph
-      (new_base1 @ new_base2 @ new_base3)
-    and new_irules = Aux.unique_sorted
-      (new_irules1 @ new_irules2 @ new_irules3) in
+    let append_base = List.rev_append (List.rev new_base1) 
+      (List.rev_append (List.rev new_base2) new_base3) in
+    let new_base = build_graph append_base
+    and all_new_irules = 
+      List.rev_append (List.rev_append new_irules1 new_irules2) new_irules3 in
+    let new_irules = Aux.unique_sorted all_new_irules in
     (* [new_base] is already disjoint from [base] *)
     let new_irules = Aux.sorted_diff new_irules irules in
-    if Aux.StrMap.is_empty new_base && new_irules = []
-    then base
-    else inst_stratum base irules new_base new_irules in
+    if Aux.StrMap.is_empty new_base && new_irules = [] then base else
+      inst_stratum base irules new_base new_irules in
   
   let rec instantiate base = function
     | [] -> base

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