Welcome to the CHICKEN Scheme pasting service

I am writing bindings for chipmunk, and I have code like this:


(define (body-info body)
  (let ([l vect-locative->list])
    `((sleeping ,(body-is-sleeping body))
      (static ,(body-is-static body))
      (rogue ,(body-is-rogue body))
      (mass  ,(body-get-mass body))
      (moment ,(body-get-moment body))
      (pos ,(l (body-get-pos body)))
      (vel ,(l (body-get-vel body)))
      (force ,(l (body-get-force body)))
      (angle ,(body-get-angle body))
      (ang-vel ,(body-get-ang-vel body))
      (torque ,(body-get-torque body))
      (vel-limit ,(body-get-vel-limit body))
      (ang-vel-limit ,(body-get-ang-vel-limit body))
      (user-data ,(body-get-user-data body))
      (shapes (TODO)))))

and code like this:


;; sample usage:
;; (body-info-set! body `((mass 1)
;;                        (pos (1 1.2))
;;                        (vel (1.1 0.2)))
(define (body-info-set! body assocl)
  (let ([tuple->v (lambda (pos-tuple)
                    (v (car pos-tuple) (cadr pos-tuple)))])
    (map
     (lambda (tuple)
       (let ([prop (car tuple)]
             [value (cadr tuple)])
         (list prop
               (case prop
                 ([sleeping] "not supported")
                 ([static]  "not supported")
                 ([mass] (body-set-mass body value))
                 ([moment] (body-set-moment body value))
                 ([pos] (body-set-pos body (tuple->v value)))
                 ([vel] (body-set-vel body (tuple->v value)))
                 ([force] (body-set-force body (tuple->v value)))
                 ([angle] (body-set-angle body value))
                 ([ang-vel] (body-set-ang-vel body value))
                 ([torque] (body-set-torque body value))
                 ([vel-limit] (body-set-vel-limit body value))
                 ([ang-vel-limit] (body-set-ang-vel-limit body value))
                 ([user-data] (body-set-user-data body value))
                 ([shapes] "not supported")
                 (else "unknown")))))
     assocl)))


This is too much typing! I am trying to make a macro to helps me. I have written a macro that gives me the body-info lambda:

;; spec format: (field-name getter-converter setter-converter getter-proc setter-proc
;; getter-proc & setter-proc are symbols, and default to (conc body-get- field-name)
(define body-info
  (make-info-proc ((sleeping #f #f body-is-sleeping #f)
                      (static   #f #f body-is-static #f)
                      (rogue    #f #f body-is-rogue #f)
                      mass moment
                      angle ang-vel torque
                      vel-limit ang-vel-limit
                      user-data
                      (pos loc->lis lis->loc)
                      (vel loc->lis lis->loc))
                     body-get- body-set-
                     )))

It's working and I'm proud of it, but now if I want to make a (make-info-set!-proc ...), I have to retype the getter/setter specs passed to the macros. 

How can I save the specs once and pass them down to both the make-info-proc macro and the make-info-set!-proc macro without copy/paste?

(define-syntax (make-info-proc x r t)
    ;; like list-ref but returns #f instead of failing
    ;; and returns original item on non-lists if idx == 0
    ;; (list-ref-maybe '(mass a b c) 3) ==> c
    ;; (list-ref-maybe '(mass a b c) 4) ==> #f
    ;; (list-ref-maybe 'mass 0) ==> mass
    ;; (list-ref-maybe 'mass 2) ==> #f
    (define (list-ref-maybe lst idx)
      (if (list? lst)  
          (and (> (length lst) idx) (list-ref lst idx))
          (and (= idx 0) lst)))

    (let* ([spec (cadr x)]
           [getter-prefix (caddr x)]
           [setter-prefix (cadddr x)])
      `(lambda (body)
         (list ,@(map (lambda (item)
                        (let* ([field (list-ref-maybe item 0)]
                               [get-conv (list-ref-maybe item 1)]
                               [set-conv (list-ref-maybe item 2)]
                               [getter (list-ref-maybe item 3)]
                               [setter (list-ref-maybe item 4)]
                               [getter-proc-name (or getter 
                                                     (string->symbol (conc getter-prefix field)))]
                               [getter-proc-call (list getter-proc-name 'body)])
                          `(list (quote ,field)
                                 ;; call getter with body as parameter
                                 ,(if get-conv
                                      `(,get-conv ,getter-proc-call)
                                      getter-proc-call))))
                      spec)))))