2
votes

I would like to wrap a getter and setter function around an identifier, so that

(define x 1)
(set! x v) ; should expand to (custom-set! x v)
x          ; should expand to (custom-get x)

where custom-put! and custom-get are defined somewhere else and add additional behavior such as logging.

In the racket guide (Section 16.1.6), there is an example for a Set!-Transformer which works for a setter and a getter with zero arguments. However, I need a macro which expands an identifier occurence to a getter function with the matched identifier as its argument.

I tried to adopt the macro in the linked section as follows:

(define-syntax-rule (generate-accessors id get put!)
(define-syntax id
  (make-set!-transformer
   (lambda (stx)
       (syntax-case stx (set! get)
         [id (identifier? (syntax id)) (syntax (get id))]
         [(set! id e) (syntax (put! id e))])))))

The problem is that (syntax (get id)) leads to infinite expansion. Is there a straightforward way to cut off recursion for a template expression? I also thought about generating a fresh identifier bound to id and including it in the literal list, but I do not know how to accomplish this.

1

1 Answers

2
votes

The example you link to works with the code from the previous section that defines get-val and put-val!:

(define-values (get-val put-val!)
  (let ([private-val 0])
    (values (lambda () private-val)
            (lambda (v) (set! private-val v)))))

(define-syntax val
  (make-set!-transformer
   (lambda (stx)
     (syntax-case stx (set!)
       [val (identifier? (syntax val)) (syntax (get-val))]
       [(set! val e) (syntax (put-val! e))]))))

val ;; 0
(set! val 42)
val ;; 42

Let's write the macro-writing macro, generate-accessors, that parameterizes the identifier and accessors, and see that it works:

(define-syntax (generate-accessors stx)
  (syntax-case stx ()
    [(_ val get-val put-val!)
     (syntax
      (define-syntax val
        (make-set!-transformer
         (lambda (stx)
           (syntax-case stx (set!)
             [val (identifier? (syntax val)) (syntax (get-val))]
             [(set! val e) (syntax (put-val! e))])))))]))

(generate-accessors foo get-val put-val!)
foo ;; 0
(set! foo 42)
foo ;; 42

Also, let's exercise it with another pair of accessors, that shows a side-effect like "logging":

(define-values (custom-get custom-set!)
  (let ([private-val 0])
    (values (lambda () (println "get") private-val)
            (lambda (v) (println "set") (set! private-val v)))))

(generate-accessors bar custom-get custom-set!)
bar ;; 0
(set! bar 42)
bar ;; 42

EDIT: In response to your comment, here's a variation where it generates a fresh pair of accessors (and value) for each invocation. It lets you supply a pair of runtime functions to be called, to do extra work (here just println). (You could simplify this to hardcode the println or log-debug or whatever, if you find it's always the same thing.)

(require (for-syntax racket/base
                     racket/syntax
                     syntax/parse))

(define-syntax (define/logged stx)
  (syntax-parse stx
    [(_ id:id init:expr on-get:expr on-set:expr)
     #:with get (format-id stx "get-~a" #'id)
     #:with set (format-id stx "set!-~a" #'id)
     #'(begin
         (define-values (get set)
           (let ([v init])
             (values (λ () (on-get 'id v) v)
                     (λ (e) (on-set 'id e) (set! v e)))))
         (define-syntax id
           (make-set!-transformer
            (λ (stx)
              (syntax-parse stx
                [id:id #'(get)]
                [(set! id e) #'(set e)])))))]))

(define (on-get id v)
  (println `(get ,id ,v)))

(define (on-set! id v)
  (println `(set! ,id ,v)))

(define/logged foo 0 on-get on-set!)
foo
(set! foo 42)
foo

;; prints:
;; '(get foo 0)
;; 0
;; '(set! foo 42)
;; '(get foo 42)
;; 42

I'm not 100% clear on the context of what you're trying to do. Maybe this is closer, or at least gives you some ideas.

Note here I'm switching to syntax-parse instead of trying to follow the original example from the Guide. Just because.