[plt-scheme] with-struct

Here is a macro that introduces fields of a struct into the current 
lexical environment so that instead of saying (foo-x some-foo) you can 
just say 'x', similar to pascal's `with' construct.

I had to resort to string munging to get the original field names. Is 
there a better way? I guess the "right" answer is to make the user pass 
in the field names themselves but I dislike such verbosity.

Here is the uncleaned-up version.

#lang scheme

(require (for-syntax scheme/struct-info)
         (for-syntax scheme/match))

(define-syntax (with-struct stx)
  (syntax-case stx ()
    [(_ (info instance) body1 body ...)
     (identifier? #'instance)
     (let ([a (syntax-local-value #'info (lambda () #f))])
       #;
       (printf "~a items\n" (length (extract-struct-info a)))
       (match (extract-struct-info a)
              [(list name init-field-count auto-field-count accessor-proc
                     mutator-proc immutable-k-list)
               (begin
                 ;; messing around with strings is bad, whats a better 
solution?
                 (define (make-local-field field-stx)
                   (datum->syntax
                     #'body1
                     (string->symbol
                       (substring (symbol->string (syntax->datum field-stx))
                                  (- (string-length (string-append 
(symbol->string (syntax->datum name)) "-"))
                                     (string-length "struct:"))))))
                 #;
                 (apply printf "name: ~a init-field-count: ~a 
auto-field-count: ~a accessor-proc: ~a mutator-proc: ~a 
immutable-k-list: ~a\n"
                        (list name init-field-count auto-field-count 
(map syntax->datum accessor-proc)
                              mutator-proc immutable-k-list))
                 (with-syntax ([(field ...)
                                (map make-local-field accessor-proc)]
                               [(setter! ...) mutator-proc]
                               [(accessor ...) accessor-proc])
                   #|
                   (printf "bind: ~a\n" (map syntax->datum (syntax->list 
#'(field ...))))
                   (printf "setter: ~a\n" (map syntax->datum 
(syntax->list #'(setter! ...))))
                   |#
                   (syntax-local-introduce
                     #;
                     #'(let ([my-accessor])
                         let-syntax ([field (make-rename-transformer 
my-accessor)] ...)
                         body)

                     #;
                     #'(let ([field (make-rename-transformer #'field
                                                             (accessor 
instance))]
                             ...)
                         body)
                     #'(let-syntax ([field (make-set!-transformer
                                             (lambda (stx)
                                               (syntax-case stx (set!)
                                                 [(set! id v) (if #'setter!
                                                                
#'(setter! instance v)
                                                                #'(error 
'with-struct "field ~a is not mutable so no set! is available" 'field))]
                                                 [id #'(accessor 
instance)])))]
                                    ...)
                         body1 body ...)

                     #;
                     #'(let-syntax ([field (lambda (stx)
                                             #'(accessor instance))]
                                    ...)
                         body1 body ...))))]))]))

(define-struct foo (n m b) #:mutable)
(let ([my-foo (make-foo 1 2 3)])
  (with-struct (foo my-foo)
               (begin
                 (set! n 9)
                 (printf "n is ~a\n" n))))

==>
n is 9