diff --git a/CMakeLists.txt b/CMakeLists.txt index fcebcdac9..f59e8223f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -97,7 +97,7 @@ target_link_libraries(format PRIVATE kernel) add_custom_target(basis DEPENDS format - COMMAND ${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/basis/configure.cmake) + COMMAND ${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/configure/basis.cmake) # ---- Target shell ------------------------------------------------------------ diff --git a/README.md b/README.md index 91bc6528d..9fab71bc0 100644 --- a/README.md +++ b/README.md @@ -15,14 +15,6 @@ library is installed as a CMake package for [easy linking](./example/CMakeLists.txt), and [any C++ classes can be used from Lisp-1 scripts](./example/example.ss) [via simple stubs](example/example.cpp). -However, as the major version indicates, this implementation is still in its -infancy. Its performance is significantly inferior to that of common Scheme -implementations. For example, in a microbenchmark comparison with Chibi Scheme, -which can be embedded into C, Meevax takes more than 40x longer to compute than -Chibi Scheme. We will try to improve the performance in future development, but -we do not recommend using Meevax for anything other than toy programs, at least -at this time. - ### Releases Latest release is [here](https://github.com/yamacir-kit/meevax/releases). @@ -46,7 +38,7 @@ Meevax can be used as an interpreter that supports the Scheme standard specified - Revised4 Report on the Algorithmic Language Scheme (R4RS) [[Clinger and Rees 1991a](#Clinger-and-Rees-1991a)] - Revised5 Report on the Algorithmic Language Scheme (R5RS) [[Kelsey, Clinger and Rees 1998](#Kelsey-Clinger-and-Rees-1998)] -- Revised7 Report on the Algorithmic Language Scheme (R7RS) [[Shinn, Cowan and Glecker 2013](#Shinn-Cowan-and-Glecker-2013)] +- Revised7 Report on the Algorithmic Language Scheme (R7RS) [[Shinn, Cowan and Gleckler 2013](#Shinn-Cowan-and-Gleckler-2013)] Procedures for each standard are provided by the following R7RS-style libraries: @@ -54,34 +46,34 @@ Procedures for each standard are provided by the following R7RS-style libraries: |:--------:|--------------| | R4RS | [`(scheme r4rs)`](./basis/r4rs.ss) | R5RS | [`(scheme r5rs)`](./basis/r5rs.ss) -| R7RS | [`(scheme base)`](./basis/r7rs.ss) [`(scheme case-lambda)`](./basis/r7rs.ss) [`(scheme char)`](./basis/r7rs.ss) [`(scheme complex)`](./basis/r7rs.ss) [`(scheme cxr)`](./basis/r7rs.ss) [`(scheme eval)`](./basis/r7rs.ss) [`(scheme file)`](./basis/r7rs.ss) [`(scheme inexact)`](./basis/r7rs.ss) [`(scheme lazy)`](./basis/r7rs.ss) [`(scheme load)`](./basis/r7rs.ss) [`(scheme process-context)`](./basis/r7rs.ss) [`(scheme read)`](./basis/r7rs.ss) [`(scheme repl)`](./basis/r7rs.ss) [`(scheme time)`](./basis/r7rs.ss) [`(scheme write)`](./basis/r7rs.ss) [`(scheme r5rs)`](./basis/r5rs.ss) +| R7RS | [`(scheme base)`](./basis/r7rs.ss) [`(scheme box)`](./basis/r7rs.ss) [`(scheme case-lambda)`](./basis/r7rs.ss) [`(scheme char)`](./basis/r7rs.ss) [`(scheme complex)`](./basis/r7rs.ss) [`(scheme cxr)`](./basis/r7rs.ss) [`(scheme eval)`](./basis/r7rs.ss) [`(scheme file)`](./basis/r7rs.ss) [`(scheme inexact)`](./basis/r7rs.ss) [`(scheme lazy)`](./basis/r7rs.ss) [`(scheme load)`](./basis/r7rs.ss) [`(scheme process-context)`](./basis/r7rs.ss) [`(scheme read)`](./basis/r7rs.ss) [`(scheme repl)`](./basis/r7rs.ss) [`(scheme time)`](./basis/r7rs.ss) [`(scheme write)`](./basis/r7rs.ss) ### SRFIs -| Number | Title | Library name | Note | -|--------------------------------------------------------:|:-------------------------------------------------------|:------------------------------------|:------------------| -| [ 0](https://srfi.schemers.org/srfi-0/srfi-0.html) | Feature-based conditional expansion construct | [`(srfi 0)`](./basis/srfi-0.ss) | R7RS 4.2.1 | -| [ 1](https://srfi.schemers.org/srfi-1/srfi-1.html) | List Library | [`(srfi 1)`](./basis/srfi-1.ss) | | -| [ 4](https://srfi.schemers.org/srfi-4/srfi-4.html) | Homogeneous numeric vector datatypes | [`(srfi 4)`](./basis/srfi-4.ss) | R7RS 6.9 | -| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 | -| [ 8](https://srfi.schemers.org/srfi-8/srfi-8.html) | receive: Binding to multiple values | [`(srfi 8)`](./basis/srfi-8.ss) | | -| [ 9](https://srfi.schemers.org/srfi-9/srfi-9.html) | Defining Record Types | [`(srfi 9)`](./basis/srfi-9.ss) | R7RS 5.5 | -| [ 10](https://srfi.schemers.org/srfi-10/srfi-10.html) | #, external form | | | -| [ 11](https://srfi.schemers.org/srfi-11/srfi-11.html) | Syntax for receiving multiple values | [`(srfi 11)`](./basis/srfi-11.ss) | R7RS 4.2.2 | -| [ 16](https://srfi.schemers.org/srfi-16/srfi-16.html) | Syntax for procedures of variable arity | [`(srfi 16)`](./basis/srfi-16.ss) | R7RS 4.2.9 | -| [ 23](https://srfi.schemers.org/srfi-23/srfi-23.html) | Error reporting mechanism | [`(srfi 23)`](./basis/srfi-23.ss) | R7RS 6.11 | -| [ 30](https://srfi.schemers.org/srfi-30/srfi-30.html) | Nested Multi-line Comments | | R7RS 2.2 | -| [ 31](https://srfi.schemers.org/srfi-31/srfi-31.html) | A special form rec for recursive evaluation | [`(srfi 31)`](./basis/srfi-31.ss) | | -| [ 34](https://srfi.schemers.org/srfi-34/srfi-34.html) | Exception Handling for Programs | [`(srfi 34)`](./basis/srfi-34.ss) | R7RS 6.11 | -| [ 38](https://srfi.schemers.org/srfi-38/srfi-38.html) | External Representation for Data With Shared Structure | [`(srfi 38)`](./basis/srfi-38.ss) | R7RS 6.13.3 | -| [ 39](https://srfi.schemers.org/srfi-39/srfi-39.html) | Parameter objects | [`(srfi 39)`](./basis/srfi-39.ss) | R7RS 4.2.6 | -| [ 45](https://srfi.schemers.org/srfi-45/srfi-45.html) | Primitives for Expressing Iterative Lazy Algorithms | [`(srfi 45)`](./basis/srfi-45.ss) | R7RS 4.2.5 | -| [ 62](https://srfi.schemers.org/srfi-62/srfi-62.html) | S-expression comments | | R7RS 2.2 | -| [ 78](https://srfi.schemers.org/srfi-78/srfi-78.html) | Lightweight testing | [`(srfi 78)`](./basis/srfi-78.ss) | Except `check-ec` | -| [ 87](https://srfi.schemers.org/srfi-87/srfi-87.html) | => in case clauses | | R7RS 4.2.1 | -| [ 98](https://srfi.schemers.org/srfi-98/srfi-98.html) | An interface to access environment variables | [`(srfi 98)`](./basis/srfi-98.ss) | R7RS 6.14 | -| [111](https://srfi.schemers.org/srfi-111/srfi-111.html) | Boxes | [`(srfi 111)`](./basis/srfi-111.ss) | | -| [149](https://srfi.schemers.org/srfi-149/srfi-149.html) | Basic syntax-rules template extensions | [`(srfi 149)`](./basis/srfi-149.ss) | R7RS 4.3.2 | +| Number | Title | Library name | Note | +|--------------------------------------------------------:|--------------------------------------------------------|-------------------------------------|-----------------------------------| +| [ 0](https://srfi.schemers.org/srfi-0/srfi-0.html) | Feature-based conditional expansion construct | [`(srfi 0)`](./basis/srfi-0.ss) | R7RS 4.2.1 | +| [ 1](https://srfi.schemers.org/srfi-1/srfi-1.html) | List Library | [`(srfi 1)`](./basis/srfi-1.ss) | | +| [ 4](https://srfi.schemers.org/srfi-4/srfi-4.html) | Homogeneous numeric vector datatypes | [`(srfi 4)`](./basis/srfi-4.ss) | R7RS 6.9 | +| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 | +| [ 8](https://srfi.schemers.org/srfi-8/srfi-8.html) | receive: Binding to multiple values | [`(srfi 8)`](./basis/srfi-8.ss) | | +| [ 9](https://srfi.schemers.org/srfi-9/srfi-9.html) | Defining Record Types | [`(srfi 9)`](./basis/srfi-9.ss) | R7RS 5.5 | +| [ 10](https://srfi.schemers.org/srfi-10/srfi-10.html) | #, external form | | | +| [ 11](https://srfi.schemers.org/srfi-11/srfi-11.html) | Syntax for receiving multiple values | [`(srfi 11)`](./basis/srfi-11.ss) | R7RS 4.2.2 | +| [ 16](https://srfi.schemers.org/srfi-16/srfi-16.html) | Syntax for procedures of variable arity | [`(srfi 16)`](./basis/srfi-16.ss) | R7RS 4.2.9 | +| [ 23](https://srfi.schemers.org/srfi-23/srfi-23.html) | Error reporting mechanism | [`(srfi 23)`](./basis/srfi-23.ss) | R7RS 6.11 | +| [ 30](https://srfi.schemers.org/srfi-30/srfi-30.html) | Nested Multi-line Comments | | R7RS 2.2 | +| [ 31](https://srfi.schemers.org/srfi-31/srfi-31.html) | A special form rec for recursive evaluation | [`(srfi 31)`](./basis/srfi-31.ss) | | +| [ 34](https://srfi.schemers.org/srfi-34/srfi-34.html) | Exception Handling for Programs | [`(srfi 34)`](./basis/srfi-34.ss) | R7RS 6.11 | +| [ 38](https://srfi.schemers.org/srfi-38/srfi-38.html) | External Representation for Data With Shared Structure | [`(srfi 38)`](./basis/srfi-38.ss) | R7RS 6.13.3 | +| [ 39](https://srfi.schemers.org/srfi-39/srfi-39.html) | Parameter objects | [`(srfi 39)`](./basis/srfi-39.ss) | R7RS 4.2.6 | +| [ 45](https://srfi.schemers.org/srfi-45/srfi-45.html) | Primitives for Expressing Iterative Lazy Algorithms | [`(srfi 45)`](./basis/srfi-45.ss) | R7RS 4.2.5 | +| [ 62](https://srfi.schemers.org/srfi-62/srfi-62.html) | S-expression comments | | R7RS 2.2 | +| [ 78](https://srfi.schemers.org/srfi-78/srfi-78.html) | Lightweight testing | [`(srfi 78)`](./basis/srfi-78.ss) | Except `check-ec` | +| [ 87](https://srfi.schemers.org/srfi-87/srfi-87.html) | => in case clauses | | R7RS 4.2.1 | +| [ 98](https://srfi.schemers.org/srfi-98/srfi-98.html) | An interface to access environment variables | [`(srfi 98)`](./basis/srfi-98.ss) | R7RS 6.14 | +| [111](https://srfi.schemers.org/srfi-111/srfi-111.html) | Boxes | [`(srfi 111)`](./basis/srfi-111.ss) | [`(scheme box)`](./basis/r7rs.ss) | +| [149](https://srfi.schemers.org/srfi-149/srfi-149.html) | Basic syntax-rules template extensions | [`(srfi 149)`](./basis/srfi-149.ss) | R7RS 4.3.2 | ## Installation @@ -99,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.0_amd64.deb +sudo apt install build/meevax_0.5.32_amd64.deb ``` or @@ -131,9 +123,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.0.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.32.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.0_amd64.deb` +| `package` | Generate debian package `meevax_0.5.32_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage @@ -157,18 +149,18 @@ See [LICENSE](./LICENSE). ## References -| Authors | Year | Title | Journal Title / Publisher | Pages | -|-------------------------------------------------------------------------------------------------------|:----:|-------------------------------------------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------------------------------------------------------------|----------------| -| John McCarthy | 1960 | [Recursive functions of symbolic expressions and their computation by machine, Part I](https://dl.acm.org/doi/10.1145/367177.367199) | [Communications of the ACM, Volume 3, Issue 4](https://dl.acm.org/toc/cacm/1960/3/4) | 184‑195 | -| P. J. Landin | 1964 | [The Mechanical Evaluation of Expressions](https://academic.oup.com/comjnl/article/6/4/308/375725) | [The Computor Journal, Volume 6, Issue 4](https://academic.oup.com/comjnl/issue/6/4) | 308‑320 | -| Peter Henderson | 1980 | [Functional Programming: Application and Implementation](https://archive.org/details/functionalprogra0000hend/mode/2up) | Prentice Hall | | -| Alan Bawden and Jonathan Rees | 1988 | [Syntactic Closures](https://dl.acm.org/doi/10.1145/62678.62687) | [LFP '88: Proceedings of the 1988 ACM Conference on LISP and Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/62678) | 86‑95 | -| William Clinger and Jonathan Rees (Editors) | 1991 | [Revised4 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/382130.382133) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 3](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/3) | 1‑55 | -| Chris Hanson | 1991 | [A Syntactic Closures Macro Facility](https://dl.acm.org/doi/10.1145/1317265.1317267) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 9‑16 | -| William Clinger | 1991 | [Hygienic Macros Through Explicit Renaming](https://dl.acm.org/doi/10.1145/1317265.1317269) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 25‑28 | -| William Clinger and Jonathan Rees | 1991 | [Macros That Work](https://dl.acm.org/doi/10.1145/99583.99607) | [POPL '91: Proceedings of the 18th ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages](https://dl.acm.org/doi/proceedings/10.1145/99583) | 155‑162 | -| Rechard Kelsey, William Clinger and Jonathan Rees (Editors) | 1998 | [Revised5 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/290229.290234) | [ACM SIGPLAN Notices, Volume 33, Issue 9](https://dl.acm.org/toc/sigplan/1998/33/9) | 26‑76 | -| William E. Kempf | 2001 | [A garbage collection framework for C++](https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C) | https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C | | -| William E. Kempf | 2001 | [A garbage collection framework for C++ - Part II](https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II) | https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II | | -| Michael D. Adams and R. Kent Dybvig | 2008 | [Efficient Nondestructive Equality Checking for Trees and Graphs](https://dl.acm.org/doi/10.1145/1411204.1411230) | [ICFP '08: Proceedings of the 13th ACM SIGPLAN International Conference on Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/1411204) | 179‑188 | -| Alex Shinn, John Cowan and Arthur A. Gleckler (Editors) | 2013 | [Revised7 Report on the Algorithmic Language Scheme](https://standards.scheme.org/official/r7rs.pdf) | http://www.scheme-reports.org/ | | +| Authors | Year | Title | Journal Title / Publisher | Pages | +|--------------------------------------------------------------------------------------------------------|:----:|-------------------------------------------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------------------------------------------------------------|:--------------:| +| John McCarthy | 1960 | [Recursive functions of symbolic expressions and their computation by machine, Part I](https://dl.acm.org/doi/10.1145/367177.367199) | [Communications of the ACM, Volume 3, Issue 4](https://dl.acm.org/toc/cacm/1960/3/4) | 184‑195 | +| P. J. Landin | 1964 | [The Mechanical Evaluation of Expressions](https://academic.oup.com/comjnl/article/6/4/308/375725) | [The Computor Journal, Volume 6, Issue 4](https://academic.oup.com/comjnl/issue/6/4) | 308‑320 | +| Peter Henderson | 1980 | [Functional Programming: Application and Implementation](https://archive.org/details/functionalprogra0000hend/mode/2up) | Prentice Hall | | +| Alan Bawden and Jonathan Rees | 1988 | [Syntactic Closures](https://dl.acm.org/doi/10.1145/62678.62687) | [LFP '88: Proceedings of the 1988 ACM Conference on LISP and Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/62678) | 86‑95 | +| William Clinger and Jonathan Rees (Editors) | 1991 | [Revised4 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/382130.382133) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 3](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/3) | 1‑55 | +| Chris Hanson | 1991 | [A Syntactic Closures Macro Facility](https://dl.acm.org/doi/10.1145/1317265.1317267) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 9‑16 | +| William Clinger | 1991 | [Hygienic Macros Through Explicit Renaming](https://dl.acm.org/doi/10.1145/1317265.1317269) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 25‑28 | +| William Clinger and Jonathan Rees | 1991 | [Macros That Work](https://dl.acm.org/doi/10.1145/99583.99607) | [POPL '91: Proceedings of the 18th ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages](https://dl.acm.org/doi/proceedings/10.1145/99583) | 155‑162 | +| Rechard Kelsey, William Clinger and Jonathan Rees (Editors) | 1998 | [Revised5 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/290229.290234) | [ACM SIGPLAN Notices, Volume 33, Issue 9](https://dl.acm.org/toc/sigplan/1998/33/9) | 26‑76 | +| William E. Kempf | 2001 | [A garbage collection framework for C++](https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C) | https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C | | +| William E. Kempf | 2001 | [A garbage collection framework for C++ - Part II](https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II) | https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II | | +| Michael D. Adams and R. Kent Dybvig | 2008 | [Efficient Nondestructive Equality Checking for Trees and Graphs](https://dl.acm.org/doi/10.1145/1411204.1411230) | [ICFP '08: Proceedings of the 13th ACM SIGPLAN International Conference on Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/1411204) | 179‑188 | +| Alex Shinn, John Cowan and Arthur A. Gleckler (Editors) | 2013 | [Revised7 Report on the Algorithmic Language Scheme](https://standards.scheme.org/official/r7rs.pdf) | http://www.scheme-reports.org/ | | diff --git a/VERSION b/VERSION index 8f0916f76..32a910026 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.0 +0.5.32 diff --git a/basis/r4rs-essential.ss b/basis/r4rs-essential.ss deleted file mode 100644 index fe61bb6a8..000000000 --- a/basis/r4rs-essential.ss +++ /dev/null @@ -1,516 +0,0 @@ -(define-library (scheme r4rs essential) - (import (only (meevax boolean) boolean? not) - (meevax character) - (meevax core) - (only (meevax comparator) eq? eqv? equal?) - (meevax continuation) - (prefix (meevax environment) %) - (meevax function) - (meevax list) - (only (meevax macro-transformer) er-macro-transformer identifier?) - (meevax number) - (meevax pair) - (meevax port) - (prefix (meevax read) %) - (meevax string) - (meevax symbol) - (meevax vector) - (prefix (meevax write) %)) - - (export quote lambda if set! cond case and or let letrec begin quasiquote - define not boolean? eqv? eq? equal? pair? cons car cdr set-car! - set-cdr! caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr - cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr - cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr null? list? - list length append reverse list-ref memq memv member assq assv assoc - symbol? symbol->string string->symbol number? complex? real? - rational? integer? exact? inexact? = < > <= >= zero? positive? - negative? odd? even? max min + * - / abs quotient remainder modulo - gcd lcm floor ceiling truncate round number->string string->number - char? char=? char? char<=? char>=? char-ci=? char-ci? char-ci<=? char-ci>=? char-alphabetic? char-numeric? - char-whitespace? char-upper-case? char-lower-case? char->integer - integer->char char-upcase char-downcase string? make-string string - string-length string-ref string-set! string=? string? - string<=? string>=? string-ci=? string-ci? string-ci<=? - string-ci>=? substring string-append string->list list->string - vector? make-vector vector vector-length vector-ref vector-set! - vector->list list->vector procedure? apply map for-each - call-with-current-continuation call-with-input-file - call-with-output-file input-port? output-port? current-input-port - current-output-port open-input-file open-output-file close-input-port - close-output-port read read-char peek-char eof-object? write display - newline write-char load) - - #| - This library contains many procedure and syntax definitions copied from - Chibi-Scheme's script lib/init-7.scm. The definitions marked - "Chibi-Scheme" in this file are those. Such definitions are subject to the - following Chibi-Scheme license. - - --- - - Copyright (c) 2009-2021 Alex Shinn - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions are - met: - 1. Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - 2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - 3. The name of the author may not be used to endorse or promote products - derived from this software without specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR IMPLIED - WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED - TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR - PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF - LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING - NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS - SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - |# - - (begin (define-syntax cond ; Chibi-Scheme - (er-macro-transformer - (lambda (form rename compare) - (if (null? (cdr form)) - (if #f #f) - ((lambda (clause) - (if (compare (rename 'else) (car clause)) - (cons (rename 'begin) (cdr clause)) - (if (if (null? (cdr clause)) #t - (compare (rename '=>) (cadr clause))) - (list (list (rename 'lambda) - (list (rename 'result)) - (list (rename 'if) - (rename 'result) - (if (null? (cdr clause)) - (rename 'result) - (list (caddr clause) - (rename 'result))) - (cons (rename 'cond) (cddr form)))) - (car clause)) - (list (rename 'if) - (car clause) - (cons (rename 'begin) (cdr clause)) - (cons (rename 'cond) (cddr form)))))) - (cadr form)))))) - - (define-syntax and ; Chibi-Scheme - (er-macro-transformer - (lambda (form rename compare) - (cond ((null? (cdr form))) - ((null? (cddr form)) - (cadr form)) - (else (list (rename 'if) - (cadr form) - (cons (rename 'and) - (cddr form)) - #f)))))) - - (define-syntax or ; Chibi-Scheme - (er-macro-transformer - (lambda (form rename compare) - (cond ((null? (cdr form)) #f) - ((null? (cddr form)) - (cadr form)) - (else (list (list (rename 'lambda) - (list (rename 'result)) - (list (rename 'if) - (rename 'result) - (rename 'result) - (cons (rename 'or) - (cddr form)))) - (cadr form))))))) - - (define-syntax quasiquote ; Chibi-Scheme - (er-macro-transformer - (lambda (form rename compare) - (define (expand x depth) - (cond ((pair? x) - (cond ((compare (rename 'unquote) (car x)) - (if (<= depth 0) - (cadr x) - (list (rename 'list) - (list (rename 'quote) 'unquote) - (expand (cadr x) (- depth 1))))) - ((compare (rename 'unquote-splicing) (car x)) - (if (<= depth 0) - (list (rename 'cons) - (expand (car x) depth) - (expand (cdr x) depth)) - (list (rename 'list) - (list (rename 'quote) 'unquote-splicing) - (expand (cadr x) (- depth 1))))) - ((compare (rename 'quasiquote) (car x)) - (list (rename 'list) - (list (rename 'quote) 'quasiquote) - (expand (cadr x) (+ depth 1)))) - ((and (<= depth 0) - (pair? (car x)) - (compare (rename 'unquote-splicing) (caar x))) - (if (null? (cdr x)) - (cadar x) - (list (rename 'append) - (cadar x) - (expand (cdr x) depth)))) - (else (list (rename 'cons) - (expand (car x) depth) - (expand (cdr x) depth))))) - ((vector? x) - (list (rename 'list->vector) - (expand (vector->list x) depth))) - ((or (identifier? x) - (null? x)) - (list (rename 'quote) x)) - (else x))) - (expand (cadr form) 0)))) - - (define (every f xs) - (if (pair? xs) - (and (f (car xs)) - (every f (cdr xs))) - #t)) - - (define (map f x . xs) ; Chibi-Scheme - (define (map f x a) - (if (pair? x) - (map f - (cdr x) - (cons (f (car x)) a)) - (reverse a))) - (define (map* f xs a) - (if (every pair? xs) - (map* f - (map cdr xs '()) - (cons (apply f (map car xs '())) a)) - (reverse a))) - (if (null? xs) - (map f x '()) - (map* f (cons x xs) '()))) - - (define (apply f x . xs) ; Chibi-Scheme - (letrec ((apply (lambda (f xs) - (f . xs)))) - (if (null? xs) - (apply f x) - ((lambda (xs) - (apply f (append (reverse (cdr xs)) - (car xs)))) - (reverse (cons x xs)))))) - - (define-syntax let ; Chibi-Scheme - (er-macro-transformer - (lambda (form rename compare) - (if (identifier? (cadr form)) - `(,(rename 'letrec) ((,(cadr form) - (,(rename 'lambda) ,(map car (caddr form)) ,@(cdddr form)))) - (,(cadr form) ,@(map cadr (caddr form)))) - `((,(rename 'lambda) ,(map car (cadr form)) ,@(cddr form)) - ,@(map cadr (cadr form))))))) - - (define (list? x) - (let list? ((x x) - (lag x)) - (if (pair? x) - (let ((x (cdr x))) - (if (pair? x) - (let ((x (cdr x)) - (lag (cdr lag))) - (and (not (eq? x lag)) - (list? x lag))) - (null? x))) - (null? x)))) - - (define-syntax case ; Chibi-Scheme - (er-macro-transformer - (lambda (form rename compare) - (define (body xs) - (cond ((null? xs) (rename 'result)) - ((compare (rename '=>) (car xs)) `(,(cadr xs) ,(rename 'result))) - (else `(,(rename 'begin) ,@xs)))) - (define (each-clause clauses) - (cond ((null? clauses) - (if #f #f)) - ((compare (rename 'else) (caar clauses)) - (body (cdar clauses))) - ((and (pair? (caar clauses)) - (null? (cdaar clauses))) - `(,(rename 'if) (,(rename 'eqv?) ,(rename 'result) - (,(rename 'quote) ,(caaar clauses))) - ,(body (cdar clauses)) - ,(each-clause (cdr clauses)))) - (else `(,(rename 'if) (,(rename 'memv) ,(rename 'result) - (,(rename 'quote) ,(caar clauses))) - ,(body (cdar clauses)) - ,(each-clause (cdr clauses)))))) - `(,(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 assoc ((alist alist)) - (if (null? alist) #f - (if (compare key (caar alist)) - (car alist) - (assoc (cdr alist))))))) - - (define (exact? z) - (define (exact-complex? x) - (and (imaginary? x) - (exact? (real-part x)) - (exact? (imag-part x)))) - (or (exact-complex? z) - (ratio? z) - (exact-integer? z))) - - (define (inexact? z) - (define (inexact-complex? x) - (and (imaginary? x) - (or (inexact? (real-part x)) - (inexact? (imag-part x))))) - (define (floating-point? z) - (or (single-float? z) - (double-float? z))) - (or (inexact-complex? z) - (floating-point? z))) - - (define (zero? n) - (= n 0)) - - (define (positive? n) - (> n 0)) - - (define (negative? n) - (< n 0)) - - (define (odd? n) - (not (even? n))) - - (define (even? n) - (= (remainder n 2) 0)) - - (define (max x . xs) ; Chibi-Scheme - (define (max-aux x xs) - (if (null? xs) - (inexact x) - (max-aux (if (< x (car xs)) (car xs) x) - (cdr xs)))) - (if (inexact? x) - (max-aux x xs) - (let rec ((x x) (xs xs)) - (cond ((null? xs) x) - ((inexact? (car xs)) (max-aux x xs)) - (else (rec (if (< x (car xs)) (car xs) x) - (cdr xs))))))) - - (define (min x . xs) ; Chibi-Scheme - (define (min-aux x xs) - (if (null? xs) - (inexact x) - (min-aux (if (< (car xs) x) (car xs) x) - (cdr xs)))) - (if (inexact? x) - (min-aux x xs) - (let rec ((x x) (xs xs)) - (cond ((null? xs) x) - ((inexact? (car xs)) (min-aux x xs)) - (else (rec (if (< (car xs) x) (car xs) x) - (cdr xs))))))) - - (define (quotient x y) - (truncate (/ x y))) - - (define remainder %) - - (define (modulo x y) - (% (+ y (% x y)) y)) - - (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 (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-ci-compare x xs compare) ; Chibi-Scheme - (let rec ((compare compare) - (lhs (char->integer (char-downcase x))) - (xs xs)) - (if (null? xs) #t - (let ((rhs (char->integer (char-downcase (car xs))))) - (and (compare lhs rhs) - (rec compare rhs (cdr xs))))))) - - (define (char-ci=? x . xs) ; Chibi-Scheme - (char-ci-compare x xs =)) - - (define (char-ci? x . xs) ; Chibi-Scheme - (char-ci-compare x xs >)) - - (define (char-ci<=? x . xs) ; Chibi-Scheme - (char-ci-compare x xs <=)) - - (define (char-ci>=? x . xs) ; Chibi-Scheme - (char-ci-compare x xs >=)) - - (define (string . xs) ; Chibi-Scheme - (list->string xs)) - - (define (string-map f x . xs) ; R7RS - (if (null? xs) - (list->string (map f (string->list x))) - (list->string (apply map f (map string->list (cons x xs)))))) - - (define (string-foldcase s) ; R7RS - (string-map char-downcase s)) - - (define (string-ci=? . xs) - (apply string=? (map string-foldcase xs))) - - (define (string-ci? . xs) - (apply string>? (map string-foldcase xs))) - - (define (string-ci<=? . xs) - (apply string<=? (map string-foldcase xs))) - - (define (string-ci>=? . xs) - (apply string>=? (map string-foldcase xs))) - - (define substring string-copy) - - (define (procedure? x) - (or (closure? x) - (continuation? x) - (foreign-function? x))) - - (define (for-each f x . xs) ; Chibi-Scheme - (if (null? xs) - (letrec ((for-each (lambda (f x) - (if (pair? x) - (begin (f (car x)) - (for-each f (cdr x))))))) - (for-each f x)) - (begin (apply map f x xs) - (if #f #f)))) - - (define (call-with-input-file path f) ; R7RS incompatible (values unsupported) - (define (call-with-input-port port f) - (let ((result (f port))) - (close-input-port port) - result)) - (call-with-input-port (open-input-file path) f)) - - (define (call-with-output-file path f) ; R7RS incompatible (values unsupported) - (define (call-with-output-port port f) - (let ((result (f port))) - (close-output-port port) - result)) - (call-with-output-port (open-output-file path) f)) - - (define current-input-port standard-input-port) - - (define current-output-port standard-output-port) - - (define close-input-port close) - - (define close-output-port close) - - (define (read . xs) - (%read (if (pair? xs) - (car xs) - (current-input-port)))) - - (define (read-char . xs) - (%get-char (if (pair? xs) - (car xs) - (current-input-port)))) - - (define (peek-char . xs) - (%peek-char (if (pair? xs) - (car xs) - (current-input-port)))) - - (define (write x . port) - (%write x (if (pair? port) - (car port) - (current-output-port)))) - - (define (write-char x . port) - (%put-char x (if (pair? port) - (car port) - (current-output-port)))) - - (define (display x . xs) - (cond ((char? x) - (apply write-char x xs)) - ((string? x) - (%put-string x (if (pair? xs) ; NOTE: The procedure write-string is not defined in R4RS. - (car xs) - (current-output-port)))) - (else (apply write x xs)))) - - (define (newline . port) - (apply write-char #\newline port)) - - (define (load filename . xs) - (%load (if (pair? xs) - (car xs) - (%interaction-environment)) - filename)))) diff --git a/basis/r4rs.ss b/basis/r4rs.ss index f5bc2eb43..71a31bfff 100644 --- a/basis/r4rs.ss +++ b/basis/r4rs.ss @@ -1,15 +1,60 @@ +#| + This library contains many procedure and syntax definitions copied from + Chibi-Scheme's script lib/init-7.scm. The definitions marked "Chibi-Scheme" + in this file are those. Such definitions are subject to the following + Chibi-Scheme license. + + --- + + Copyright (c) 2009-2021 Alex Shinn + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + 1. Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + + 3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR IMPLIED + WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# + (define-library (scheme r4rs) - (import (meevax inexact) - (only (meevax core) define-syntax) - (only (meevax list) list-tail) - (only (meevax macro-transformer) er-macro-transformer) - (only (meevax number) exact-integer? expt exact inexact ratio? ratio-numerator ratio-denominator) - (prefix (meevax port) %) + (import (only (meevax boolean) boolean? not) + (only (meevax character) char? char=? char? char<=? char>=? char-ci=? char-ci? char-ci<=? char-ci>=? char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case? char->integer integer->char char-upcase char-downcase) + (only (meevax comparator) eq? eqv? equal?) + (only (meevax complex) make-rectangular make-polar real-part imag-part magnitude angle) + (only (meevax continuation) call-with-current-continuation) + (only (meevax core) begin define define-syntax if lambda letrec quote set!) + (only (meevax inexact) exp log sqrt sin cos tan asin acos atan) + (only (meevax list) null? list? list length append reverse list-tail list-ref memq memv assq assv) + (only (meevax macro-transformer) er-macro-transformer identifier?) + (only (meevax number) number? complex? real? rational? integer? exact? inexact? = < > <= >= zero? positive? negative? odd? even? max min + * - / abs quotient remainder modulo gcd lcm numerator denominator floor ceiling truncate round expt exact inexact number->string string->number) + (only (meevax pair) pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr) + (only (meevax port) input-port? output-port? standard-input-port standard-output-port open-input-file open-output-file close eof-object?) + (only (meevax procedure) procedure?) + (only (meevax string) string? make-string string string-length string-ref string-set! string=? string? string<=? string>=? string-ci=? string-ci? string-ci<=? string-ci>=? string-append string->list list->string string-copy string-fill!) + (only (meevax symbol) symbol? symbol->string string->symbol) + (only (meevax vector) vector? make-vector vector vector-length vector-ref vector-set! vector->list list->vector vector-fill!) + (prefix (only (meevax environment) load) %) (prefix (meevax read) %) - (only (meevax string) string-copy) - (only (meevax vector) vector-fill!) - (scheme r4rs essential) - (srfi 45)) + (prefix (meevax write) %) + (only (srfi 45) delay force)) (export quote lambda if set! cond case and or let let* letrec begin do delay quasiquote define not boolean? eqv? eq? equal? pair? cons car cdr @@ -31,51 +76,157 @@ char-downcase string? make-string string string-length string-ref string-set! string=? string? string<=? string>=? string-ci=? string-ci? string-ci<=? string-ci>=? - substring string-append string->list list->string string-copy - string-fill! vector? make-vector vector vector-length vector-ref - vector-set! vector->list list->vector vector-fill! procedure? apply - map for-each force call-with-current-continuation - call-with-input-file call-with-output-file input-port? output-port? - current-input-port current-output-port with-input-from-file - with-output-to-file open-input-file open-output-file close-input-port - close-output-port read read-char peek-char eof-object? char-ready? - write display newline write-char load) - - #| - This library contains many procedure and syntax definitions copied from - Chibi-Scheme's script lib/init-7.scm. The definitions marked - "Chibi-Scheme" in this file are those. Such definitions are subject to the - following Chibi-Scheme license. - - --- - - Copyright (c) 2009-2021 Alex Shinn - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions are - met: - 1. Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - 2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - 3. The name of the author may not be used to endorse or promote products - derived from this software without specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR IMPLIED - WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED - TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR - PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF - LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING - NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS - SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - |# - - (begin (define-syntax let* + (rename string-copy substring) string-append string->list + list->string string-copy string-fill! vector? make-vector vector + vector-length vector-ref vector-set! vector->list list->vector + vector-fill! procedure? apply map for-each force + call-with-current-continuation call-with-input-file + call-with-output-file input-port? output-port? current-input-port + current-output-port with-input-from-file with-output-to-file + open-input-file open-output-file close-input-port close-output-port + read read-char peek-char eof-object? char-ready? write display + newline write-char load) + + (begin (define-syntax cond ; Chibi-Scheme + (er-macro-transformer + (lambda (form rename compare) + (if (null? (cdr form)) + (if #f #f) + ((lambda (clause) + (if (compare (rename 'else) (car clause)) + (cons (rename 'begin) (cdr clause)) + (if (if (null? (cdr clause)) #t + (compare (rename '=>) (cadr clause))) + (list (list (rename 'lambda) + (list (rename 'result)) + (list (rename 'if) + (rename 'result) + (if (null? (cdr clause)) + (rename 'result) + (list (caddr clause) + (rename 'result))) + (cons (rename 'cond) (cddr form)))) + (car clause)) + (list (rename 'if) + (car clause) + (cons (rename 'begin) (cdr clause)) + (cons (rename 'cond) (cddr form)))))) + (cadr form)))))) + + (define-syntax and ; Chibi-Scheme + (er-macro-transformer + (lambda (form rename compare) + (cond ((null? (cdr form))) + ((null? (cddr form)) + (cadr form)) + (else (list (rename 'if) + (cadr form) + (cons (rename 'and) + (cddr form)) + #f)))))) + + (define-syntax or ; Chibi-Scheme + (er-macro-transformer + (lambda (form rename compare) + (cond ((null? (cdr form)) #f) + ((null? (cddr form)) + (cadr form)) + (else (list (list (rename 'lambda) + (list (rename 'result)) + (list (rename 'if) + (rename 'result) + (rename 'result) + (cons (rename 'or) + (cddr form)))) + (cadr form))))))) + + (define-syntax quasiquote ; Chibi-Scheme + (er-macro-transformer + (lambda (form rename compare) + (define (expand x depth) + (cond ((pair? x) + (cond ((compare (rename 'unquote) (car x)) + (if (<= depth 0) + (cadr x) + (list (rename 'list) + (list (rename 'quote) 'unquote) + (expand (cadr x) (- depth 1))))) + ((compare (rename 'unquote-splicing) (car x)) + (if (<= depth 0) + (list (rename 'cons) + (expand (car x) depth) + (expand (cdr x) depth)) + (list (rename 'list) + (list (rename 'quote) 'unquote-splicing) + (expand (cadr x) (- depth 1))))) + ((compare (rename 'quasiquote) (car x)) + (list (rename 'list) + (list (rename 'quote) 'quasiquote) + (expand (cadr x) (+ depth 1)))) + ((and (<= depth 0) + (pair? (car x)) + (compare (rename 'unquote-splicing) (caar x))) + (if (null? (cdr x)) + (cadar x) + (list (rename 'append) + (cadar x) + (expand (cdr x) depth)))) + (else (list (rename 'cons) + (expand (car x) depth) + (expand (cdr x) depth))))) + ((vector? x) + (list (rename 'list->vector) + (expand (vector->list x) depth))) + ((or (identifier? x) + (null? x)) + (list (rename 'quote) x)) + (else x))) + (expand (cadr form) 0)))) + + (define (every f xs) + (if (pair? xs) + (and (f (car xs)) + (every f (cdr xs))) + #t)) + + (define (map f x . xs) ; Chibi-Scheme + (define (map f x a) + (if (pair? x) + (map f + (cdr x) + (cons (f (car x)) a)) + (reverse a))) + (define (map* f xs a) + (if (every pair? xs) + (map* f + (map cdr xs '()) + (cons (apply f (map car xs '())) a)) + (reverse a))) + (if (null? xs) + (map f x '()) + (map* f (cons x xs) '()))) + + (define (apply f x . xs) ; Chibi-Scheme + (letrec ((apply (lambda (f xs) + (f . xs)))) + (if (null? xs) + (apply f x) + ((lambda (xs) + (apply f (append (reverse (cdr xs)) + (car xs)))) + (reverse (cons x xs)))))) + + (define-syntax let ; Chibi-Scheme + (er-macro-transformer + (lambda (form rename compare) + (if (identifier? (cadr form)) + `(,(rename 'letrec) ((,(cadr form) + (,(rename 'lambda) ,(map car (caddr form)) ,@(cdddr form)))) + (,(cadr form) ,@(map cadr (caddr form)))) + `((,(rename 'lambda) ,(map car (cadr form)) ,@(cddr form)) + ,@(map cadr (cadr form))))))) + + (define-syntax let* (er-macro-transformer (lambda (form rename compare) (if (null? (cadr form)) @@ -106,16 +257,45 @@ (,(rename 'begin) ,@(cdaddr form)) ,body))))))) - (define (numerator x) ; Chibi-Scheme - (cond ((ratio? x) (ratio-numerator x)) - ((exact? x) x) - (else (inexact (numerator (exact x)))))) + (define-syntax case ; Chibi-Scheme + (er-macro-transformer + (lambda (form rename compare) + (define (body xs) + (cond ((null? xs) (rename 'result)) + ((compare (rename '=>) (car xs)) `(,(cadr xs) ,(rename 'result))) + (else `(,(rename 'begin) ,@xs)))) + (define (each-clause clauses) + (cond ((null? clauses) + (if #f #f)) + ((compare (rename 'else) (caar clauses)) + (body (cdar clauses))) + ((and (pair? (caar clauses)) + (null? (cdaar clauses))) + `(,(rename 'if) (,(rename 'eqv?) ,(rename 'result) + (,(rename 'quote) ,(caaar clauses))) + ,(body (cdar clauses)) + ,(each-clause (cdr clauses)))) + (else `(,(rename 'if) (,(rename 'memv) ,(rename 'result) + (,(rename 'quote) ,(caar clauses))) + ,(body (cdar clauses)) + ,(each-clause (cdr clauses)))))) + `(,(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 (denominator x) ; Chibi-Scheme - (cond ((ratio? x) (ratio-denominator x)) - ((exact? x) 1) - ((integer? x) 1.0) - (else (inexact (denominator (exact x)))))) + (define (assoc key alist . compare) ; Chibi-Scheme + (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 (rationalize x e) ; IEEE Std 1178-1990 ANNEX C.4 (define (simplest-rational x y) @@ -144,51 +324,37 @@ (simplest-rational (- x e) (+ x e))) - (define (make-rectangular x y) ; Chibi-Scheme - (+ x (* y (sqrt -1)))) - - (define (make-polar radius phi) ; Chibi-Scheme - (make-rectangular (* radius (cos phi)) - (* radius (sin phi)))) - - (define (real-part z) - (if (imaginary? z) (car z) z)) - - (define (imag-part z) - (if (imaginary? z) (cdr z) 0)) + (define (for-each f x . xs) ; Chibi-Scheme + (if (null? xs) + (letrec ((for-each (lambda (f x) + (if (pair? x) + (begin (f (car x)) + (for-each f (cdr x))))))) + (for-each f x)) + (begin (apply map f x xs) + (if #f #f)))) - (define (magnitude z) ; Chibi-Scheme - (sqrt (+ (square (real-part z)) - (square (imag-part z))))) + (define (call-with-input-file path f) ; R7RS incompatible (values unsupported) + (define (call-with-input-port port f) + (let ((result (f port))) + (close-input-port port) + result)) + (call-with-input-port (open-input-file path) f)) - (define (angle z) ; Chibi-Scheme - (atan (imag-part z) - (real-part z))) + (define (call-with-output-file path f) ; R7RS incompatible (values unsupported) + (define (call-with-output-port port f) + (let ((result (f port))) + (close-output-port port) + result)) + (call-with-output-port (open-output-file path) f)) - (define (string-fill! s c . o) ; Chibi-Scheme - (let ((start (if (and (pair? o) - (exact-integer? (car o))) - (car o) - 0)) - (end (if (and (pair? o) - (pair? (cdr o)) - (exact-integer? (cadr o))) - (cadr o) - (string-length s)))) - (let rec ((k (- end 1))) - (if (<= start k) - (begin (string-set! s k c) - (rec (- k 1))))))) + (define %current-input-port (standard-input-port)) - (define %current-input-port (%standard-input-port)) + (define (current-input-port) %current-input-port) - (define (current-input-port) - %current-input-port) + (define %current-output-port (standard-output-port)) - (define %current-output-port (%standard-output-port)) - - (define (current-output-port) - %current-output-port) + (define (current-output-port) %current-output-port) (define (with-input-from-file path thunk) (let ((previous-input-port (current-input-port))) @@ -202,7 +368,54 @@ (thunk) (set! %current-output-port previous-output-port))) + (define close-input-port close) + + (define close-output-port close) + + (define (read . xs) + (%read (if (pair? xs) + (car xs) + (current-input-port)))) + + (define (read-char . xs) + (%get-char (if (pair? xs) + (car xs) + (current-input-port)))) + + (define (peek-char . xs) + (%peek-char (if (pair? xs) + (car xs) + (current-input-port)))) + (define (char-ready? . xs) (%get-char-ready? (if (pair? xs) (car xs) - (current-input-port)))))) + (current-input-port)))) + + (define (write x . port) + (%write x (if (pair? port) + (car port) + (current-output-port)))) + + (define (write-char x . port) + (%put-char x (if (pair? port) + (car port) + (current-output-port)))) + + (define (display x . xs) + (cond ((char? x) + (apply write-char x xs)) + ((string? x) + (%put-string x (if (pair? xs) ; NOTE: The procedure write-string is not defined in R4RS. + (car xs) + (current-output-port)))) + (else (apply write x xs)))) + + (define (newline . port) + (apply write-char #\newline port)) + + (define (load filename . xs) + (%load (if (pair? xs) + (car xs) + (%interaction-environment)) + filename)))) diff --git a/basis/r7rs.ss b/basis/r7rs.ss index 214b6b5f0..1738f4a7e 100644 --- a/basis/r7rs.ss +++ b/basis/r7rs.ss @@ -394,6 +394,10 @@ (car xs) (current-output-port)))))) +(define-library (scheme box) + (import (srfi 111)) + (export box box? unbox set-box!)) + (define-library (scheme case-lambda) (import (srfi 16)) (export case-lambda)) @@ -421,8 +425,7 @@ (string-map char-foldcase x)))) (define-library (scheme complex) - (import (only (meevax complex) make-rectangular real-part imag-part) - (only (scheme r5rs) make-polar magnitude angle)) + (import (only (scheme r5rs) make-rectangular make-polar real-part imag-part magnitude angle)) (export make-rectangular make-polar real-part imag-part magnitude angle)) (define-library (scheme cxr) diff --git a/basis/srfi-45.ss b/basis/srfi-45.ss index 6e07b5634..5a550fe38 100644 --- a/basis/srfi-45.ss +++ b/basis/srfi-45.ss @@ -1,7 +1,10 @@ (define-library (srfi 45) ; Based on r7rs reference implementation. - (import (only (meevax core) define-syntax) + (import (only (meevax boolean) not) + (only (meevax comparator) eq?) + (only (meevax core) define define-syntax if lambda quote) + (only (meevax list) list) (only (meevax macro-transformer) er-macro-transformer) - (scheme r4rs essential)) + (only (meevax pair) pair? cons car cdr cadr cddr set-car! set-cdr!)) (export delay eager force lazy promise?) @@ -11,8 +14,9 @@ (cons (cons done? value))) (define (promise? x) - (and (pair? x) - (eq? (car x)))) + (if (pair? x) + (eq? (car x)) + #f)) (define promise-done? cadr) diff --git a/configure/README.md b/configure/README.md index db3661b97..245acfa70 100644 --- a/configure/README.md +++ b/configure/README.md @@ -15,14 +15,6 @@ library is installed as a CMake package for [easy linking](./example/CMakeLists.txt), and [any C++ classes can be used from Lisp-1 scripts](./example/example.ss) [via simple stubs](example/example.cpp). -However, as the major version indicates, this implementation is still in its -infancy. Its performance is significantly inferior to that of common Scheme -implementations. For example, in a microbenchmark comparison with Chibi Scheme, -which can be embedded into C, Meevax takes more than 40x longer to compute than -Chibi Scheme. We will try to improve the performance in future development, but -we do not recommend using Meevax for anything other than toy programs, at least -at this time. - ### Releases Latest release is [here](https://github.com/yamacir-kit/meevax/releases). @@ -46,7 +38,7 @@ Meevax can be used as an interpreter that supports the Scheme standard specified - Revised4 Report on the Algorithmic Language Scheme (R4RS) [[Clinger and Rees 1991a](#Clinger-and-Rees-1991a)] - Revised5 Report on the Algorithmic Language Scheme (R5RS) [[Kelsey, Clinger and Rees 1998](#Kelsey-Clinger-and-Rees-1998)] -- Revised7 Report on the Algorithmic Language Scheme (R7RS) [[Shinn, Cowan and Glecker 2013](#Shinn-Cowan-and-Glecker-2013)] +- Revised7 Report on the Algorithmic Language Scheme (R7RS) [[Shinn, Cowan and Gleckler 2013](#Shinn-Cowan-and-Gleckler-2013)] Procedures for each standard are provided by the following R7RS-style libraries: @@ -54,34 +46,34 @@ Procedures for each standard are provided by the following R7RS-style libraries: |:--------:|--------------| | R4RS | [`(scheme r4rs)`](./basis/r4rs.ss) | R5RS | [`(scheme r5rs)`](./basis/r5rs.ss) -| R7RS | [`(scheme base)`](./basis/r7rs.ss) [`(scheme case-lambda)`](./basis/r7rs.ss) [`(scheme char)`](./basis/r7rs.ss) [`(scheme complex)`](./basis/r7rs.ss) [`(scheme cxr)`](./basis/r7rs.ss) [`(scheme eval)`](./basis/r7rs.ss) [`(scheme file)`](./basis/r7rs.ss) [`(scheme inexact)`](./basis/r7rs.ss) [`(scheme lazy)`](./basis/r7rs.ss) [`(scheme load)`](./basis/r7rs.ss) [`(scheme process-context)`](./basis/r7rs.ss) [`(scheme read)`](./basis/r7rs.ss) [`(scheme repl)`](./basis/r7rs.ss) [`(scheme time)`](./basis/r7rs.ss) [`(scheme write)`](./basis/r7rs.ss) [`(scheme r5rs)`](./basis/r5rs.ss) +| R7RS | [`(scheme base)`](./basis/r7rs.ss) [`(scheme box)`](./basis/r7rs.ss) [`(scheme case-lambda)`](./basis/r7rs.ss) [`(scheme char)`](./basis/r7rs.ss) [`(scheme complex)`](./basis/r7rs.ss) [`(scheme cxr)`](./basis/r7rs.ss) [`(scheme eval)`](./basis/r7rs.ss) [`(scheme file)`](./basis/r7rs.ss) [`(scheme inexact)`](./basis/r7rs.ss) [`(scheme lazy)`](./basis/r7rs.ss) [`(scheme load)`](./basis/r7rs.ss) [`(scheme process-context)`](./basis/r7rs.ss) [`(scheme read)`](./basis/r7rs.ss) [`(scheme repl)`](./basis/r7rs.ss) [`(scheme time)`](./basis/r7rs.ss) [`(scheme write)`](./basis/r7rs.ss) ### SRFIs -| Number | Title | Library name | Note | -|--------------------------------------------------------:|:-------------------------------------------------------|:------------------------------------|:------------------| -| [ 0](https://srfi.schemers.org/srfi-0/srfi-0.html) | Feature-based conditional expansion construct | [`(srfi 0)`](./basis/srfi-0.ss) | R7RS 4.2.1 | -| [ 1](https://srfi.schemers.org/srfi-1/srfi-1.html) | List Library | [`(srfi 1)`](./basis/srfi-1.ss) | | -| [ 4](https://srfi.schemers.org/srfi-4/srfi-4.html) | Homogeneous numeric vector datatypes | [`(srfi 4)`](./basis/srfi-4.ss) | R7RS 6.9 | -| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 | -| [ 8](https://srfi.schemers.org/srfi-8/srfi-8.html) | receive: Binding to multiple values | [`(srfi 8)`](./basis/srfi-8.ss) | | -| [ 9](https://srfi.schemers.org/srfi-9/srfi-9.html) | Defining Record Types | [`(srfi 9)`](./basis/srfi-9.ss) | R7RS 5.5 | -| [ 10](https://srfi.schemers.org/srfi-10/srfi-10.html) | #, external form | | | -| [ 11](https://srfi.schemers.org/srfi-11/srfi-11.html) | Syntax for receiving multiple values | [`(srfi 11)`](./basis/srfi-11.ss) | R7RS 4.2.2 | -| [ 16](https://srfi.schemers.org/srfi-16/srfi-16.html) | Syntax for procedures of variable arity | [`(srfi 16)`](./basis/srfi-16.ss) | R7RS 4.2.9 | -| [ 23](https://srfi.schemers.org/srfi-23/srfi-23.html) | Error reporting mechanism | [`(srfi 23)`](./basis/srfi-23.ss) | R7RS 6.11 | -| [ 30](https://srfi.schemers.org/srfi-30/srfi-30.html) | Nested Multi-line Comments | | R7RS 2.2 | -| [ 31](https://srfi.schemers.org/srfi-31/srfi-31.html) | A special form rec for recursive evaluation | [`(srfi 31)`](./basis/srfi-31.ss) | | -| [ 34](https://srfi.schemers.org/srfi-34/srfi-34.html) | Exception Handling for Programs | [`(srfi 34)`](./basis/srfi-34.ss) | R7RS 6.11 | -| [ 38](https://srfi.schemers.org/srfi-38/srfi-38.html) | External Representation for Data With Shared Structure | [`(srfi 38)`](./basis/srfi-38.ss) | R7RS 6.13.3 | -| [ 39](https://srfi.schemers.org/srfi-39/srfi-39.html) | Parameter objects | [`(srfi 39)`](./basis/srfi-39.ss) | R7RS 4.2.6 | -| [ 45](https://srfi.schemers.org/srfi-45/srfi-45.html) | Primitives for Expressing Iterative Lazy Algorithms | [`(srfi 45)`](./basis/srfi-45.ss) | R7RS 4.2.5 | -| [ 62](https://srfi.schemers.org/srfi-62/srfi-62.html) | S-expression comments | | R7RS 2.2 | -| [ 78](https://srfi.schemers.org/srfi-78/srfi-78.html) | Lightweight testing | [`(srfi 78)`](./basis/srfi-78.ss) | Except `check-ec` | -| [ 87](https://srfi.schemers.org/srfi-87/srfi-87.html) | => in case clauses | | R7RS 4.2.1 | -| [ 98](https://srfi.schemers.org/srfi-98/srfi-98.html) | An interface to access environment variables | [`(srfi 98)`](./basis/srfi-98.ss) | R7RS 6.14 | -| [111](https://srfi.schemers.org/srfi-111/srfi-111.html) | Boxes | [`(srfi 111)`](./basis/srfi-111.ss) | | -| [149](https://srfi.schemers.org/srfi-149/srfi-149.html) | Basic syntax-rules template extensions | [`(srfi 149)`](./basis/srfi-149.ss) | R7RS 4.3.2 | +| Number | Title | Library name | Note | +|--------------------------------------------------------:|--------------------------------------------------------|-------------------------------------|-----------------------------------| +| [ 0](https://srfi.schemers.org/srfi-0/srfi-0.html) | Feature-based conditional expansion construct | [`(srfi 0)`](./basis/srfi-0.ss) | R7RS 4.2.1 | +| [ 1](https://srfi.schemers.org/srfi-1/srfi-1.html) | List Library | [`(srfi 1)`](./basis/srfi-1.ss) | | +| [ 4](https://srfi.schemers.org/srfi-4/srfi-4.html) | Homogeneous numeric vector datatypes | [`(srfi 4)`](./basis/srfi-4.ss) | R7RS 6.9 | +| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 | +| [ 8](https://srfi.schemers.org/srfi-8/srfi-8.html) | receive: Binding to multiple values | [`(srfi 8)`](./basis/srfi-8.ss) | | +| [ 9](https://srfi.schemers.org/srfi-9/srfi-9.html) | Defining Record Types | [`(srfi 9)`](./basis/srfi-9.ss) | R7RS 5.5 | +| [ 10](https://srfi.schemers.org/srfi-10/srfi-10.html) | #, external form | | | +| [ 11](https://srfi.schemers.org/srfi-11/srfi-11.html) | Syntax for receiving multiple values | [`(srfi 11)`](./basis/srfi-11.ss) | R7RS 4.2.2 | +| [ 16](https://srfi.schemers.org/srfi-16/srfi-16.html) | Syntax for procedures of variable arity | [`(srfi 16)`](./basis/srfi-16.ss) | R7RS 4.2.9 | +| [ 23](https://srfi.schemers.org/srfi-23/srfi-23.html) | Error reporting mechanism | [`(srfi 23)`](./basis/srfi-23.ss) | R7RS 6.11 | +| [ 30](https://srfi.schemers.org/srfi-30/srfi-30.html) | Nested Multi-line Comments | | R7RS 2.2 | +| [ 31](https://srfi.schemers.org/srfi-31/srfi-31.html) | A special form rec for recursive evaluation | [`(srfi 31)`](./basis/srfi-31.ss) | | +| [ 34](https://srfi.schemers.org/srfi-34/srfi-34.html) | Exception Handling for Programs | [`(srfi 34)`](./basis/srfi-34.ss) | R7RS 6.11 | +| [ 38](https://srfi.schemers.org/srfi-38/srfi-38.html) | External Representation for Data With Shared Structure | [`(srfi 38)`](./basis/srfi-38.ss) | R7RS 6.13.3 | +| [ 39](https://srfi.schemers.org/srfi-39/srfi-39.html) | Parameter objects | [`(srfi 39)`](./basis/srfi-39.ss) | R7RS 4.2.6 | +| [ 45](https://srfi.schemers.org/srfi-45/srfi-45.html) | Primitives for Expressing Iterative Lazy Algorithms | [`(srfi 45)`](./basis/srfi-45.ss) | R7RS 4.2.5 | +| [ 62](https://srfi.schemers.org/srfi-62/srfi-62.html) | S-expression comments | | R7RS 2.2 | +| [ 78](https://srfi.schemers.org/srfi-78/srfi-78.html) | Lightweight testing | [`(srfi 78)`](./basis/srfi-78.ss) | Except `check-ec` | +| [ 87](https://srfi.schemers.org/srfi-87/srfi-87.html) | => in case clauses | | R7RS 4.2.1 | +| [ 98](https://srfi.schemers.org/srfi-98/srfi-98.html) | An interface to access environment variables | [`(srfi 98)`](./basis/srfi-98.ss) | R7RS 6.14 | +| [111](https://srfi.schemers.org/srfi-111/srfi-111.html) | Boxes | [`(srfi 111)`](./basis/srfi-111.ss) | [`(scheme box)`](./basis/r7rs.ss) | +| [149](https://srfi.schemers.org/srfi-149/srfi-149.html) | Basic syntax-rules template extensions | [`(srfi 149)`](./basis/srfi-149.ss) | R7RS 4.3.2 | ## Installation @@ -148,18 +140,18 @@ See [LICENSE](./LICENSE). ## References -| Authors | Year | Title | Journal Title / Publisher | Pages | -|-------------------------------------------------------------------------------------------------------|:----:|-------------------------------------------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------------------------------------------------------------|----------------| -| John McCarthy | 1960 | [Recursive functions of symbolic expressions and their computation by machine, Part I](https://dl.acm.org/doi/10.1145/367177.367199) | [Communications of the ACM, Volume 3, Issue 4](https://dl.acm.org/toc/cacm/1960/3/4) | 184‑195 | -| P. J. Landin | 1964 | [The Mechanical Evaluation of Expressions](https://academic.oup.com/comjnl/article/6/4/308/375725) | [The Computor Journal, Volume 6, Issue 4](https://academic.oup.com/comjnl/issue/6/4) | 308‑320 | -| Peter Henderson | 1980 | [Functional Programming: Application and Implementation](https://archive.org/details/functionalprogra0000hend/mode/2up) | Prentice Hall | | -| Alan Bawden and Jonathan Rees | 1988 | [Syntactic Closures](https://dl.acm.org/doi/10.1145/62678.62687) | [LFP '88: Proceedings of the 1988 ACM Conference on LISP and Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/62678) | 86‑95 | -| William Clinger and Jonathan Rees (Editors) | 1991 | [Revised4 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/382130.382133) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 3](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/3) | 1‑55 | -| Chris Hanson | 1991 | [A Syntactic Closures Macro Facility](https://dl.acm.org/doi/10.1145/1317265.1317267) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 9‑16 | -| William Clinger | 1991 | [Hygienic Macros Through Explicit Renaming](https://dl.acm.org/doi/10.1145/1317265.1317269) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 25‑28 | -| William Clinger and Jonathan Rees | 1991 | [Macros That Work](https://dl.acm.org/doi/10.1145/99583.99607) | [POPL '91: Proceedings of the 18th ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages](https://dl.acm.org/doi/proceedings/10.1145/99583) | 155‑162 | -| Rechard Kelsey, William Clinger and Jonathan Rees (Editors) | 1998 | [Revised5 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/290229.290234) | [ACM SIGPLAN Notices, Volume 33, Issue 9](https://dl.acm.org/toc/sigplan/1998/33/9) | 26‑76 | -| William E. Kempf | 2001 | [A garbage collection framework for C++](https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C) | https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C | | -| William E. Kempf | 2001 | [A garbage collection framework for C++ - Part II](https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II) | https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II | | -| Michael D. Adams and R. Kent Dybvig | 2008 | [Efficient Nondestructive Equality Checking for Trees and Graphs](https://dl.acm.org/doi/10.1145/1411204.1411230) | [ICFP '08: Proceedings of the 13th ACM SIGPLAN International Conference on Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/1411204) | 179‑188 | -| Alex Shinn, John Cowan and Arthur A. Gleckler (Editors) | 2013 | [Revised7 Report on the Algorithmic Language Scheme](https://standards.scheme.org/official/r7rs.pdf) | http://www.scheme-reports.org/ | | +| Authors | Year | Title | Journal Title / Publisher | Pages | +|--------------------------------------------------------------------------------------------------------|:----:|-------------------------------------------------------------------------------------------------------------------------------------------|-----------------------------------------------------------------------------------------------------------------------------------------------------------|:--------------:| +| John McCarthy | 1960 | [Recursive functions of symbolic expressions and their computation by machine, Part I](https://dl.acm.org/doi/10.1145/367177.367199) | [Communications of the ACM, Volume 3, Issue 4](https://dl.acm.org/toc/cacm/1960/3/4) | 184‑195 | +| P. J. Landin | 1964 | [The Mechanical Evaluation of Expressions](https://academic.oup.com/comjnl/article/6/4/308/375725) | [The Computor Journal, Volume 6, Issue 4](https://academic.oup.com/comjnl/issue/6/4) | 308‑320 | +| Peter Henderson | 1980 | [Functional Programming: Application and Implementation](https://archive.org/details/functionalprogra0000hend/mode/2up) | Prentice Hall | | +| Alan Bawden and Jonathan Rees | 1988 | [Syntactic Closures](https://dl.acm.org/doi/10.1145/62678.62687) | [LFP '88: Proceedings of the 1988 ACM Conference on LISP and Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/62678) | 86‑95 | +| William Clinger and Jonathan Rees (Editors) | 1991 | [Revised4 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/382130.382133) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 3](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/3) | 1‑55 | +| Chris Hanson | 1991 | [A Syntactic Closures Macro Facility](https://dl.acm.org/doi/10.1145/1317265.1317267) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 9‑16 | +| William Clinger | 1991 | [Hygienic Macros Through Explicit Renaming](https://dl.acm.org/doi/10.1145/1317265.1317269) | [ACM SIGPLAN LISP Pointers, Volume IV, Issue 4](https://dl.acm.org/toc/sigplan-lisppointers/1991/IV/4) | 25‑28 | +| William Clinger and Jonathan Rees | 1991 | [Macros That Work](https://dl.acm.org/doi/10.1145/99583.99607) | [POPL '91: Proceedings of the 18th ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages](https://dl.acm.org/doi/proceedings/10.1145/99583) | 155‑162 | +| Rechard Kelsey, William Clinger and Jonathan Rees (Editors) | 1998 | [Revised5 Report on the Algorithmic Language Scheme](https://dl.acm.org/doi/10.1145/290229.290234) | [ACM SIGPLAN Notices, Volume 33, Issue 9](https://dl.acm.org/toc/sigplan/1998/33/9) | 26‑76 | +| William E. Kempf | 2001 | [A garbage collection framework for C++](https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C) | https://www.codeproject.com/Articles/912/A-garbage-collection-framework-for-C | | +| William E. Kempf | 2001 | [A garbage collection framework for C++ - Part II](https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II) | https://www.codeproject.com/Articles/938/A-garbage-collection-framework-for-C-Part-II | | +| Michael D. Adams and R. Kent Dybvig | 2008 | [Efficient Nondestructive Equality Checking for Trees and Graphs](https://dl.acm.org/doi/10.1145/1411204.1411230) | [ICFP '08: Proceedings of the 13th ACM SIGPLAN International Conference on Functional Programming](https://dl.acm.org/doi/proceedings/10.1145/1411204) | 179‑188 | +| Alex Shinn, John Cowan and Arthur A. Gleckler (Editors) | 2013 | [Revised7 Report on the Algorithmic Language Scheme](https://standards.scheme.org/official/r7rs.pdf) | http://www.scheme-reports.org/ | | diff --git a/basis/configure.cmake b/configure/basis.cmake similarity index 100% rename from basis/configure.cmake rename to configure/basis.cmake diff --git a/configure/basis.hpp b/configure/basis.hpp index 45f978ffe..423db2e71 100644 --- a/configure/basis.hpp +++ b/configure/basis.hpp @@ -33,7 +33,6 @@ inline namespace kernel { return make_array( R"##(${CONFIGURED_meevax.ss})##", - R"##(${CONFIGURED_r4rs-essential.ss})##", R"##(${CONFIGURED_r4rs.ss})##", R"##(${CONFIGURED_r5rs.ss})##", R"##(${CONFIGURED_r7rs.ss})##", diff --git a/example/example.cpp b/example/example.cpp index b2f8b7a54..22d932e56 100644 --- a/example/example.cpp +++ b/example/example.cpp @@ -1,18 +1,17 @@ -#include #include using namespace meevax; // NOTE: DIRTY HACK extern "C" { - let length_of_arguments(let const& xs) + auto arity(object & xs) { return make(length(xs)); } - let dummy_procedure(let const& xs) + auto dummy_procedure(object & xs) { - std::cout << "\n; calling C++ function via foreign-function-interface." << std::endl; + std::cout << "\n; calling C++ function." << std::endl; std::size_t count = 0; @@ -46,17 +45,17 @@ extern "C" } }; - let make_hoge(let const& xs) + auto make_hoge(object & xs) { return make(xs[0].as()); } - let is_hoge(let const& xs) + auto is_hoge(object & xs) { return xs[0].is() ? t : f; } - let hoge_value(let const& xs) + auto hoge_value(object & xs) { return make(xs[0].as().value); } diff --git a/example/example.ss b/example/example.ss index 6216a1f3e..863ece4b0 100644 --- a/example/example.ss +++ b/example/example.ss @@ -1,4 +1,4 @@ -(import (meevax function) +(import (only (meevax procedure) procedure) (scheme base) (scheme process-context) (scheme write) @@ -7,37 +7,37 @@ ; ------------------------------------------------------------------------------ (define dummy-procedure - (foreign-function "build/libexample.so" "dummy_procedure")) + (procedure "build/libexample.so" 'dummy_procedure)) -(check (foreign-function? dummy-procedure) => #t) +(check (procedure? dummy-procedure) => #t) (check (dummy-procedure 'hoge 42 #(1 2 3) 3.14) => 43) ; ------------------------------------------------------------------------------ -(define length-of-arguments - (foreign-function "build/libexample.so" "length_of_arguments")) +(define arity + (procedure "build/libexample.so" 'arity)) -(check (foreign-function? length-of-arguments) => #t) +(check (procedure? arity) => #t) -(check (length-of-arguments 'hoge 42 #(1 2 3) 3.14) => 4) +(check (arity 'hoge 42 #(1 2 3) 3.14) => 4) ; ------------------------------------------------------------------------------ (define make-hoge - (foreign-function "build/libexample.so" "make_hoge")) + (procedure "build/libexample.so" 'make_hoge)) (define hoge? - (foreign-function "build/libexample.so" "is_hoge")) + (procedure "build/libexample.so" 'is_hoge)) (define hoge-value - (foreign-function "build/libexample.so" "hoge_value")) + (procedure "build/libexample.so" 'hoge_value)) -(check (foreign-function? make-hoge) => #t) +(check (procedure? make-hoge) => #t) -(check (foreign-function? hoge?) => #t) +(check (procedure? hoge?) => #t) -(check (foreign-function? hoge-value) => #t) +(check (procedure? hoge-value) => #t) (define h (make-hoge 100)) diff --git a/include/meevax/kernel/complex.hpp b/include/meevax/kernel/complex.hpp index 3b0a64a91..df05495bb 100644 --- a/include/meevax/kernel/complex.hpp +++ b/include/meevax/kernel/complex.hpp @@ -41,6 +41,14 @@ inline namespace kernel }; auto operator <<(std::ostream &, complex const&) -> std::ostream &; + + auto real_part(object const&) -> object const&; + + auto imag_part(object const&) -> object const&; + + auto magnitude(object const&) -> object; + + auto angle(object const&) -> object; } // namespace kernel } // namespace meevax diff --git a/include/meevax/kernel/configurator.hpp b/include/meevax/kernel/configurator.hpp index 148166a3d..6cf2a7b09 100644 --- a/include/meevax/kernel/configurator.hpp +++ b/include/meevax/kernel/configurator.hpp @@ -66,7 +66,7 @@ inline namespace kernel { option("(i|interactive)", [this](auto) { - let const f = make("", [this](let const&) + let const f = make("", [this](let const&) { interactive = true; return unspecified; @@ -82,7 +82,7 @@ inline namespace kernel option("(h|help)", [](auto) { - let static const f = make("", [](let const&) + let static const f = make("", [](let const&) { std::cout << help() << std::endl; throw EXIT_SUCCESS; @@ -93,7 +93,7 @@ inline namespace kernel option("(l|load)", [this](auto read) { - let const f = make("", [this](let const& xs) + let const f = make("", [this](let const& xs) { static_cast(*this).load(xs[0].as()); return unspecified; @@ -104,7 +104,7 @@ inline namespace kernel option("(v|version)", [](auto) { - let static const f = make("", [](let const&) + let static const f = make("", [](let const&) { std::cout << version() << std::endl; throw EXIT_SUCCESS; @@ -115,7 +115,7 @@ inline namespace kernel option("(w|write)", [](auto read) { - let static const f = make("", [](let const& xs) + let static const f = make("", [](let const& xs) { std::cout << xs[0] << std::endl; }); @@ -184,7 +184,7 @@ inline namespace kernel } else { - let const f = make("", [iter](let const&) + let const f = make("", [iter](let const&) { Environment().load(*iter); return unspecified; diff --git a/include/meevax/kernel/dynamic_environment.hpp b/include/meevax/kernel/dynamic_environment.hpp index b32497e12..aaf2f4b85 100644 --- a/include/meevax/kernel/dynamic_environment.hpp +++ b/include/meevax/kernel/dynamic_environment.hpp @@ -286,16 +286,16 @@ inline namespace kernel s = unit; goto fetch; } - else if (callee.is_also()) /* ----------------------------- + else if (callee.is_also()) /* ------------------------------ * - * ( xs . s) e (%call . c) d => (x . s) e c d + * ( xs . s) e (%call . c) d => (x . s) e c d * * where x = procedure(xs) * * ----------------------------------------------------------------- */ { assert(tail(c, 1).template is()); - s = cons(callee.as()(cadr(s)), cddr(s)); + s = cons(callee.as()(cadr(s)), cddr(s)); c = cdr(c); goto fetch; } @@ -336,9 +336,9 @@ inline namespace kernel s = unit; goto fetch; } - else if (callee.is_also()) /* ----------------------------- + else if (callee.is_also()) /* ------------------------------ * - * ( xs) e (%tail-call) (s' e' c' . d) => (x . s') e' c' d + * ( xs) e (%tail-call) (s' e' c' . d) => (x . s') e' c' d * * where x = procedure(xs) * @@ -346,7 +346,7 @@ inline namespace kernel { assert(tail(s, 2).template is()); assert(tail(c, 1).template is()); - s = cons(callee.as()(cadr(s)), car(d)); + s = cons(callee.as()(cadr(s)), car(d)); e = cadr(d); c = caddr(d); d = cdddr(d); diff --git a/include/meevax/kernel/library.hpp b/include/meevax/kernel/library.hpp index 7041c4a11..4656460b0 100644 --- a/include/meevax/kernel/library.hpp +++ b/include/meevax/kernel/library.hpp @@ -47,6 +47,12 @@ inline namespace kernel export_specs = cons(input_string_port(name).read(), export_specs); } + template