From cdf79f2907cab5aa410ad47934f0374254386220 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 13 May 2020 18:43:02 -0700
Subject: lib: sort becomes non-destructive; nsort introduced.

I'm fixing a historic mistake copied from ANSI Lisp,
which trips up language newcomers and sometimes even
experienced users.

The function innocently named sort will now return newly
allocated structure. The function previously called sort will
be available as nsort (non-consing/allocating sort).

The shuffle function also becomes pure, and is accompanied by
nshuffle.

* eval (me_op): Continue to use destructive sort in this
legacy code that is only triggered in very old compat mode.
(eval_init): Registered nsort and nshuffle.

* lib.c (nsort, nshuffle): New functions introduced, closely
based on sort and shuffle.
(sort, shuffle): Rewritten to avoid destructive behavior: work
by copying the input and calling destructive counterparts.
(sort_group): Continue to use destructive sort, which is safe;
the structure is locally allocated. The sort_group function
has pure semantics.
(grade): Likewise.

* lib.h (nsort, nshuffle): Declared.

* share/txr/stdlib/getopts.tl (opthelp): Replace an instance
of the (sort (copy-list ...)) pattern with just (sort ...).

* tags.tl (toplevel): Continue to use destructive sort to sort
tags before writing the tag file; the lifetime of the tags
list ends when the file is written.

* tests/010/seq.txr: Switch some sort calls to nsort to keep
test case working.

* txr.1: Documented.
---
 eval.c                      |  4 +++-
 lib.c                       | 44 +++++++++++++++++++++++++++++++++++-------
 lib.h                       |  2 ++
 share/txr/stdlib/getopts.tl |  4 ++--
 tags.tl                     |  2 +-
 tests/010/seq.txr           |  6 +++---
 txr.1                       | 47 +++++++++++++++++++++++++++++++++++++--------
 7 files changed, 87 insertions(+), 22 deletions(-)

diff --git a/eval.c b/eval.c
index 3eea86bc..4d0cc137 100644
--- a/eval.c
+++ b/eval.c
@@ -3883,7 +3883,7 @@ static val me_op(val form, val menv)
                     expand(body, new_menv)));
   val rest_gensym = gensym(lit("rest-"));
   cons_bind (syms, body_trans, transform_op(body_ex, nil, rest_gensym));
-  val ssyms = sort(syms, func_n2(lt), car_f);
+  val ssyms = nsort(syms, func_n2(lt), car_f);
   val nums = mapcar(car_f, ssyms);
   val max = if3(nums, maxl(car(nums), cdr(nums)), zero);
   val min = if3(nums, minl(car(nums), cdr(nums)), zero);
@@ -6892,7 +6892,9 @@ void eval_init(void)
   reg_fun(intern(lit("plist-to-alist"), user_package), func_n1(plist_to_alist));
   reg_fun(intern(lit("improper-plist-to-alist"), user_package), func_n2(improper_plist_to_alist));
   reg_fun(intern(lit("merge"), user_package), func_n4o(merge_wrap, 2));
+  reg_fun(intern(lit("nsort"), user_package), func_n3o(nsort, 1));
   reg_fun(intern(lit("sort"), user_package), func_n3o(sort, 1));
+  reg_fun(intern(lit("nshuffle"), user_package), func_n1(nshuffle));
   reg_fun(intern(lit("shuffle"), user_package), func_n1(shuffle));
   reg_fun(intern(lit("find"), user_package), func_n4o(find, 2));
   reg_fun(intern(lit("rfind"), user_package), func_n4o(rfind, 2));
diff --git a/lib.c b/lib.c
index 77bbb34b..cf25d99e 100644
--- a/lib.c
+++ b/lib.c
@@ -8867,9 +8867,9 @@ static void sort_vec(val vec, val lessfun, val keyfun)
   quicksort(vec, lessfun, keyfun, 0, len);
 }
 
-val sort(val seq, val lessfun, val keyfun)
+val nsort(val seq, val lessfun, val keyfun)
 {
-  val self = lit("sort");
+  val self = lit("nsort");
   seq_info_t si = seq_info(seq);
 
   keyfun = default_arg(keyfun, identity_f);
@@ -8891,7 +8891,31 @@ val sort(val seq, val lessfun, val keyfun)
   abort();
 }
 
