[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
with-accessors macro
From: |
Andy Wingo |
Subject: |
with-accessors macro |
Date: |
Tue, 22 Apr 2008 11:03:46 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/23.0.60 (gnu/linux) |
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/
- with-accessors macro,
Andy Wingo <=