From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Wed, 15 Feb 1995 23:43:06 +0000 (+0000)
Subject: Moved PUT, GET and ASSQ to library.scm
X-Git-Tag: 20090517-FFI~6635
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d516bef58ee21f77a49a66f252077128fac08676;p=mit-scheme.git

Moved PUT, GET and ASSQ to library.scm
---

diff --git a/v8/src/bench/boyer.scm b/v8/src/bench/boyer.scm
index 0ac8a88a4..89822c035 100644
--- 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 8aa14491e..1717142b4 100644
--- 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 4dfb01ccb..80afc4a69 100644
--- 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)