From dd9f7f30e879123e57a32492c7c82d9d2b361678 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 29 Aug 2012 18:34:25 -0700
Subject: * eval.c (mapcarv): Changed to external linkage.

* eval.h (mapcarv): Declaration added.
(eval_init): New intrinsic multi-sort registered.

* lib.c (multi_sort_less): New static function.
(multi_sort): New function.

* lib.h (multi_sort): Declared.

* txr.1: stub section added.
---
 ChangeLog | 14 ++++++++++++++
 eval.c    |  3 ++-
 eval.h    |  1 +
 lib.c     | 31 +++++++++++++++++++++++++++++++
 lib.h     |  1 +
 txr.1     |  2 ++
 6 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 6cfc7aef..bdea0b40 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2012-08-29  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (mapcarv): Changed to external linkage.
+
+	* eval.h (mapcarv): Declaration added.
+	(eval_init): New intrinsic multi-sort registered.
+
+	* lib.c (multi_sort_less): New static function.
+	(multi_sort): New function.
+
+	* lib.h (multi_sort): Declared.
+
+	* txr.1: stub section added.
+
 2012-05-18  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (eval_init): Registered open-command and open-process
diff --git a/eval.c b/eval.c
index fea2ed7a..853ddb87 100644
--- a/eval.c
+++ b/eval.c
@@ -1741,7 +1741,7 @@ val expand(val form)
   }
 }
 
-static val mapcarv(val fun, val list_of_lists)
+val mapcarv(val fun, val list_of_lists)
 {
   if (!cdr(list_of_lists)) {
     return mapcar(fun, car(list_of_lists));
@@ -2381,6 +2381,7 @@ void eval_init(void)
   reg_fun(intern(lit("merge"), user_package), func_n4o(merge, 2));
   reg_fun(intern(lit("sort"), user_package), func_n3o(sort, 2));
   reg_fun(intern(lit("find"), user_package), func_n4o(find, 2));
+  reg_fun(intern(lit("multi-sort"), user_package), func_n2(multi_sort));
   reg_fun(intern(lit("find-if"), user_package), func_n3o(find_if, 2));
   reg_fun(intern(lit("set-diff"), user_package), func_n4o(set_diff, 2));
 
diff --git a/eval.h b/eval.h
index d485e2d4..23b98565 100644
--- a/eval.h
+++ b/eval.h
@@ -39,5 +39,6 @@ val eval_progn(val forms, val env, val ctx_form);
 val eval(val form, val env, val ctx_form);
 val expand(val form);
 val bindable(val obj);
+val mapcarv(val fun, val list_of_lists);
 
 void eval_init(void);
diff --git a/lib.c b/lib.c
index acaccf72..7c15a864 100644
--- a/lib.c
+++ b/lib.c
@@ -3994,6 +3994,37 @@ val sort(val seq, val lessfun, val keyfun)
   return seq;
 }
 
+static val multi_sort_less(val funcs, val llist, val rlist)
+{
+  val less = nil;
+
+  while (funcs) {
+    val func = pop(&funcs);
+    val left = pop(&llist);
+    val right = pop(&rlist);
+
+    if (funcall2(func, left, right)) {
+      less = t;
+      break;
+    }
+
+    if (funcall2(func, right, left))
+      break;
+  }
+
+  return less;
+}
+
+val multi_sort(val funcs, val lists)
+{
+  val lol = mapcarv(func_n0v(identity), lists);
+
+  if (functionp(funcs))
+    funcs = cons(funcs, nil);
+
+  return sort_list(lol, func_f2(funcs, multi_sort_less), identity_f);
+}
+
 val find(val item, val list, val testfun, val keyfun)
 {
   if (!keyfun)
diff --git a/lib.h b/lib.h
index a3429221..475dfe7b 100644
--- a/lib.h
+++ b/lib.h
@@ -635,6 +635,7 @@ val mapcon(val fun, val list);
 val mappend(val fun, val list);
 val merge(val list1, val list2, val lessfun, val keyfun);
 val sort(val seq, val lessfun, val keyfun);
+val multi_sort(val funcs, val lists);
 val find(val list, val key, val testfun, val keyfun);
 val find_if(val pred, val list, val key);
 val set_diff(val list1, val list2, val testfun, val keyfun);
diff --git a/txr.1 b/txr.1
index 8d74b759..2ebf0f0c 100644
--- a/txr.1
+++ b/txr.1
@@ -7635,6 +7635,8 @@ Examples:
 
 .SS Function sort
 
+.SS Function multi-sort
+
 .SS Functions find and find-if
 
 .SS Function set-diff
-- 
cgit v1.2.3