New function: grade.

Inspired by APL.

* eval.c (eval_init): Register grade intrinsic.

* lib.c (grade): New function.

* lib.h (grade): Declared.

* txr.1: Documented.

4 files changed, 90 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 3f904e21..deed3ede 100644
--- a/eval.c
+++ b/eval.c
@@ -6003,6 +6003,7 @@ void eval_init(void)
   reg_fun(intern(lit("sort-group"), user_package), func_n3o(sort_group, 1));
   reg_fun(intern(lit("unique"), user_package), func_n2ov(unique, 1));
   reg_fun(intern(lit("uniq"), user_package), func_n1(uniq));
+  reg_fun(intern(lit("grade"), user_package), func_n3o(grade, 1));
 
   reg_var(intern(lit("*param-macro*"), user_package), pm_table);
 
diff --git a/lib.c b/lib.c
index 8bc522c1..def3d65c 100644
--- a/lib.c
+++ b/lib.c
@@ -8398,6 +8398,49 @@ val uniq(val seq)
   return unique(seq, identity_f, hashv_args);
 }
 
+val grade(val seq, val lessfun, val keyfun_in)
+{
+  val self = lit("grade");
+  seq_info_t si = seq_info(seq);
+
+  if (si.kind != SEQ_NIL) {
+    val keyfun = if3(missingp(keyfun_in),
+                     car_f,
+                     chain(car_f, keyfun_in, nao));
+    cnum i, len = c_fixnum(length(seq), self);
+    val iter, v = vector(num_fast(len), nil);
+
+    switch (si.kind) {
+    case SEQ_LISTLIKE:
+      for (iter = si.obj, i = 0; i < len; i++, iter = cdr(iter)) {
+        set(mkloc(v->v.vec[i], v), cons(car(iter), num_fast(i)));
+      }
+      break;
+    case SEQ_VECLIKE:
+      for (i = 0; i < len; i++) {
+        val ix = num_fast(i);
+        set(mkloc(v->v.vec[i], v), cons(ref(seq, ix), ix));
+      }
+      break;
+    default:
+      uw_throwf(error_s, lit("~a: unsupported object ~s"), self, seq, nao);
+    }
+
+    {
+      list_collect_decl (out, ptail);
+
+      sort(v, lessfun, keyfun);
+
+      for (i = 0; i < len; i++)
+        ptail = list_collect(ptail, cdr(v->v.vec[i]));
+
+      return out;
+    }
+  }
+
+  return nil;
+}
+
 val find(val item, val seq, val testfun, val keyfun)
 {
   val self = lit("find");
diff --git a/lib.h b/lib.h
index a4138bda..6c61d282 100644
--- a/lib.h
+++ b/lib.h
@@ -1004,6 +1004,7 @@ val multi_sort(val lists, val funcs, val key_funcs);
 val sort_group(val seq, val keyfun, val lessfun);
 val unique(val seq, val keyfun, struct args *hashv_args);
 val uniq(val seq);
+val grade(val seq, val lessfun, val keyfun_in);
 val find(val list, val key, val testfun, val keyfun);
 val rfind(val list, val key, val testfun, val keyfun);
 val find_if(val pred, val list, val key);
diff --git a/txr.1 b/txr.1
index d7570610..fc187aec 100644
--- a/txr.1
+++ b/txr.1
@@ -28945,6 +28945,51 @@ For strings and vectors,
 .code sort
 is not stable.
 
+.coNP Function @ grade
+.synb
+.mets (grade < sequence >> [ lessfun <> [ keyfun ]])
+.syne
+.desc
+The
+.code grade
+function returns a list of integer indices which indicate the position
+of the elements of
+.meta sequence
+in sorted order.
+
+The
+.meta lessfun
+and
+.meta keyfun
+arguments behave like those of the
+.code sort
+function.
+
+The
+.meta sequence
+object is not modified.
+
+The internal sort performed by
+.code grade
+is not stable. The indices of any elements considered equivalent under
+.code lessfun
+may appear in any order in the returned index sequence.
+
+Note: the
+.code grade
+function is inspired by the "grade up" and "grade down" operators
+in the APL language.
+
+.TP* Examples:
+
+.cblk
+  ;; Order of the 2 3 positions of the "l"
+  ;; characters is not specified:
+
+  [grade "Hello"] -> (0 1 2 3 4)
+  [grade "Hello" >] -> (4 2 3 1 0)
+.cble
+
 .coNP Function @ shuffle
 .synb
 .mets (shuffle << sequence )