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:
parent
cd702346f2
commit
7f52f9e3b4
2 changed files with 7 additions and 8 deletions
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue