Moved PUT, GET and ASSQ to library.scm

diff --git a/v8/src/bench/boyer.scm b/v8/src/bench/boyer.scm
index 0ac8a88a46bc6549f0a7c0d61b1f79743ebb1921..89822c035ce5838576b9907ad9b19d2d92c22714 100644 (file)
--- a/v8/src/bench/boyer.scm
+++ b/v8/src/bench/boyer.scm
@@ -25,28 +25,6 @@
 ;;; BOYER -- Logic programming benchmark, originally written by Bob Boyer.
 ;;; Fairly CONS intensive.
 
-(define get #F)
-(define put #F)
-
-(let ((properties '()))
-  (define (our-get x y)
-    (let ((x-cut (assq x properties)))
-      (if x-cut
-         (let ((value (assq y (cdr x-cut))))
-           (if value (cdr value) '()))
-         '())))
-  (define (our-put x y z)
-    (let ((x-cut (assq x properties)))
-      (if x-cut
-         (let ((value (assq y (cdr x-cut))))
-           (if value
-               (set-cdr! value z)
-               (set-cdr! x-cut (cons (cons y z) (cdr x-cut)))))
-         (set! properties `((,x . ((,y . ,z))) ,@properties))))
-    'OK)
-  (set! get our-get)
-  (set! put our-put))
-
 (define unify-subst '())
 (define temp-temp '())
 

diff --git a/v8/src/bench/browse.scm b/v8/src/bench/browse.scm
index 8aa14491eb14dc5512d21c95899c4a979f2f78af..1717142b4a644877a3dd004c9bbad4ce311be1ec 100644 (file)
--- a/v8/src/bench/browse.scm
+++ b/v8/src/bench/browse.scm
@@ -32,10 +32,6 @@
 ; The next few definitions should be omitted if the Scheme implementation
 ; already provides them.
 
-(define gensym generate-uninterned-symbol)
-(define get 2d-get)
-(define put 2d-put!)
-
 (define (append! x y)
   (if (null? x)
       y

diff --git a/v8/src/bench/library.scm b/v8/src/bench/library.scm
index 4dfb01ccb04b7fdf10366eec203e73ddfec40a22..80afc4a6974c30262da2ecc3ae8c332c5c398e07 100644 (file)
--- a/v8/src/bench/library.scm
+++ b/v8/src/bench/library.scm
@@ -1,17 +1,42 @@
 (declare (usual-integrations))
 
 
-(define assq/1
-  (named-lambda (assq key alist)
-    (let loop ((alist* alist))
-      (if (pair? alist*)
-         (begin
-           (if (not (pair? (car alist*)))
-               (error:wrong-type-argument alist "alist" 'assq))
-           (if (eq? (car (car alist*)) key)
-               (car alist*)
-               (loop (cdr alist*))))
-         (begin
-           (if (not (null? alist*))
-               (error:wrong-type-argument alist "alist" 'assq))
-           #F)))))
+(define (assq key alist)
+  (let loop ((alist* alist))
+    (if (pair? alist*)
+       (begin
+         (if (not (pair? (car alist*)))
+             (error:wrong-type-argument alist "alist" 'assq))
+         (if (eq? (car (car alist*)) key)
+             (car alist*)
+             (loop (cdr alist*))))
+       (begin
+         (if (not (null? alist*))
+             (error:wrong-type-argument alist "alist" 'assq))
+         #F))))
+
+
+(define get #F)
+(define put #F)
+
+(let ((properties '()))
+  (define (our-get x y)
+    (let ((x-cut (assq x properties)))
+      (if x-cut
+         (let ((value (assq y (cdr x-cut))))
+           (if value (cdr value) '()))
+         '())))
+  (define (our-put x y z)
+    (let ((x-cut (assq x properties)))
+      (if x-cut
+         (let ((value (assq y (cdr x-cut))))
+           (if value
+               (set-cdr! value z)
+               (set-cdr! x-cut (cons (cons y z) (cdr x-cut)))))
+         (set! properties `((,x . ((,y . ,z))) ,@properties))))
+    'OK)
+  (set! get our-get)
+  (set! put our-put))
+
+
+(define gensym generate-uninterned-symbol)