1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

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.
This commit is contained in:
Andy Wingo 2008-05-15 18:57:33 +02:00
parent cd702346f2
commit 7f52f9e3b4
2 changed files with 7 additions and 8 deletions

View file

@ -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)

View file

@ -266,7 +266,7 @@
((<vmod> 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)))