From 256e7627ac6c2112581ecd3e8ae18d17c4fb5d8f Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Sat, 25 Jun 2011 15:51:30 -0700 Subject: [PATCH] %make-record now takes a tag and length. Other returned record fields will be #f. --- src/runtime/record.scm | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/runtime/record.scm b/src/runtime/record.scm index 7d6abc60d..9cef57d83 100644 --- a/src/runtime/record.scm +++ b/src/runtime/record.scm @@ -43,9 +43,11 @@ USA. (primitive-object-set-type 2) (vector-cons 2)) -(define-integrable (%make-record length object) - ((ucode-primitive object-set-type) (ucode-type record) - (vector-cons length object))) +(define-integrable (%make-record tag length) + (let ((record ((ucode-primitive object-set-type) + (ucode-type record) (vector-cons length #f)))) + (%record-set! record 0 tag) + record)) (define-integrable (%record-tag record) (%record-ref record 0)) @@ -56,8 +58,8 @@ USA. (define (%copy-record record) (let ((length (%record-length record))) - (let ((result (%make-record length #f))) - (do ((index 0 (fix:+ index 1))) + (let ((result (%make-record (%record-tag record) length))) + (do ((index 1 (fix:+ index 1))) ((fix:= index length)) (%record-set! result index (%record-ref record index))) result))) @@ -351,13 +353,12 @@ USA. (letrec ((constructor (lambda field-values - (let ((record (%make-record reclen #f)) + (let ((record (%make-record tag reclen)) (lose (lambda () (error:wrong-number-of-arguments constructor n-fields field-values)))) - (%record-set! record 0 tag) (do ((i 1 (fix:+ i 1)) (vals field-values (cdr vals))) ((not (fix:< i reclen)) @@ -400,8 +401,8 @@ USA. (length indexes) field-values)))) (let ((record - (%make-record (%record-type-length record-type) #f))) - (%record-set! record 0 (%record-type-dispatch-tag record-type)) + (%make-record (%record-type-dispatch-tag record-type) + (%record-type-length record-type)))) (do ((indexes indexes (cdr indexes)) (values field-values (cdr values))) ((not (pair? indexes)) @@ -424,9 +425,8 @@ USA. ((constructor (lambda keyword-list (let ((n (%record-type-length record-type))) - (let ((record (%make-record n #f)) + (let ((record (%make-record (%record-type-dispatch-tag record-type) n)) (seen? (vector-cons n #f))) - (%record-set! record 0 (%record-type-dispatch-tag record-type)) (do ((kl keyword-list (cddr kl))) ((not (and (pair? kl) (symbol? (car kl)) -- 2.25.1