> I factored out the code for generating the getter and setter syntax:
>
> (define-syntax define-get-field-syntax
> (lambda (stx)
> (syntax-case stx ()
> ((_ var field get)
> (with-syntax ((var.field (gen-id #'var #'var "." #'field)))
> #'(begin
> (define-syntax var.field
> (identifier-syntax
> (get var)))))))))
>
> (define-syntax define-set-field-syntax
> (lambda (stx)
> (syntax-case stx ()
> ((_ var field set)
> (with-syntax ((var.field! (gen-id #'var #'var "." #'field "!")))
> #'(begin
> (define-syntax var.field!
> (syntax-rules ()
> ((var.field! val)
> (set var val))))))))))
Here's the factored out code for generating the method syntax:
(define-syntax define-record-method-syntax
(lambda (stx)
(syntax-case stx ()
((_ var name proc)
(with-syntax ((var.name (gen-id #'var #'var "." #'name)))
(syntax
(define-syntax var.name
(syntax-rules ()
((var.name arg (... ...))
(proc var arg (... ...)))))))))))
So given the simple 'pt' type:
(define-record-type pt
(fields (mutable x)
(mutable y)))
and a couple of procedures (methods by the convention that they accept a
'pt' as the first argument):
(define (pt-neg p)
(make-pt (- (pt-x p))
(- (pt-y p))))
(define (square n) (* n n))
(define (pt-norm p)
(sqrt (+ (square (pt-x p))
(square (pt-y p)))))
here's the 'is-pt' macro again:
(define-syntax is-pt
(lambda (stx)
(syntax-case stx ()
((is-pt var)
(syntax
(begin
(define-get-field-syntax var x pt-x)
(define-get-field-syntax var y pt-y)
(define-set-field-syntax var x pt-x-set!)
(define-set-field-syntax var y pt-y-set!)
(define-record-method-syntax var neg pt-neg)
(define-record-method-syntax var norm pt-norm)))))))
Example usage:
> (define p0 (make-pt 3 4))
> (is-pt p0)
> p0.x
3
> p0.y
4
> (p0.neg)
#[pt -3 -4]
> (p0.norm)
5
Ed
