Update procedure gcd and lcm to built-in

Signed-off-by: yamacir-kit <[email protected]>

README.md

@@ -99,7 +99,7 @@ Procedures for each standard are provided by the following R7RS-style libraries:
 cmake -B build -DCMAKE_BUILD_TYPE=Release
 cd build
 make package
-sudo apt install build/meevax_0.5.16_amd64.deb
+sudo apt install build/meevax_0.5.17_amd64.deb
 ```
 
 or
@@ -131,9 +131,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.5.16.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.5.17.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.5.16_amd64.deb`
+| `package`   | Generate debian package `meevax_0.5.17_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage

VERSION

@@ -1 +1 @@
-0.5.16
+0.5.17

basis/r4rs.ss

@@ -55,6 +55,7 @@
                 + * - /
                 abs
                 quotient remainder modulo
+                gcd lcm
                 numerator denominator
                 floor ceiling truncate round
                 expt
@@ -326,26 +327,6 @@
                        (car alist)
                        (assoc (cdr alist)))))))
 
-         (define (gcd . xs) ; Chibi-Scheme
-           (define (gcd-2 a b)
-             (if (zero? b)
-                 (abs a)
-                 (gcd b (remainder a b))))
-           (if (null? xs) 0
-               (let rec ((n  (car xs))
-                         (ns (cdr xs)))
-                 (if (null? ns) n
-                     (rec (gcd-2 n (car ns)) (cdr ns))))))
-
-         (define (lcm . xs) ; Chibi-Scheme
-           (define (lcm-2 a b)
-             (abs (quotient (* a b) (gcd a b))))
-           (if (null? xs) 1
-               (let rec ((n  (car xs))
-                         (ns (cdr xs)))
-                 (if (null? ns) n
-                     (rec (lcm-2 n (car ns)) (cdr ns))))))
-
          (define (rationalize x e) ; IEEE Std 1178-1990 ANNEX C.4
            (define (simplest-rational x y)
              (define (simplest-rational-internal x y)

include/meevax/kernel/number.hpp

@@ -383,6 +383,10 @@ inline namespace number
 
   auto is_even(object const&) -> bool;
 
+  auto max(object const&) -> object;
+
+  auto min(object const&) -> object;
+
   auto abs(object const&) -> object;
 
   auto quotient(object const&, object const&) -> object;
@@ -391,6 +395,10 @@ inline namespace number
 
   auto modulo(object const&, object const&) -> object;
 
+  auto gcd(object const&, object const&) -> object;
+
+  auto lcm(object const&, object const&) -> object;
+
   auto sqrt(object const&) -> object;
 
   auto pow(object const&, object const&) -> object;

src/kernel/boot.cpp

@@ -625,26 +625,12 @@ inline namespace kernel
 
       library.define<function>("max", [](let const& xs)
       {
-        if (auto iter = std::max_element(xs.begin(), xs.end(), less_than); iter != xs.end())
-        {
-          return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter;
-        }
-        else
-        {
-          throw error(make<string>("procedure max requires at least one argument"));
-        }
+        return max(xs);
       });
 
       library.define<function>("min", [](let const& xs)
       {
-        if (auto iter = std::min_element(xs.begin(), xs.end(), less_than); iter != xs.end())
-        {
-          return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter;
-        }
-        else
-        {
-          throw error(make<string>("procedure min requires at least one argument"));
-        }
+        return min(xs);
       });
 
       library.define<function>("+", [](let const& xs)
@@ -701,6 +687,36 @@ inline namespace kernel
         return modulo(xs[0], xs[1]);
       });
 
+      library.define<function>("gcd", [](let const& xs)
+      {
+        switch (length(xs))
+        {
+        case 0:
+          return e0;
+
+        case 1:
+          return xs[0];
+
+        default:
+          return std::accumulate(cdr(xs).begin(), xs.end(), xs[0], gcd);
+        }
+      });
+
+      library.define<function>("lcm", [](let const& xs)
+      {
+        switch (length(xs))
+        {
+        case 0:
+          return e1;
+
+        case 1:
+          return xs[0];
+
+        default:
+          return std::accumulate(cdr(xs).begin(), xs.end(), xs[0], lcm);
+        }
+      });
+
       library.define<function>("numerator", [](let const& xs)
       {
         return numerator(xs[0]);

src/kernel/number.cpp

@@ -18,6 +18,7 @@
 #include <regex>
 #include <string_view>
 
+#include <meevax/kernel/ghost.hpp>
 #include <meevax/kernel/number.hpp>
 #include <meevax/kernel/string.hpp>
 
@@ -762,6 +763,30 @@ inline namespace number
     return is_zero(remainder(x, e2));
   }
 
+  auto max(object const& xs) -> object
+  {
+    if (auto iter = std::max_element(xs.begin(), xs.end(), less_than); iter != xs.end())
+    {
+      return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter;
+    }
+    else
+    {
+      return unspecified;
+    }
+  }
+
+  auto min(object const& xs) -> object
+  {
+    if (auto iter = std::min_element(xs.begin(), xs.end(), less_than); iter != xs.end())
+    {
+      return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter;
+    }
+    else
+    {
+      return unspecified;
+    }
+  }
+
   auto abs(object const& x) -> object
   {
     auto f = [](auto&& x)
@@ -803,6 +828,16 @@ inline namespace number
     return ((x % y) + y) % y;
   }
 
+  auto gcd(object const& x, object const& y) -> object
+  {
+    return is_zero(y) ? abs(x) : gcd(y, remainder(x, y));
+  }
+
+  auto lcm(object const& x, object const& y) -> object
+  {
+    return abs(quotient(x * y, gcd(x, y)));
+  }
+
   auto sqrt(object const& x) -> object
   {
     auto f = [](auto&& x)