* with-accessors macro
@ 2008-04-22 9:03 Andy Wingo
2008-04-23 21:50 ` Ludovic Courtès
0 siblings, 1 reply; 2+ messages in thread
From: Andy Wingo @ 2008-04-22 9:03 UTC (permalink / raw
To: guile-user
Heya hackers,
Use GOOPS? Think slot-ref is ugly? Don't like the permeation of
accessors into the global namespace? `with-accessors' is for you!
Use example:
(define (scale-opacity w ratio)
(with-accessors (opacity)
(set! (opacity w)
(* (opacity w) ratio))))
Definition:
(define-macro (with-accessors names . body)
`(let (,@(map (lambda (name)
`(,name ,(make-procedure-with-setter
(lambda (x) (slot-ref x name))
(lambda (x y) (slot-set! x name y)))))
names))
,@body))
It would be nice to actually use accessors, so that we can get their
compilation characteristics. This version would probably work:
(define (fetch-g-n-s name class)
(assq name (slot-ref class 'getters-n-setters)))
(define-class <lazy-getter> (<generic>))
(define-method (no-applicable-method (gf <lazy-getter>) args)
(if (= (length args) 1)
(let* ((class (class-of (car args)))
(g-n-s (fetch-g-n-s (generic-function-name gf) class)))
(if g-n-s
(begin
(add-method! gf (compute-getter-method class g-n-s))
(gf (car args)))
(next-method)))
(next-method)))
(define-class <lazy-setter> (<generic>)
(slot-name #:init-keyword #:slot-name))
(define-method (no-applicable-method (gf <lazy-setter>) args)
(if (= (length args) 2)
(let* ((class (class-of (car args)))
(g-n-s (fetch-g-n-s (slot-ref gf 'slot-name) class)))
(if g-n-s
(begin
(add-method! gf (compute-setter-method class g-n-s))
(gf (car args) (cadr args)))
(next-method)))
(next-method)))
(define-class <lazy-accessor> (<accessor> <lazy-getter>))
(define (make-lazy-accessor name)
(make <lazy-accessor>
#:name name
#:setter (make <lazy-setter>
#:name (symbol-append 'setter: name)
#:slot-name name)))
(define-macro (with-accessors names . body)
`(let (,@(map (lambda (name)
`(,name ,(make-accessor name)))
names))
,@body))
But GOOPS doesn't do subclasses of <generic> yet. One day that code will
magically spring to utility.
Happy hacking,
Andy
--
http://wingolog.org/
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: with-accessors macro
2008-04-22 9:03 with-accessors macro Andy Wingo
@ 2008-04-23 21:50 ` Ludovic Courtès
0 siblings, 0 replies; 2+ messages in thread
From: Ludovic Courtès @ 2008-04-23 21:50 UTC (permalink / raw
To: guile-user
Hi,
Andy Wingo <wingo@pobox.com> writes:
> But GOOPS doesn't do subclasses of <generic> yet.
Yeah, that'd be a nice thing to have (one of the first things I tried
with GOOPS! [0]). Any idea what it would take to have it?
Thanks,
Ludo'.
[0] http://thread.gmane.org/gmane.lisp.guile.user/2117
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2008-04-23 21:50 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2008-04-22 9:03 with-accessors macro Andy Wingo
2008-04-23 21:50 ` Ludovic Courtès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).