-val shuffle(val seq)
+val sort(val seq, val lessfun, val keyfun)
+{
+  val self = lit("sort");
+  seq_info_t si = seq_info(seq);
+
+  keyfun = default_arg(keyfun, identity_f);
+  lessfun = default_arg(lessfun, less_f);
+
+  switch (si.kind) {
+  case SEQ_NIL:
+    return nil;
+  case SEQ_VECLIKE:
+  case SEQ_HASHLIKE:
+    sort_vec(copy(seq), lessfun, keyfun);
+    return seq;
+  case SEQ_LISTLIKE:
+    return sort_list(copy_list(seq), lessfun, keyfun);
+  case SEQ_NOTSEQ:
+    unsup_obj(self, seq);
+  }
+
+  abort();
+}
+
+val nshuffle(val seq)
 {
   seq_info_t si = seq_info(seq);
 
@@ -8928,12 +8952,19 @@ val shuffle(val seq)
       return seq;
     }
   case SEQ_NOTSEQ:
-    type_mismatch(lit("shuffle: ~s is not a sequence"), seq, nao);
+    type_mismatch(lit("nshuffle: ~s is not a sequence"), seq, nao);
   }
 
   abort();
 }
 
+val shuffle(val seq)
+{
+  if (seqp(seq))
+    return nshuffle(copy(seq));
+  type_mismatch(lit("nshuffle: ~s is not a sequence"), seq, nao);
+}
+
 static val multi_sort_less(val funcs_cons, val llist, val rlist)
 {
   cons_bind (funcs, key_funcs, funcs_cons);
@@ -8976,8 +9007,7 @@ val sort_group(val seq, val keyfun, val lessfun)
 {
   val kf = default_arg(keyfun, identity_f);
   val lf = default_arg(lessfun, less_f);
-  val seq_copy = copy(seq);
-  val sorted = sort(seq_copy, lf, kf);
+  val sorted = sort(seq, lf, kf);
   return partition_by(kf, sorted);
 }
 
@@ -9054,7 +9084,7 @@ val grade(val seq, val lessfun, val keyfun_in)
     {
       list_collect_decl (out, ptail);
 
-      sort(v, lessfun, keyfun);
+      nsort(v, lessfun, keyfun);
 
       for (i = 0; i < len; i++)
         ptail = list_collect(ptail, cdr(v->v.vec[i]));
diff --git a/lib.h b/lib.h
index e8cc31d6..c3330344 100644
--- a/lib.h
+++ b/lib.h
@@ -1104,7 +1104,9 @@ val window_mappend(val range, val boundary, val fun, val seq);
 val window_mapdo(val range, val boundary, val fun, val seq);
 val interpose(val sep, val seq);
 val merge(val list1, val list2, val lessfun, val keyfun);
+val nsort(val seq, val lessfun, val keyfun);
 val sort(val seq, val lessfun, val keyfun);
+val nshuffle(val seq);
 val shuffle(val seq);
 val multi_sort(val lists, val funcs, val key_funcs);
 val sort_group(val seq, val keyfun, val lessfun);
diff --git a/share/txr/stdlib/getopts.tl b/share/txr/stdlib/getopts.tl
index b98a76dc..db8f793f 100644
--- a/share/txr/stdlib/getopts.tl
+++ b/share/txr/stdlib/getopts.tl
@@ -269,8 +269,8 @@
     opr.(parse-opts args)))
 
 (defun opthelp (opt-desc-list : (stream *stdout*))
-  (let ((sorted [sort (copy-list (remove-if (op null @1.helptext)
-                                            opt-desc-list)) :
+  (let ((sorted [sort (remove-if (op null @1.helptext)
+                                             opt-desc-list) :
                       (do if @1.long @1.long @1.short)])
         (undocumented (keep-if (op null @1.helptext) opt-desc-list)))
     (put-line "\nOptions:\n")
diff --git a/tags.tl b/tags.tl
index 44f2fad5..711fb650 100755
--- a/tags.tl
+++ b/tags.tl
@@ -284,4 +284,4 @@
                                       ftw-skip-subtree)))
                             (t ftw-continue)))
                         (logior ftw-phys ftw-actionretval)))))
