From 5379f1bd30e602bc6dc953d8d9d711c84748be0e Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Thu, 9 Jun 2011 14:14:15 -0700 Subject: [PATCH] Get rid of boot dependency on MEMQ. --- src/runtime/record.scm | 49 +++++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 22 deletions(-) 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 -- 2.25.1