oops, fixing srfi-9

This commit is contained in:
Alex Shinn 2010-09-16 00:04:35 +09:00
parent d9bdc5fb1a
commit 11e552576e

View file

@ -17,7 +17,7 @@
(_type_slot_offset (rename 'type-slot-offset)))
`(,(rename 'begin)
;; type
(,_define ,name (,_register ,name-str ,parent ',fields))
(,_define ,name (,_register ,name-str ,parent ',(map car fields)))
;; predicate
(,_define ,pred (,(rename 'make-type-predicate)
,(symbol->string (identifier->symbol pred))
@ -25,21 +25,21 @@
;; fields
,@(map (lambda (f)
(and (pair? f) (pair? (cdr f))
`(,_define ,(cadar ls)
`(,_define ,(cadr f)
(,(rename 'make-getter)
,(symbol->string
(identifier->symbol (cadr f)))
,name
(,_type_slot_offset ,name ,(car f))))))
(,_type_slot_offset ,name ',(car f))))))
fields)
,@(map (lambda (f)
(and (pair? f) (pair? (cdr f)) (pair? (cddr f))
`(,_define ,(caddar ls)
`(,_define ,(caddr f)
(,(rename 'make-setter)
,(symbol->string
(identifier->symbol (caddr f)))
,name
(,_type_slot_offset ,name ,(car f))))))
(,_type_slot_offset ,name ',(car f))))))
fields)
;; constructor
(,_define ,make
@ -60,7 +60,8 @@
(error "unknown record field in constructor" (car ls)))
((pair? (cddr field))
(lp (cdr ls)
(cons (list (caddr field) 'res (car ls)) sets)))
(cons `(,(caddr field) res ,(car ls)) sets)))
(else
(lp (cdr ls)
(cons (list _slot-set! 'res (list 'quote (car ls)) (car ls)) sets))))))))))))))
(cons `(,_slot-set! ,name res (,_type_slot_offset ,name ',(car ls)) ,(car ls))
sets))))))))))))))