-      (write-tagfile (sort tags : .ident) o))))
+      (write-tagfile (nsort tags : .ident) o))))
diff --git a/tests/010/seq.txr b/tests/010/seq.txr
index 080b01ad..9b3edf28 100644
--- a/tests/010/seq.txr
+++ b/tests/010/seq.txr
@@ -14,7 +14,7 @@
    (format t "~s ~s\n" (del [*s* 1]) *s*)
    (format t "~s ~s\n" (del [*s* -1]) *s*)
    (catch (pr (del [*s* 3]) *s*) (t (x) (caught x)))
-   (pr [sort *v* >])
-   (pr [sort *v2* > cdr])
-   (pr [sort (range 1 100) >])
+   (pr [nsort *v* >])
+   (pr [nsort *v2* > cdr])
+   (pr [nsort (range 1 100) >])
    (pr2 (del [*v2* 1..3]) *v2*))
diff --git a/txr.1 b/txr.1
index e83cdfb6..f33024ad 100644
--- a/txr.1
+++ b/txr.1
@@ -32550,13 +32550,14 @@ is a transformed list of rows which is reconstituted into a list of columns.
   ;; (op remove-if (ap eql @3 20))
 .brev
 
-.coNP Function @ sort
+.coNP Functions @ sort and @ nsort
 .synb
 .mets (sort < sequence >> [ lessfun <> [ keyfun ]])
+.mets (nsort < sequence >> [ lessfun <> [ keyfun ]])
 .syne
 .desc
 The
-.code sort
+.code nsort
 function destructively sorts
 .metn sequence ,
 producing a sequence
@@ -32596,7 +32597,21 @@ function.
 
 The
 .code sort
-function is stable for sequences which are lists. This means that the
+function has the same argument requirements as
+.code nsort
+but is non-destructive: it returns a new object, leaving the input
+.meta sequence
+unmodified, as if a copy of the input object were made using the
+function
+.code copy
+and then that copy were sorted in-place using
+.codn nsort .
+
+The
+.code sort
+and
+.code nsort
+functions are stable for sequences which are lists. This means that the
 original order of items which are considered identical is preserved.
 For strings and vectors,
 .code sort
@@ -32604,7 +32619,9 @@ is not stable.
 
 The
 .code sort
-function can be applied to hashes. It produces meaningful behavior
+and
+.code nsort
+functions can be applied to hashes. It produces meaningful behavior
 for a hash table which contains
 .I N
 keys which are the integers from 0 to
@@ -32660,13 +32677,14 @@ in the APL language.
   [grade "Hello" >] -> (4 2 3 1 0)
 .brev
 
-.coNP Function @ shuffle
+.coNP Functions @ shuffle and @ nshuffle
 .synb
 .mets (shuffle << sequence )
+.mets (nshuffle << sequence )
 .syne
 .desc
 The
-.code shuffle
+.code nshuffle
 function pseudo-randomly rearranges the elements of
 .metn sequence .
 This is performed in place:
@@ -32682,12 +32700,25 @@ The rearrangement depends on pseudo-random numbers obtained from the
 function.
 
 The
-.code shuffle
+.code nshuffle
 function supports hash tables in a manner analogous to the way
-.code sort
+.code nsort
 supports hash tables; the same remarks apply as in the description
 of that function.
 
+The
+.code shuffle
+function has the same argument requirements and
+semantics, but differs from
+.code nshuffle
+in that it avoids in-place modification of
+.metn sequence :
+a new, shuffled sequence is returned, as if a copy of
+.meta sequence
+were made using
+.code copy
+and then that copy were shuffled in-place and returned.
+
 .coNP Function @ sort-group
 .synb
 .mets (sort-group < sequence >> [ keyfun <> [ lessfun ]])
-- 
cgit v1.2.3