From ef33ae0c563543449d2284e13d6c9ba28654e64d Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 11 Feb 2017 17:41:48 -0800
Subject: Add rassoc and rassql functions.

* eval.c (eval_init): Register rassoc and rassql intrinsics.

* lib.c (rassoc, rassql): New functions.

* lib.h (rassoc, rassql): Declared.

* txr.1: Documented rassoc and rassql, with small fixes
to assql and assoc.
---
 eval.c |  2 ++
 lib.c  | 28 ++++++++++++++++++++++++++++
 lib.h  |  2 ++
 txr.1  | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++---
 4 files changed, 82 insertions(+), 3 deletions(-)

diff --git a/eval.c b/eval.c
index a5f3da58..418d79ff 100644
--- a/eval.c
+++ b/eval.c
@@ -5980,6 +5980,8 @@ void eval_init(void)
 
   reg_fun(intern(lit("assoc"), user_package), func_n2(assoc));
   reg_fun(intern(lit("assql"), user_package), func_n2(assql));
+  reg_fun(intern(lit("rassoc"), user_package), func_n2(rassoc));
+  reg_fun(intern(lit("rassql"), user_package), func_n2(rassql));
   reg_fun(intern(lit("acons"), user_package), func_n3(acons));
   reg_fun(intern(lit("acons-new"), user_package), func_n3(acons_new));
   reg_fun(intern(lit("aconsql-new"), user_package), func_n3(aconsql_new));
diff --git a/lib.c b/lib.c
index 8720218d..98e80315 100644
--- a/lib.c
+++ b/lib.c
@@ -7277,6 +7277,34 @@ val assql(val key, val list)
   return nil;
 }
 
+val rassoc(val key, val list)
+{
+  list = nullify(list);
+
+  while (list) {
+    val elem = car(list);
+    if (equal(cdr(elem), key))
+      return elem;
+    list = cdr(list);
+  }
+
+  return nil;
+}
+
+val rassql(val key, val list)
+{
+  list = nullify(list);
+
+  while (list) {
+    val elem = car(list);
+    if (eql(cdr(elem), key))
+      return elem;
+    list = cdr(list);
+  }
+
+  return nil;
+}
+
 val acons(val car, val cdr, val list)
 {
   return cons(cons(car, cdr), list);
diff --git a/lib.h b/lib.h
index d58a5091..5f44eb41 100644
--- a/lib.h
+++ b/lib.h
@@ -917,6 +917,8 @@ val cptr(mem_t *ptr);
 mem_t *cptr_get(val cptr);
 val assoc(val key, val list);
 val assql(val key, val list);
+val rassoc(val key, val list);
+val rassql(val key, val list);
 val acons(val car, val cdr, val list);
 val acons_new(val key, val value, val list);
 val acons_new_c(val key, loc new_p, loc list);
diff --git a/txr.1 b/txr.1
index 7e14e11c..55655241 100644
--- a/txr.1
+++ b/txr.1
@@ -18072,10 +18072,13 @@ The
 function searches an association list
 .meta alist
 for a cons cell whose
-car field is equivalent to
+.code car
+field is equivalent to
 .meta key
-(with equality determined by the equal
-function). The first such cons is returned. If no such cons is found,
+under the
+.code equal
+function.
+The first such cons is returned. If no such cons is found,
 .code nil
 is returned.
 
@@ -18094,6 +18097,50 @@ is determined using the
 function rather than
 .codn equal .
 
+.coNP Functions @ rassql and @ rassoc
+.synb
+.mets (rassql < value << alist )
+.mets (rassoc < value << alist )
+.syne
+.desc
+The
+.code rassql
+and
+.code rassoc
+functions are reverse lookup counterparts to
+.code assql
+and
+.codn assoc .
+When searching, they examine the
+.code cdr
+field of the pairs of
+.meta alist
+rather than the
+.code car
+field.
+
+The
+.code rassql
+function searches association list
+.meta alist
+for a cons whose
+.code cdr
+field equivalent to
+.meta value
+according to the
+.code eql
+function. If such a cons is found, it is returned.
+Otherwise
+.code nil
+is returned.
+
+The
+.code rassoc
+function searches in the same way as
+.code rassql
+but compares values using
+.codn equal .
+
 .coNP Function @ acons
 .synb
 .mets (acons < car < cdr << alist )
-- 
cgit v1.2.3