Issue #490 - Proper assv and memv implementations

Both were previously implemented in terms of `assq` and `memq`, respectively.

CHANGELOG.md

@@ -15,6 +15,7 @@ Bug Fixes
 
 - Fix a regression where `c-compiler-options` was not recognized as a top level form by programs.
 - Enforce a maximum recursion depth when printing an object via `display` or `write`, and when comparing objects via `equal?`. This prevents segmentation faults when working with circular data structures.
+- Added proper implementations of `assv` and `memv`. Both were previously implemented in terms of `assq` and `memq`, respectively.
 
 ## 0.34.0 - January 2, 2022
 

include/cyclone/runtime.h

@@ -1000,8 +1000,10 @@ object Cyc_length_unsafe(void *d, object l);
 object Cyc_list2vector(void *data, object cont, object l);
 object Cyc_list2string(void *d, object cont, object lst);
 object memberp(void *data, object x, list l);
+object memvp(void *data, object x, list l);
 object memqp(void *data, object x, list l);
 list assq(void *data, object x, list l);
+list assv(void *data, object x, list l);
 list assoc(void *data, object x, list l);
 list assoc_cdr(void *data, object x, list l);
 /**@}*/

runtime.c

@@ -1466,6 +1466,16 @@ object memberp(void *data, object x, list l)
   return boolean_f;
 }
 
+object memvp(void *data, object x, list l)
+{
+  for (; l != NULL; l = cdr(l)) {
+    Cyc_check_pair_or_null(data, l);
+    if (boolean_f != Cyc_eqv(x, car(l)))
+      return l;
+  }
+  return boolean_f;
+}
+
 object memqp(void *data, object x, list l)
 {
   for (; l != NULL; l = cdr(l)) {
@@ -1490,6 +1500,20 @@ list assq(void *data, object x, list l)
   return boolean_f;
 }
 
+list assv(void *data, object x, list l)
+{
+  if ((l == NULL) || is_value_type(l) || type_of(l) != pair_tag)
+    return boolean_f;
+  for (; (l != NULL); l = cdr(l)) {
+    Cyc_check_pair(data, l);
+    list la = car(l);
+    Cyc_check_pair(data, la);
+    if (boolean_f != Cyc_eqv(x, car(la)))
+      return la;
+  }
+  return boolean_f;
+}
+
 list assoc(void *data, object x, list l)
 {
   if ((l == NULL) || is_value_type(l) || type_of(l) != pair_tag)
@@ -5392,7 +5416,7 @@ void _assv(void *data, object clo, int argc, object *args)
 {
   Cyc_check_argc(data, "assv", argc - 1, 2);
   object cont = args[0];
-  return_closcall1(data, cont, assq(data, args[1], args[2]));
+  return_closcall1(data, cont, assv(data, args[1], args[2]));
 }
 
 void _memq(void *data, object clo, int argc, object *args)
@@ -5406,7 +5430,7 @@ void _memv(void *data, object clo, int argc, object *args)
 {
   Cyc_check_argc(data, "memv", argc - 1, 2);
   object cont = args[0];
-  return_closcall1(data, cont, memqp(data, args[1], args[2]));
+  return_closcall1(data, cont, memvp(data, args[1], args[2]));
 }
 
 void _char_91_125integer(void *data, object clo, int argc, object *args)

scheme/cyclone/primitives.sld

@@ -665,9 +665,9 @@
          ((eq? p 'Cyc-fast-member)  "memberp")
          ((eq? p 'Cyc-fast-assoc)   "assoc")
          ((eq? p 'assq)          "assq")
-         ((eq? p 'assv)          "assq")
+         ((eq? p 'assv)          "assv")
          ((eq? p 'memq)          "memqp")
-         ((eq? p 'memv)          "memqp")
+         ((eq? p 'memv)          "memvp")
          ((eq? p 'boolean?)      "Cyc_is_boolean")
          ((eq? p 'char?)         "Cyc_is_char")
          ((eq? p 'null?)         "Cyc_is_null")

tests/base.scm

@@ -65,5 +65,27 @@
   (test 'test-field (get-test e))
 )
 
+(test-group
+  "assoc"
+  (define a 0.0)
+  (test '(0.0) (assoc a (list (list a))))
+  (test '(0.0) (assoc 0.0 (list (list a))))
+  (test '(0.0) (assv a (list (list a))))
+  (test '(0.0) (assv 0.0 (list (list a))))
+  (test '(0.0) (assq a (list (list a))))
+  (test #f (assq 0.0 (list (list a))))
+)
+
+(test-group
+  "member"
+  (define m 0.0)
+  (test '(0.0) (member m (list m)))
+  (test '(0.0) (member 0.0 (list m)))
+  (test '(0.0) (memv m (list m)))
+  (test '(0.0) (memv 0.0 (list m)))
+  (test '(0.0) (memq m (list m)))
+  (test #f (memq 0.0 (list m)))
+)
+
 (test-exit)