[racket] Advice on a macro for mutating structs

err... https://gist.github.com/1112122

On 2011-07-28, at 12:10 PM, Tom McNulty wrote:

> Hello,
> 
> I posted a question on stackoverflow this week: http://stackoverflow.com/questions/6838115/racket-using-a-macro-across-modules, with thanks to Eli, I was able to understand where I was going wrong.  I took his advice in using a struct-info alternative, and as I have limited experience building macros I'm appealing for comments on my solution.
> 
> The macro in question destructively increments a field in a structure.  In this version, the getter and setter are pulled from extract-struct-info.   I was hoping that I could locate the getter (and setter) with just the field and structure type but that information doesn't seem to be possible. 
> 
> https://gist.github.com/1111993
> 
> Thanks,
> 
> - Tom 
> 
> (for completeness, contents of the gist above)
> 
> #lang racket
> 
> (require (for-syntax racket/struct-info))
> (require rackunit)
> 
> ;; (increment! a-struct type field [amount 1]) -> void
> ;; increments a mutable field in a structure
> (define-syntax (increment! stx)
>  (syntax-case stx ()
>    [(_ s sn fn i)
>     (with-syntax ([(_ _ _ getters setters _) 
>                    (extract-struct-info (syntax-local-value #'sn))])
>       (let ([seek (string->symbol 
>                    (format "~a-~a" (syntax-e #'sn) (syntax-e #'fn)))])
>         (let iter ([gets (syntax->list #'getters)] [sets (syntax->list #'setters)])
>           (cond [(null? gets)
>                  (raise-syntax-error #f "unknown field-name" stx)]
>                 [(eq? (syntax-e (car gets)) seek)
>                  (if (identifier? (car sets))
>                      (with-syntax ([set! (car sets)] [get (car gets)])
>                        #'(set! s (+ i (get s))))
>                      (raise-syntax-error #f (format "~s not mutable" (syntax-e #'fn)) stx))]
>                 [else 
>                  (iter (cdr gets) (cdr sets))]))))]        
>    [(increment! s sn fn) #'(increment! s sn fn 1)]))
> 
> (struct vault ([dollars #:mutable] 
>               pounds 
>               [euros #:mutable]))
> 
> (define v (vault 0 50 20))
> (increment! v vault dollars 100)
> (increment! v vault euros)
> 
> (test-case "sums"
>           (check-equal? (vault-dollars v) 100)
>           (check-equal? (vault-euros v) 21))
> ;(test-exn "not mutable" exn:fail:syntax? (λ () (increment! v vault pounds)))
> ;(test-exn "unknown name" exn:fail:syntax? (λ () (increment! v vault yen)))
>