(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)))
(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)
(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")
(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)
(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