Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

List #467

Merged
merged 24 commits into from
Oct 22, 2023
Merged

List #467

Changes from 1 commit
Commits
Show all changes
24 commits
Select commit Hold shift + click to select a range
00ea63e
Update procedure `xcons` to built-in
yamacir-kit Oct 11, 2023
02990be
Update procedure `last` and `last-pair` to built-in
yamacir-kit Oct 11, 2023
74ea30f
Update procedure `circular-list?` and `circular-list` to built-in
yamacir-kit Oct 12, 2023
df6d498
Update procedures `first`, `second`... `tenth` to built-in
yamacir-kit Oct 12, 2023
13abe47
Update procedure `dotted-list?` to built-in
yamacir-kit Oct 13, 2023
80f4bb1
Update procedure `not-pair?` to built-in
yamacir-kit Oct 13, 2023
66dce30
Update procedure `take` to built-in
yamacir-kit Oct 13, 2023
442c020
Update procedure `cons*` to built-int
yamacir-kit Oct 14, 2023
4c6da13
Update procedure `iota` to built-in
yamacir-kit Oct 14, 2023
973f489
Update procedure `null-list?` to built-in
yamacir-kit Oct 14, 2023
7514b06
Update procedure `list-copy` to built-in
yamacir-kit Oct 14, 2023
1eccc2c
Update procedure `drop` to built-in
yamacir-kit Oct 15, 2023
f863adc
Update procedure `take!` to built-in
yamacir-kit Oct 15, 2023
437aabd
Update procedures `take-right` and `drop-right` to built-in
yamacir-kit Oct 15, 2023
9173c06
Update procedure `drop-right!` to built-in
yamacir-kit Oct 15, 2023
2d1294c
Update procedure `length+` to built-in
yamacir-kit Oct 15, 2023
b06ec44
Update procedure `append!` to built-in
yamacir-kit Oct 15, 2023
f1fc749
Update procedures `concatenate` and `concatenate!` to built-in
yamacir-kit Oct 15, 2023
218b232
Update procedure `reverse!` to built-in
yamacir-kit Oct 15, 2023
8fdd2e3
Update procedures `alist-cons` and `alist-copy` to built-in
yamacir-kit Oct 16, 2023
0ff6e21
Update procedures `append-reverse` and `append-reverse!` to built-in
yamacir-kit Oct 16, 2023
c194efc
Cleanup
yamacir-kit Oct 21, 2023
5699ce0
Update `environment` to allow import of the same identifier if are sa…
yamacir-kit Oct 21, 2023
737fbf1
Support R7RS-large library `(scheme list)`
yamacir-kit Oct 21, 2023
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Update procedure drop-right! to built-in
Signed-off-by: yamacir-kit <httperror@404-notfound.jp>
yamacir-kit committed Oct 15, 2023
commit 9173c06b05d155ac866fd46d2a87cfdf8df4e01d
6 changes: 3 additions & 3 deletions README.md
Original file line number Diff line number Diff line change
@@ -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
2 changes: 1 addition & 1 deletion VERSION
Original file line number Diff line number Diff line change
@@ -1 +1 @@
0.5.49
0.5.50
26 changes: 4 additions & 22 deletions basis/srfi-1.ss
Original file line number Diff line number Diff line change
@@ -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)
2 changes: 2 additions & 0 deletions include/meevax/kernel/list.hpp
Original file line number Diff line number Diff line change
@@ -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;
5 changes: 5 additions & 0 deletions src/kernel/boot.cpp
Original file line number Diff line number Diff line change
@@ -732,6 +732,11 @@ inline namespace kernel
return drop_right(xs[0], xs[1].as<exact_integer>());
});

library.define<procedure>("drop-right!", [](let & xs)
{
return drop_right(xs[0], xs[1].as<exact_integer>());
});

library.define<procedure>("memq", [](let const& xs) -> auto const&
{
return memq(xs[0], xs[1]);
25 changes: 25 additions & 0 deletions src/kernel/list.cpp
Original file line number Diff line number Diff line change
@@ -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<pair>())
{
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<pair>())
{
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());
25 changes: 18 additions & 7 deletions test/srfi-1.ss
Original file line number Diff line number Diff line change
@@ -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))