lib/rnrs/r5rs.ss
 (library (rnrs r5rs (6))
   
   (export null-environment scheme-report-environment delay force
           exact->inexact inexact->exact quotient remainder modulo)
   
   (import (only (core primitives) exact->inexact inexact->exact quotient remainder modulo)
           (rnrs eval)
           (rnrs base)
           (rnrs control))
   
   (define scheme-report-environment
     (let ((r5rs-env 
            (environment
             '(except (rnrs base)
                      _ letrec* let-values let*-values
                      real-valued? rational-valued? integer-valued? exact inexact finite? infinite?
                      nan? div mod div-and-mod div0 mod0 div0-and-mod0 exact-integer-sqrt boolean=?
                      symbol=? string-for-each vector-map vector-for-each error assertion-violation
                      call/cc)
             '(only (rnrs eval) eval)
             '(only (rnrs control) do)
             '(only (rnrs lists) assoc assv assq)
             '(only (rnrs io simple)
                call-with-input-file call-with-output-file 
                close-input-port close-output-port current-input-port current-output-port
                display eof-object? newline open-input-file open-output-file peek-char
                read read-char with-input-from-file with-output-to-file write write-char)
             '(only (rnrs unicode)
                char-upcase char-downcase char-ci=? char-ci<? char-ci>?
                char-ci<=? char-ci>=? char-alphabetic? char-numeric? char-whitespace?
                char-upper-case? char-lower-case? string-ci=? string-ci<? string-ci>?
                string-ci<=? string-ci>=?)
             '(only (rnrs mutable-pairs) set-car! set-cdr!)
             '(only (rnrs lists) assoc assv assq member memv memq)
             '(only (rnrs mutable-strings) string-set! string-fill!)
             '(rnrs r5rs))))
       (lambda (n)
         (unless (= n 5)
           (assertion-violation 'scheme-report-environment "Argument should be 5" n))
         r5rs-env)))
   
   (define null-environment
     (let ((null-env
            (environment '(only (rnrs base)
                            begin if lambda quote set! and or
                            define define-syntax let-syntax letrec-syntax 
                            let let* letrec
                            case cond else =>
                            quasiquote unquote unquote-splicing
                            syntax-rules ...)
                         '(only (rnrs control) do))))
       (lambda (n)
         (unless (= n 5)
           (assertion-violation 'scheme-report-environment "Argument should be 5" n))
         null-env)))
   
   (define force
     (lambda (object)
       (object)))
   
   (define-syntax delay
     (syntax-rules ()
       ((delay expression)
        (make-promise (lambda () expression)))))
   
   (define make-promise
     (lambda (proc)
       (let ((result-ready? #f)
             (result #f))
         (lambda ()
           (if result-ready?
               result
               (let ((x (proc)))
                 (if result-ready?
                     result
                     (begin (set! result-ready? #t)
                            (set! result x)
                            result))))))))
   ) ; rnrs r5rs