From: Joe Marshall <eval.apply@gmail.com>
Date: Thu, 9 Jun 2011 21:14:15 +0000 (-0700)
Subject: Get rid of boot dependency on MEMQ.
X-Git-Tag: release-9.1.0~22^2~13
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5379f1bd30e602bc6dc953d8d9d711c84748be0e;p=mit-scheme.git

Get rid of boot dependency on MEMQ.
---

diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index 626059fa9..afe6ae1b6 100644
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -43,14 +43,14 @@ USA.
   (primitive-object-set-type 2)
   (vector-cons 2))
 
-(define-integrable (%make-record length object)
+(define (%make-record length object)
   ((ucode-primitive object-set-type) (ucode-type record)
 				     (vector-cons length object)))
 
-(define-integrable (%record-tag record)
+(define (%record-tag record)
   (%record-ref record 0))
 
-(define-integrable (%tagged-record? tag object)
+(define (%tagged-record? tag object)
   (and (%record? object)
        (eq? (%record-tag object) tag)))
 
@@ -169,31 +169,31 @@ USA.
 (define (record-type? object)
   (%tagged-record? record-type-type-tag object))
 
-(define-integrable (%record-type-descriptor record)
+(define (%record-type-descriptor record)
   (dispatch-tag-contents (%record-tag record)))
 
-(define-integrable (%record-type-dispatch-tag record-type)
+(define (%record-type-dispatch-tag record-type)
   (%record-ref record-type 1))
 
-(define-integrable (%record-type-name record-type)
+(define (%record-type-name record-type)
   (%record-ref record-type 2))
 
-(define-integrable (%record-type-field-names record-type)
+(define (%record-type-field-names record-type)
   (%record-ref record-type 3))
 
-(define-integrable (%record-type-default-inits record-type)
+(define (%record-type-default-inits record-type)
   (%record-ref record-type 4))
 
-(define-integrable (%record-type-extension record-type)
+(define (%record-type-extension record-type)
   (%record-ref record-type 5))
 
-(define-integrable (%set-record-type-extension! record-type extension)
+(define (%set-record-type-extension! record-type extension)
   (%record-set! record-type 5 extension))
 
-(define-integrable (%record-type-n-fields record-type)
+(define (%record-type-n-fields record-type)
   (vector-length (%record-type-field-names record-type)))
 
-(define-integrable (%record-type-length record-type)
+(define (%record-type-length record-type)
   (fix:+ 1 (%record-type-n-fields record-type)))
 
 (define (record-type-dispatch-tag record-type)
@@ -519,9 +519,14 @@ USA.
   (and (list-of-type? object symbol?)
        (let loop ((elements object))
 	 (if (pair? elements)
-	     (if (memq (car elements) (cdr elements))
-		 #f
-		 (loop (cdr elements)))
+	     ;; No memq in the cold load.
+	     (let memq ((item (car elements))
+			(tail (cdr elements)))
+	       (cond ((pair? tail) (if (eq? item (car tail))
+				       #f
+				       (memq item (cdr tail))))
+		     ((null? tail) (loop (cdr elements)))
+		     (else (error "Improper list."))))
 	     #t))))
 
 (define-guarantee list-of-unique-symbols "list of unique symbols")
@@ -593,16 +598,16 @@ USA.
 (define structure-type/entity-unparser-method)
 (define set-structure-type/entity-unparser-method!)
 
-(define-integrable (structure-type/field-index type field-name)
+(define (structure-type/field-index type field-name)
   (vector-ref (structure-type/field-indexes type)
 	      (structure-type/field-name-index type field-name)))
 
-(define-integrable (structure-type/default-init type field-name)
+(define (structure-type/default-init type field-name)
   (structure-type/default-init-by-index
    type
    (structure-type/field-name-index type field-name)))
 
-(define-integrable (structure-type/default-init-by-index type field-name-index)
+(define (structure-type/default-init-by-index type field-name-index)
   (vector-ref (structure-type/default-inits type) field-name-index))
 
 (define (structure-type/field-name-index type field-name)
@@ -744,24 +749,24 @@ USA.
 	  (check-list-untagged structure type)
 	  (set-car! (list-tail structure index) value)))))
 
-(define-integrable (check-vector-tagged structure type)
+(define (check-vector-tagged structure type)
   (if (not (and (vector? structure)
 		(fix:= (vector-length structure)
 		       (structure-type/length type))
 		(eq? (vector-ref structure 0) (structure-type/tag type))))
       (error:wrong-type-argument structure type #f)))
 
-(define-integrable (check-vector-untagged structure type)
+(define (check-vector-untagged structure type)
   (if (not (and (vector? structure)
 		(fix:= (vector-length structure)
 		       (structure-type/length type))))
       (error:wrong-type-argument structure type #f)))
 
-(define-integrable (check-list-tagged structure type)
+(define (check-list-tagged structure type)
   (if (not (and (eq? (list?->length structure) (structure-type/length type))
 		(eq? (car structure) (structure-type/tag type))))
       (error:wrong-type-argument structure type #f)))
 
-(define-integrable (check-list-untagged structure type)
+(define (check-list-untagged structure type)
   (if (not (eq? (list?->length structure) (structure-type/length type)))
       (error:wrong-type-argument structure type #f)))
\ No newline at end of file