-(define-macro (define-component name . args)
- `(begin
- (use-modules (srfi srfi-9) (srfi srfi-9 gnu))
- (define-record-type ,name
- (,(symbol-concatenate "make-" name) ,@args)
- ,(symbol-concatenate name "?")
- ,@(map (lambda (a) (list a (symbol-concatenate name "-" a) (symbol-concatenate "set-" name "-" a "!"))) args))
- (set-record-type-printer! ,name
- (lambda (record port)
- (format port "#<[~a]" ',name)
- ,@(map (lambda (a) `(format port " ~a: ~a" ',a (,(symbol-concatenate name "-" a) record))) args)
- (format port ">")))
- ',name))
+(define-syntax define-component
+ (lambda (x)
+ (define (concat . args)
+ (datum->syntax x
+ (apply symbol-concatenate
+ (map (lambda (a)
+ (if (string? a)
+ a
+ (syntax->datum a)))
+ args))))
+ (syntax-case x ()
+ ((_ name field ...)
+ (with-syntax ((make-name (concat "make-" #'name))
+ (name? (concat #'name "?"))
+ ((field-getter ...) (map (lambda (f) (concat #'name "-" f)) #'(field ...)))
+ ((field-setter ...) (map (lambda (f) (concat "set-" #'name "-" f "!")) #'(field ...))))
+ #'(begin
+ (define-record-type name
+ (make-name field ...)
+ name?
+ (field field-getter field-setter)
+ ...)
+ (set-record-type-printer! name
+ (lambda (record port)
+ (format port "#<[~a]" 'name)
+ (format port " ~a: ~a" 'field (field-getter record))
+ ...
+ (format port ">")))
+ 'name))))))