updates for changes from results of the fifth ballot

lib/init-7.scm

@@ -290,15 +290,15 @@
          ,(map (lambda (x) (list (car x) (cadr x))) (cadr expr))
          ,wrap)))))
 
-(define-syntax lazy
+(define-syntax delay-force
   (er-macro-transformer
    (lambda (expr rename compare)
-     `(,(rename 'make-promise) #f (,(rename 'lambda) () ,(cadr expr))))))
+     `(,(rename 'promise) #f (,(rename 'lambda) () ,(cadr expr))))))
 
 (define-syntax delay
   (er-macro-transformer
    (lambda (expr rename compare)
-     `(,(rename 'lazy) (,(rename 'make-promise) #t ,(cadr expr))))))
+     `(,(rename 'delay-force) (,(rename 'promise) #t ,(cadr expr))))))
 
 (define-syntax define-auxiliary-syntax
   (er-macro-transformer
@@ -899,7 +899,7 @@
  (auto-force
   )
  (else
-  (define (make-promise done? proc)
+  (define (promise done? proc)
     (list (cons done? proc)))
   (define (promise-done? x) (car (car x)))
   (define (promise-value x) (cdr (car x)))

lib/scheme/base.sld

@@ -12,8 +12,8 @@
           (srfi 9) (srfi 11) (srfi 39))
   (export
    * + - ... / < <= = => > >= _ abs and append apply assoc assq assv begin
-   binary-port?  boolean?  bytevector-copy bytevector-copy!
-   bytevector-copy-partial bytevector-copy-partial!  bytevector-length
+   binary-port?  boolean?  boolean=?  bytevector-copy bytevector-copy!
+   bytevector-copy-partial bytevector-length
    bytevector-u8-ref bytevector-u8-set!  bytevector?  caar cadr
    call-with-current-continuation call-with-port call-with-values
    call/cc car case cdr cdar cddr ceiling char->integer
@@ -23,9 +23,9 @@
    define-record-type define-syntax define-values denominator do
    dynamic-wind else eof-object?  eq?  equal?  eqv?  error
    error-object-irritants error-object-message error-object?  even?
-   exact->inexact exact-integer-sqrt exact-integer?  exact?  expt floor
+   exact exact-integer-sqrt exact-integer?  exact?  expt floor
    flush-output-port for-each gcd get-output-bytevector get-output-string
-   guard if import inexact->exact inexact?  input-port?  integer->char
+   guard if import inexact inexact?  input-port?  integer->char
    integer?  lambda lcm length let let* let*-values let-syntax let-values
    letrec letrec* letrec-syntax list list->string list->vector list-copy
    list-ref list-set!  list-tail list?  make-bytevector make-list
@@ -40,11 +40,11 @@
    string->number string->symbol string->utf8 string->vector string-append
    string-copy string-fill!  string-for-each string-length string-map
    string-ref string-set!  string<=?  string<?  string=?  string>=?
-   string>?  string?  substring symbol->string symbol?  syntax-error
+   string>?  string?  substring symbol->string symbol?  symbol=?  syntax-error
    syntax-rules textual-port?  truncate u8-ready?  unless unquote
    unquote-splicing utf8->string values vector vector->list vector->string
-   vector-copy vector-fill!  vector-for-each vector-length vector-map
-   vector-ref vector-set!  vector?  when with-exception-handler
+   vector-copy vector-copy! vector-fill!  vector-for-each vector-length
+   vector-map vector-ref vector-set!  vector?  when with-exception-handler
    write-bytevector write-char write-partial-bytevector write-u8 zero?)
   (include "define-values.scm"
            "extras.scm"

lib/scheme/char/normalization.sld

@@ -1,3 +1,5 @@
+;; This library is deprecated, occurring in early R7RS drafts before
+;; being removed.
 
 (define-library (scheme char normalization)
   (import (rename (scheme)

lib/scheme/division.sld

@@ -1,3 +1,5 @@
+;; This library is deprecated, occurring in early R7RS drafts before
+;; being removed.
 
 (define-library (scheme division)
   (import (scheme))

lib/scheme/extras.scm

@@ -1,4 +1,10 @@
 
+(define exact inexact->exact)
+(define inexact exact->inexact)
+
+(define (boolean=? x y) (eq? x y))
+(define (symbol=? x y) (eq? x y))
+
 (define call/cc call-with-current-continuation)
 
 ;; Adapted from Bawden's algorithm.
@@ -19,6 +25,8 @@
         (sr (- x e) (+ x e) return))
       x))
 
+(define (square x) (* x x))
+
 (define flush-output-port flush-output)
 
 (define (close-port port)
@@ -98,6 +106,13 @@
     (do ((i 0 (+ i 1))) ((>= i len) res)
       (vector-set! res i (vector-ref vec i)))))
 
+(define (vector-copy! to at from . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length from))))
+    (do ((i at (+ i 1)) (j start (+ i 1)))
+        ((>= j end))
+      (vector-set! to i (vector-ref from j)))))
+
 (define (vector->string vec)
   (list->string (vector->list vec)))
 
@@ -109,12 +124,41 @@
     (bytevector-copy! bv res)
     res))
 
-(define (bytevector-copy! from to)
-  (bytevector-copy-partial! from 0 (bytevector-length from) to 0))
+(define (bytevector-copy! to at from . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o)))
+                 (cadr o)
+                 (bytevector-length from))))
+    (do ((i at (+ i 1)) (j start (+ i 1)))
+        ((>= j end))
+      (bytevector-u8-set! to i (bytevector-u8-ref from j)))))
 
 (define bytevector-copy-partial subbytes)
 
-(define (bytevector-copy-partial! from start end to at)
-  (do ((i start (+ i 1)))
-      ((= i end))
-    (bytevector-u8-set! to (+ (- i start) at) (bytevector-u8-ref from i))))
+;; Never use this!
+(define (string-copy! to at from . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length from))))
+    (do ((i at (+ i 1)) (j start (+ i 1)))
+        ((>= j end))
+      (string-set! to i (string-ref from j)))))
+
+(define truncate-quotient quotient)
+(define truncate-remainder remainder)
+(define (truncate/ n m)
+  (values (truncate-quotient n m) (truncate-remainder n m)))
+
+(cond-expand
+ (ratios
+  (define (floor-quotient n m)
+    (floor (/ n m))))
+ (else
+  (define (floor-quotient n m)
+    (let ((res (floor (/ n m))))
+      (if (and (exact? n) (exact? m))
+          (exact res)
+          res)))))
+(define (floor-remainder n m)
+  (- n (* m (floor-quotient n m))))
+(define (floor/ n m)
+  (values (floor-quotient n m) (floor-remainder n m)))

lib/scheme/lazy.sld

@@ -1,5 +1,5 @@
 
 (define-library (scheme lazy)
   (import (scheme))
-  (export delay force lazy eager)
-  (begin (define (eager x) (delay x))))
+  (export delay force delay-force make-promise)
+  (begin (define (make-promise x) (delay x))))

opcodes.c

@@ -242,7 +242,7 @@ _FN0(SEXP_VOID, "print-vm-profile", 0, sexp_print_vm_profile),
 #endif
 #if SEXP_USE_AUTO_FORCE
 _OP(SEXP_OPC_GENERIC, SEXP_OP_FORCE, 1, 0, _I(SEXP_OBJECT), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "force", 0, NULL),
-_FN2(_I(SEXP_PROMISE), _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "make-promise", 0, sexp_make_promise),
+_FN2(_I(SEXP_PROMISE), _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "promise", 0, sexp_make_promise),
 #endif
 };