r5rs.ss

(define-library (scheme r5rs)
  (import (only (meevax continuation) dynamic-wind)
          (only (meevax core) define-syntax let-syntax letrec-syntax)
          (only (meevax environment) environment eval)
          (scheme r4rs)
          (srfi 149))

  (export quote lambda if set! cond case and or let let* letrec begin do delay
          quasiquote let-syntax letrec-syntax syntax-rules define define-syntax
          eqv? eq? equal? 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 rationalize exp log sin cos tan asin acos atan
          sqrt expt make-rectangular make-polar real-part imag-part magnitude
          angle exact->inexact inexact->exact number->string string->number not
          boolean? 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-tail
          list-ref memq memv member assq assv assoc symbol? symbol->string
          string->symbol char? char=? char<? char>? char<=? char>=? char-ci=?
          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>=? string-ci=? 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 values call-with-values dynamic-wind
          eval scheme-report-environment null-environment
          interaction-environment 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 values
         ;   (lambda xs
         ;     (call-with-current-continuation
         ;       (lambda (cc)
         ;         (apply cc xs)))))
         ;
         ; (define (call-with-values producer consumer)
         ;   (let-values ((xs (producer)))
         ;     (apply consumer xs)))

         (define <values> (list 'values)) ; Chibi-Scheme

         (define (values . xs) ; Chibi-Scheme
           (if (and (pair? xs)
                    (null? (cdr xs)))
               (car xs)
               (cons <values> xs)))

         (define (call-with-values produce consume) ; Chibi-Scheme
           (define (values? x)
             (and (pair? x)
                  (eq? <values> (car x))))
           (let ((vs (produce)))
             (if (values? vs)
                 (apply consume (cdr vs))
                 (consume vs))))

         (define (scheme-report-environment version)
           (environment `(scheme ,(string->symbol (string-append "r" (number->string version) "rs")))))

         (define (null-environment version)
           (environment `(only (scheme ,(string->symbol (string-append "r" (number->string version) "rs")))
                               quote lambda if set! cond case and or let let*
                               letrec begin do delay quasiquote let-syntax
                               letrec-syntax syntax-rules define define-syntax)))))