define-macroなしで頑張ってsimple-structを作る

今までdefine-macroで書いていたsimple-structをR6RSのsyntax-caseを使って書き直した。

(define-syntax syntax-with:
  (lambda (x)
    (define (add: sym)
      (string->symbol (string-append (symbol->string sym) ":")))
    (syntax-case x ()
      ((_ target body ...)
       (let ((newname (datum->syntax #'target (add: (syntax->datum #'target)))))
         #`(define-syntax #,newname body ...))))))

まず、後ろにsuffixを自動的につけるdefine-syntaxであるところのsyntax-with:を作る。これで、(syntax-with: hoge BODY)とやると、(define-syntax hoge: BODY)に展開されるようになる。
こればっかりはsyntax-caseのsyntax->datum等を使わないとどうにも書けない。。

(define-syntax addspec
  (lambda (x)
    (syntax-case x ()
      ((_ num name spec)
       #'(syntax-with: spec
                       (syntax-rules ()
                       ((_ obj) (vector-ref obj num))
                       ((_ obj dat) (vector-set! obj num dat))))))))

(define-syntax defmysclass-num
  (syntax-rules ()
  ((_ num name spec0)
   (addspec num name spec0))
  ((_ num name spec0 spec1 ...)
   (begin
     (addspec num name spec0)
     (defmysclass-num (+ 1 num) name spec1 ...)))))

(define-syntax defmysclass ; my-define-static-class
  (syntax-rules ()
     ((_ name spec0 ...)
      (defmysclass-num 0 name spec0 ...))))