Add a new global procedure, obarray->list so that symbols can be
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sun, 21 May 1989 17:14:29 +0000 (17:14 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sun, 21 May 1989 17:14:29 +0000 (17:14 +0000)
filtered, etc.

v7/src/runtime/global.scm
v8/src/runtime/global.scm

index 694331f8e9161254cf7d5caa0a64cbdc0a91f352..3852afcf91c93308bdbd55dad856437c4491ec68 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.7 1988/08/15 21:58:20 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.8 1989/05/21 17:14:29 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -258,4 +258,22 @@ MIT in each case. |#
   (object-new-type (ucode-type true) 1))
 
 (define unspecific
-  (object-new-type (ucode-type true) 1))
\ No newline at end of file
+  (object-new-type (ucode-type true) 1))
+\f
+;;;; Obarray->list
+
+(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)
+         accumulator
+         (let per-symbol
+             ((bucket (vector-ref table index))
+              (accumulator accumulator))
+           (if (null? bucket)
+               (per-bucket (-1+ index) accumulator)
+               (per-symbol
+                (cdr bucket)
+                (cons (car bucket) accumulator))))))))
\ No newline at end of file
index 3cdc09a431bb2bc3d31e142ac53f1356dc3bbed4..5a66f7b9a00e8a3086e38030ea137edfbbf8f1db 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.7 1988/08/15 21:58:20 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.8 1989/05/21 17:14:29 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -258,4 +258,22 @@ MIT in each case. |#
   (object-new-type (ucode-type true) 1))
 
 (define unspecific
-  (object-new-type (ucode-type true) 1))
\ No newline at end of file
+  (object-new-type (ucode-type true) 1))
+\f
+;;;; Obarray->list
+
+(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)
+         accumulator
+         (let per-symbol
+             ((bucket (vector-ref table index))
+              (accumulator accumulator))
+           (if (null? bucket)
+               (per-bucket (-1+ index) accumulator)
+               (per-symbol
+                (cdr bucket)
+                (cons (car bucket) accumulator))))))))
\ No newline at end of file