PLT風の構造体

が便利すぎるのだが、DrScheme風のpretty-printerが欲しくなったので定義。

(define-macro (define-plt-struct name fields)
  (let* ((constructor (string->symbol #`"make-,|name|"))
         (predicate (string->symbol #`",|name|?"))
         (acc&mods (map (lambda (field)
                          (list field
			       (string->symbol #`",|name|-,|field|")
			       (string->symbol #`"set-,|name|-,|field|!")))
                        fields))
         (fmt (string-append "(make-" (symbol->string name) " " (string-join (map (lambda (x) "~a") fields) " ") ")")))
    `(begin
      (define-record-type
        ,name
        (,constructor ,@fields)
        ,predicate
        ,@acc&mods)
      (define-method write-object ((obj ,name) port)
        (format port ,fmt ,@(map (lambda (f) `(,(cadr f) obj)) acc&mods)))
      (define-method object-equal? ((a ,name) (b ,name))
        (and ,@(map (lambda (f) `(equal? (,(cadr f) a) (,(cadr f) b))) acc&mods))))))

(define-struct posn (x y))
(print (make-posn 100 200))                          => (make-posn 100 200)
(equal? (make-posn 100 200) (make-posn 100 200))     => #t

ついでに、全部のフィールドを適当にequal?で比較するように修正。

マクロがわかってきた気がします。