#| -*-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
(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)
(->environment to)
(->environment from)
name))
-
+\f
(define-integrable (object-non-pointer? object)
(zero? (object-gc-type object)))
(define-integrable (object-pointer? object)
(not (object-non-pointer? object)))
-\f
+
(define (impurify object)
(if (and (object-pointer? object) (object-pure? object))
((ucode-primitive primitive-impurify) object))
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
#| -*-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
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))
cadddr
caddr
cadr
+ call-with-values
cdaaar
cdaadr
cdaar
cadddr-expansion
caddr-expansion
cadr-expansion
+ call-with-values-expansion
cdaaar-expansion
cdaadr-expansion
cdaar-expansion
values-expansion
vector?-expansion
weak-pair?-expansion
- with-values-expansion
+ call-with-values-expansion
zero?-expansion
))
#| -*-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
(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)
(->environment to)
(->environment from)
name))
-
+\f
(define-integrable (object-non-pointer? object)
(zero? (object-gc-type object)))
(define-integrable (object-pointer? object)
(not (object-non-pointer? object)))
-\f
+
(define (impurify object)
(if (and (object-pointer? object) (object-pure? object))
((ucode-primitive primitive-impurify) object))
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