Define CALL-WITH-VALUES to be an alias for WITH-VALUES.
authorChris Hanson <org/chris-hanson/cph>
Tue, 22 Dec 1992 21:00:55 +0000 (21:00 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 22 Dec 1992 21:00:55 +0000 (21:00 +0000)
v7/src/runtime/global.scm
v7/src/sf/usiexp.scm
v8/src/runtime/global.scm

index 3ea9a91ebbe44e43d3a228ebc7f31df705df4035..f0e7db1b0c26927f2455074d1115ca92295cacbe 100644 (file)
@@ -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))
-
+\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))
@@ -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
index 0326827ea8bd12c01f75b71dcc04ed8610784fe0..f51929da28a5d0532258953c7ed1ea5006bb02cb 100644 (file)
@@ -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
    ))
 
index 3ea9a91ebbe44e43d3a228ebc7f31df705df4035..f0e7db1b0c26927f2455074d1115ca92295cacbe 100644 (file)
@@ -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))
-
+\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))
@@ -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