Update procedures memv and assv to built-in

Signed-off-by: yamacir-kit <[email protected]>
yamacir-kit · Sep 19, 2023 · 32e6ecb · 32e6ecb
1 parent b03d47a
commit 32e6ecb
Show file tree

Hide file tree

Showing 6 changed files with 64 additions and 20 deletions.
diff --git a/README.md b/README.md
@@ -74,7 +74,7 @@ Subset of R7RS-small.
 cmake -B build -DCMAKE_BUILD_TYPE=Release
 cd build
 make package
-sudo apt install build/meevax_0.4.808_amd64.deb
+sudo apt install build/meevax_0.4.809_amd64.deb
 ```
 
 or
@@ -106,9 +106,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.4.808.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.4.809.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.4.808_amd64.deb`
+| `package`   | Generate debian package `meevax_0.4.809_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage

diff --git a/VERSION b/VERSION
@@ -1 +1 @@
-0.4.808
+0.4.809
diff --git a/basis/r4rs-essential.ss b/basis/r4rs-essential.ss
@@ -230,16 +230,6 @@
                        (null? x)))
                  (null? x))))
 
-         (define (member o x . c) ; Chibi-Scheme
-           (let ((compare (if (pair? c) (car c) equal?)))
-             (let member ((x x))
-               (and (pair? x)
-                    (if (compare o (car x)) x
-                        (member (cdr x)))))))
-
-         (define (memv o x)
-           (member o x eqv?))
-
          (define-syntax case ; Chibi-Scheme
            (er-macro-transformer
              (lambda (form rename compare)
@@ -265,19 +255,21 @@
                `(,(rename 'let) ((,(rename 'result) ,(cadr form)))
                                 ,(each-clause (cddr form))))))
 
+         (define (member x xs . compare) ; Chibi-Scheme
+           (let ((compare (if (pair? compare) (car compare) equal?)))
+             (let member ((xs xs))
+               (and (pair? xs)
+                    (if (compare x (car xs)) xs
+                        (member (cdr xs)))))))
+
          (define (assoc key alist . compare) ; Chibi-Scheme
-           (let ((compare (if (pair? compare)
-                              (car compare)
-                              equal?)))
+           (let ((compare (if (pair? compare) (car compare) equal?)))
              (let assoc ((alist alist))
                (if (null? alist) #f
                    (if (compare key (caar alist))
                        (car alist)
                        (assoc (cdr alist)))))))
 
-         (define (assv key alist)
-           (assoc key alist eqv?))
-
          (define (exact? z)
            (define (exact-complex? x)
              (and (imaginary? x)

diff --git a/include/meevax/kernel/list.hpp b/include/meevax/kernel/list.hpp
@@ -142,8 +142,12 @@ inline namespace kernel
 
   auto memq(object const&, object const&) -> object const&;
 
+  auto memv(object const&, object const&) -> object const&;
+
   auto assq(object const&, object const&) -> object const&;
 
+  auto assv(object const&, object const&) -> object const&;
+
   template <typename F>
   auto filter(F test, object const& xs) -> object
   {

diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp
@@ -487,10 +487,20 @@ inline namespace kernel
         return memq(xs[0], xs[1]);
       });
 
+      library.define<accessor>("memv", [](let const& xs) -> auto const&
+      {
+        return memv(xs[0], xs[1]);
+      });
+
       library.define<accessor>("assq", [](let const& xs) -> auto const&
       {
         return assq(xs[0], xs[1]);
       });
+
+      library.define<accessor>("assv", [](let const& xs) -> auto const&
+      {
+        return assv(xs[0], xs[1]);
+      });
     });
 
     define<library>("(meevax number)", [](library & library)

diff --git a/src/kernel/list.cpp b/src/kernel/list.cpp
@@ -84,6 +84,25 @@ inline namespace kernel
     }
   }
 
+  auto memv(object const& x, object const& xs) -> object const&
+  {
+    if (xs.is<pair>())
+    {
+      if (eqv(x, car(xs)))
+      {
+        return xs;
+      }
+      else
+      {
+        return memv(x, cdr(xs));
+      }
+    }
+    else
+    {
+      return f;
+    }
+  }
+
   auto assq(object const& x, object const& xs) -> object const&
   {
     if (xs.is<pair>())
@@ -103,6 +122,25 @@ inline namespace kernel
     }
   }
 
+  auto assv(object const& x, object const& xs) -> object const&
+  {
+    if (xs.is<pair>())
+    {
+      if (eqv(x, caar(xs)))
+      {
+        return car(xs);
+      }
+      else
+      {
+        return assv(x, cdr(xs));
+      }
+    }
+    else
+    {
+      return f;
+    }
+  }
+
   auto longest_common_tail(let const& a, let const& b) -> object const&
   {
     if (a.is<null>() or b.is<null>() or eq(a, b))