From 7db1a96672617aa3e7f01e06cc9d36b4cdaee476 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 22 Dec 1992 21:00:55 +0000 Subject: [PATCH] Define CALL-WITH-VALUES to be an alias for WITH-VALUES. --- v7/src/runtime/global.scm | 32 +++++++++++++++++--------------- v7/src/sf/usiexp.scm | 8 +++++--- v8/src/runtime/global.scm | 32 +++++++++++++++++--------------- 3 files changed, 39 insertions(+), 33 deletions(-) diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm index 3ea9a91eb..f0e7db1b0 100644 --- a/v7/src/runtime/global.scm +++ b/v7/src/runtime/global.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: global.scm,v 14.44 1992/11/08 18:13:16 jinx Exp $ +$Id: global.scm,v 14.45 1992/12/22 20:59:33 cph Exp $ Copyright (c) 1988-1992 Massachusetts Institute of Technology @@ -138,9 +138,11 @@ MIT in each case. |# (lambda (receiver) (apply receiver objects))) -(define-integrable (with-values thunk receiver) +(define (call-with-values thunk receiver) ((thunk) receiver)) +(define with-values call-with-values) + (define (write-to-string object #!optional max) (if (default-object? max) (set! max false)) (if (not max) @@ -230,13 +232,13 @@ MIT in each case. |# (->environment to) (->environment from) name)) - + (define-integrable (object-non-pointer? object) (zero? (object-gc-type object))) (define-integrable (object-pointer? object) (not (object-non-pointer? object))) - + (define (impurify object) (if (and (object-pointer? object) (object-pure? object)) ((ucode-primitive primitive-impurify) object)) @@ -290,18 +292,18 @@ MIT in each case. |# unspecific) (define (obarray->list #!optional obarray) - (let ((table (if (default-object? obarray) - (fixed-objects-item 'OBARRAY) - obarray))) - (let per-bucket ((index (-1+ (vector-length table))) (accumulator '())) - (if (< index 0) + (let ((obarray + (if (default-object? obarray) + (fixed-objects-item 'OBARRAY) + obarray))) + (let per-bucket + ((index (fix:- (vector-length obarray) 1)) + (accumulator '())) + (if (fix:< index 0) accumulator (let per-symbol - ((bucket (vector-ref table index)) + ((bucket (vector-ref obarray index)) (accumulator accumulator)) (if (null? bucket) - (per-bucket (-1+ index) accumulator) - (per-symbol - (cdr bucket) - (cons (car bucket) accumulator)))))))) - + (per-bucket (fix:- index 1) accumulator) + (per-symbol (cdr bucket) (cons (car bucket) accumulator)))))))) \ No newline at end of file diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm index 0326827ea..f51929da2 100644 --- a/v7/src/sf/usiexp.scm +++ b/v7/src/sf/usiexp.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: usiexp.scm,v 4.12 1992/12/07 18:42:23 cph Exp $ +$Id: usiexp.scm,v 4.13 1992/12/22 21:00:55 cph Exp $ Copyright (c) 1988-1992 Massachusetts Institute of Technology @@ -311,7 +311,7 @@ MIT in each case. |# variables))))))) operands))))) -(define (with-values-expansion operands if-expanded if-not-expanded block) +(define (call-with-values-expansion operands if-expanded if-not-expanded block) block (if (and (pair? operands) (pair? (cdr operands)) @@ -481,6 +481,7 @@ MIT in each case. |# cadddr caddr cadr + call-with-values cdaaar cdaadr cdaar @@ -560,6 +561,7 @@ MIT in each case. |# cadddr-expansion caddr-expansion cadr-expansion + call-with-values-expansion cdaaar-expansion cdaadr-expansion cdaar-expansion @@ -606,7 +608,7 @@ MIT in each case. |# values-expansion vector?-expansion weak-pair?-expansion - with-values-expansion + call-with-values-expansion zero?-expansion )) diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm index 3ea9a91eb..f0e7db1b0 100644 --- a/v8/src/runtime/global.scm +++ b/v8/src/runtime/global.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: global.scm,v 14.44 1992/11/08 18:13:16 jinx Exp $ +$Id: global.scm,v 14.45 1992/12/22 20:59:33 cph Exp $ Copyright (c) 1988-1992 Massachusetts Institute of Technology @@ -138,9 +138,11 @@ MIT in each case. |# (lambda (receiver) (apply receiver objects))) -(define-integrable (with-values thunk receiver) +(define (call-with-values thunk receiver) ((thunk) receiver)) +(define with-values call-with-values) + (define (write-to-string object #!optional max) (if (default-object? max) (set! max false)) (if (not max) @@ -230,13 +232,13 @@ MIT in each case. |# (->environment to) (->environment from) name)) - + (define-integrable (object-non-pointer? object) (zero? (object-gc-type object))) (define-integrable (object-pointer? object) (not (object-non-pointer? object))) - + (define (impurify object) (if (and (object-pointer? object) (object-pure? object)) ((ucode-primitive primitive-impurify) object)) @@ -290,18 +292,18 @@ MIT in each case. |# unspecific) (define (obarray->list #!optional obarray) - (let ((table (if (default-object? obarray) - (fixed-objects-item 'OBARRAY) - obarray))) - (let per-bucket ((index (-1+ (vector-length table))) (accumulator '())) - (if (< index 0) + (let ((obarray + (if (default-object? obarray) + (fixed-objects-item 'OBARRAY) + obarray))) + (let per-bucket + ((index (fix:- (vector-length obarray) 1)) + (accumulator '())) + (if (fix:< index 0) accumulator (let per-symbol - ((bucket (vector-ref table index)) + ((bucket (vector-ref obarray index)) (accumulator accumulator)) (if (null? bucket) - (per-bucket (-1+ index) accumulator) - (per-symbol - (cdr bucket) - (cons (car bucket) accumulator)))))))) - + (per-bucket (fix:- index 1) accumulator) + (per-symbol (cdr bucket) (cons (car bucket) accumulator)))))))) \ No newline at end of file -- 2.25.1