gistfile1.rkt

#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)))