From 7f52f9e3b444a8621c44cd13bf6c90dab3f1aa93 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 15 May 2008 18:57:33 +0200 Subject: [PATCH] avoid zealous unquotation * module/system/base/syntax.scm (define-record): Again, don't unquote in actual objects, because this is uncompilable. Ah well. At least now all of base/ is compiling. * module/system/vm/assemble.scm (dump-object!): More debug info. --- module/system/base/syntax.scm | 13 ++++++------- module/system/vm/assemble.scm | 2 +- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm index ffdac8414..33463e3c6 100644 --- a/module/system/base/syntax.scm +++ b/module/system/base/syntax.scm @@ -49,10 +49,9 @@ (let* ((name (car def)) (slots (cdr def)) (slot-names (map (lambda (slot) (if (pair? slot) (car slot) slot)) slots)) - (stem (symbol-trim-both name (list->char-set '(#\< #\>)))) - (type (make-record-type (symbol->string name) slot-names))) + (stem (symbol-trim-both name (list->char-set '(#\< #\>))))) `(begin - (define ,name ,type) + (define ,name (make-record-type ,(symbol->string name) ',slot-names)) (define ,(symbol-append 'make- stem) (let ((slots (list ,@(map (lambda (slot) (if (pair? slot) @@ -62,12 +61,12 @@ (constructor (record-constructor ,name))) (lambda args (apply constructor (%compute-initargs args slots))))) - (define ,(symbol-append stem '?) ,(record-predicate type)) + (define ,(symbol-append stem '?) (record-predicate ,name)) ,@(map (lambda (sname) `(define ,(symbol-append stem '- sname) - ,(make-procedure-with-setter - (record-accessor type sname) - (record-modifier type sname)))) + (make-procedure-with-setter + (record-accessor ,name ',sname) + (record-modifier ,name ',sname)))) slot-names)))) (define (%compute-initargs args slots) diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm index 33274e780..ad0aac9a6 100644 --- a/module/system/vm/assemble.scm +++ b/module/system/vm/assemble.scm @@ -266,7 +266,7 @@ (( id) (push-code! `(load-module ,id))) (else - (error "assemble: unknown record type")))) + (error "assemble: unknown record type" (record-type-descriptor x))))) ((and (integer? x) (exact? x)) (let ((str (do ((n x (quotient n 256)) (l '() (cons (modulo n 256) l)))