[racket] Advice on a macro for mutating structs

From: Tom McNulty (tom at cetiforge.com)
Date: Thu Jul 28 14:10:33 EDT 2011


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. 



- 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))]
                  (iter (cdr gets) (cdr sets))]))))]        
    [(increment! s sn fn) #'(increment! s sn fn 1)]))

(struct vault ([dollars #:mutable] 
               [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)))

Posted on the users mailing list.