From 9173c06b05d155ac866fd46d2a87cfdf8df4e01d Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 15 Oct 2023 14:28:39 +0900 Subject: [PATCH] Update procedure `drop-right!` to built-in Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- basis/srfi-1.ss | 26 ++++---------------------- include/meevax/kernel/list.hpp | 2 ++ src/kernel/boot.cpp | 5 +++++ src/kernel/list.cpp | 25 +++++++++++++++++++++++++ test/srfi-1.ss | 25 ++++++++++++++++++------- 7 files changed, 58 insertions(+), 33 deletions(-) diff --git a/README.md b/README.md index e651639bc..8e2a132f2 100644 --- a/README.md +++ b/README.md @@ -91,7 +91,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.49_amd64.deb +sudo apt install build/meevax_0.5.50_amd64.deb ``` or @@ -123,9 +123,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.49.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.50.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.49_amd64.deb` +| `package` | Generate debian package `meevax_0.5.50_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index b19530f3d..1e7ed0369 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.49 +0.5.50 diff --git a/basis/srfi-1.ss b/basis/srfi-1.ss index efac2028e..3228ceb40 100644 --- a/basis/srfi-1.ss +++ b/basis/srfi-1.ss @@ -16,17 +16,10 @@ ) (only (meevax list) list make-list list-copy circular-list iota null? - list? - circular-list? - dotted-list? - null-list? - list-ref - first second third fourth fifth sixth seventh eighth ninth tenth - ; car+cdr - take take! - drop - take-right - drop-right + list? circular-list? dotted-list? null-list? + list-ref first second third fourth fifth sixth seventh eighth ninth tenth + take take! take-right + drop drop-right drop-right! last last-pair @@ -93,17 +86,6 @@ (values (car pair) (cdr pair))) - (define (drop-right! x k) - (let ((lead (drop x k))) - (if (pair? lead) - (let rec ((lag x) - (lead (cdr lead))) - (if (pair? lead) - (rec (cdr lag) - (cdr lead)) - (begin (set-cdr! lag '()) x))) - '()))) - (define (split-at x k) (let recur ((lis x) (k k)) (if (zero? k) (values '() lis) diff --git a/include/meevax/kernel/list.hpp b/include/meevax/kernel/list.hpp index 423d27b9f..a8dcec320 100644 --- a/include/meevax/kernel/list.hpp +++ b/include/meevax/kernel/list.hpp @@ -167,6 +167,8 @@ inline namespace kernel auto drop_right(object const&, std::size_t) -> object; + auto drop_right(object &, std::size_t) -> object; + auto length(object const&) -> std::size_t; auto append(object const&, object const&) -> object; diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index fdd0bb08f..0cb76fb9f 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -732,6 +732,11 @@ inline namespace kernel return drop_right(xs[0], xs[1].as()); }); + library.define("drop-right!", [](let & xs) + { + return drop_right(xs[0], xs[1].as()); + }); + library.define("memq", [](let const& xs) -> auto const& { return memq(xs[0], xs[1]); diff --git a/src/kernel/list.cpp b/src/kernel/list.cpp index 33d10a056..cb72c33ad 100644 --- a/src/kernel/list.cpp +++ b/src/kernel/list.cpp @@ -221,6 +221,31 @@ inline namespace kernel return drop_right(x, drop(x, k)); } + auto drop_right(object & x, object const& y) -> void + { + if (y.is()) + { + drop_right(cdr(x), cdr(y)); + } + else + { + cdr(x) = unit; + } + } + + auto drop_right(object & x, std::size_t k) -> object + { + if (let const y = drop(x, k); y.is()) + { + drop_right(x, cdr(y)); + return x; + } + else + { + return unit; + } + } + auto length(object const& xs) -> std::size_t { return std::distance(xs.begin(), xs.end()); diff --git a/test/srfi-1.ss b/test/srfi-1.ss index 1c6b82a70..9413a46c6 100644 --- a/test/srfi-1.ss +++ b/test/srfi-1.ss @@ -15,7 +15,7 @@ take take! drop take-right - drop-right + drop-right drop-right! last last-pair length+ @@ -105,13 +105,24 @@ (check (drop-right '(a b c . x) 2) => '(a)) (check (drop-right '(a b c . x) 3) => '()) -(let ((x '(a b c d e))) (check (take! x 0) => '()) (check x => '(a b c d e))) -(let ((x '(a b c d e))) (check (take! x 1) => '(a)) (check x => '(a))) -(let ((x '(a b c d e))) (check (take! x 2) => '(a b)) (check x => '(a b))) -(let ((x '(a b c d e))) (check (take! x 3) => '(a b c)) (check x => '(a b c))) -(let ((x '(a b c d e))) (check (take! x 4) => '(a b c d)) (check x => '(a b c d))) +(let ((x '(a b c d e))) (check (take! x 0) => '()) (check x => '(a b c d e))) +(let ((x '(a b c d e))) (check (take! x 1) => '(a)) (check x => '(a))) +(let ((x '(a b c d e))) (check (take! x 2) => '(a b)) (check x => '(a b))) +(let ((x '(a b c d e))) (check (take! x 3) => '(a b c)) (check x => '(a b c))) +(let ((x '(a b c d e))) (check (take! x 4) => '(a b c d)) (check x => '(a b c d))) (let ((x '(a b c d e))) (check (take! x 5) => '(a b c d e)) (check x => '(a b c d e))) +(let ((x '(a b c d e))) (check (drop-right! x 0) => '(a b c d e)) (check x => '(a b c d e))) +(let ((x '(a b c d e))) (check (drop-right! x 1) => '(a b c d)) (check x => '(a b c d))) +(let ((x '(a b c d e))) (check (drop-right! x 2) => '(a b c)) (check x => '(a b c))) +(let ((x '(a b c d e))) (check (drop-right! x 3) => '(a b)) (check x => '(a b))) +(let ((x '(a b c d e))) (check (drop-right! x 4) => '(a)) (check x => '(a))) +(let ((x '(a b c d e))) (check (drop-right! x 5) => '()) (check x => '(a b c d e))) +(let ((x '(a b c . z))) (check (drop-right! x 0) => '(a b c)) (check x => '(a b c))) +(let ((x '(a b c . z))) (check (drop-right! x 1) => '(a b)) (check x => '(a b))) +(let ((x '(a b c . z))) (check (drop-right! x 2) => '(a)) (check x => '(a))) +(let ((x '(a b c . z))) (check (drop-right! x 3) => '()) (check x => '(a b c . z))) + (check (last '(a)) => 'a) (check (last '(a b)) => 'b) (check (last '(a b c)) => 'c) @@ -127,4 +138,4 @@ (check-report) -(exit (check-passed? 89)) +(exit (check-passed? 109))