Skip to content

Commit

Permalink
Update character comparison procedures to built-in
Browse files Browse the repository at this point in the history
Signed-off-by: yamacir-kit <[email protected]>
  • Loading branch information
yamacir-kit committed Oct 3, 2023
1 parent 0904663 commit 5609bc4
Show file tree
Hide file tree
Showing 4 changed files with 61 additions and 29 deletions.
6 changes: 3 additions & 3 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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.18_amd64.deb
sudo apt install build/meevax_0.5.19_amd64.deb
```

or
Expand Down Expand Up @@ -131,9 +131,9 @@ sudo rm -rf /usr/local/share/meevax

| Target Name | Description
|-------------|-------------
| `all` | Build shared-library `libmeevax.0.5.18.so` and executable `meevax`
| `all` | Build shared-library `libmeevax.0.5.19.so` and executable `meevax`
| `test` | Test executable `meevax`
| `package` | Generate debian package `meevax_0.5.18_amd64.deb`
| `package` | Generate debian package `meevax_0.5.19_amd64.deb`
| `install` | Copy files into `/usr/local` directly

## Usage
Expand Down
2 changes: 1 addition & 1 deletion VERSION
Original file line number Diff line number Diff line change
@@ -1 +1 @@
0.5.18
0.5.19
32 changes: 7 additions & 25 deletions basis/r4rs.ss
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,13 @@

(define-library (scheme r4rs)
(import (only (meevax boolean) boolean? not)
(meevax character)
(only (meevax character)
char?
char=? char<? char>? char<=? char>=?
char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case?
char->integer integer->char
char-upcase char-downcase
)
(only (meevax core) begin define define-syntax if lambda letrec quote set!)
(only (meevax comparator) eq? eqv? equal?)
(only (meevax complex) make-rectangular make-polar real-part imag-part magnitude angle)
Expand Down Expand Up @@ -336,30 +342,6 @@
(simplest-rational (- x e)
(+ x e)))

(define (char-compare x xs compare) ; Chibi-Scheme
(let rec ((compare compare)
(lhs (char->integer x))
(xs xs))
(if (null? xs) #t
(let ((rhs (char->integer (car xs))))
(and (compare lhs rhs)
(rec compare rhs (cdr xs)))))))

(define (char=? x . xs) ; Chibi-Scheme
(char-compare x xs =))

(define (char<? x . xs) ; Chibi-Scheme
(char-compare x xs <))

(define (char>? x . xs) ; Chibi-Scheme
(char-compare x xs >))

(define (char<=? x . xs) ; Chibi-Scheme
(char-compare x xs <=))

(define (char>=? x . xs) ; Chibi-Scheme
(char-compare x xs >=))

(define (char-ci-compare x xs compare) ; Chibi-Scheme
(let rec ((compare compare)
(lhs (char->integer (char-downcase x)))
Expand Down
50 changes: 50 additions & 0 deletions src/kernel/boot.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,56 @@ inline namespace kernel
return xs[0].is<character>();
});

library.define<predicate>("char=?", [](let const& xs)
{
auto compare = [](let const& a, let const& b)
{
return not (a.as<character>().codepoint == b.as<character>().codepoint);
};

return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
});

library.define<predicate>("char<?", [](let const& xs)
{
auto compare = [](let const& a, let const& b)
{
return not (a.as<character>().codepoint < b.as<character>().codepoint);
};

return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
});

library.define<predicate>("char>?", [](let const& xs)
{
auto compare = [](let const& a, let const& b)
{
return not (a.as<character>().codepoint > b.as<character>().codepoint);
};

return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
});

library.define<predicate>("char<=?", [](let const& xs)
{
auto compare = [](let const& a, let const& b)
{
return not (a.as<character>().codepoint <= b.as<character>().codepoint);
};

return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
});

library.define<predicate>("char>=?", [](let const& xs)
{
auto compare = [](let const& a, let const& b)
{
return not (a.as<character>().codepoint >= b.as<character>().codepoint);
};

return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
});

library.define<predicate>("char-alphabetic?", [](let const& xs)
{
return xs[0].as<character>().property().is_letter();
Expand Down

0 comments on commit 5609bc4

Please sign in to comment.