From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.user Subject: with-accessors macro Date: Tue, 22 Apr 2008 11:03:46 +0200 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: ger.gmane.org 1208900838 8279 80.91.229.12 (22 Apr 2008 21:47:18 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 22 Apr 2008 21:47:18 +0000 (UTC) To: guile-user Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Tue Apr 22 23:47:52 2008 connect(): Connection refused Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1JoQL7-0000PE-UY for guile-user@m.gmane.org; Tue, 22 Apr 2008 23:47:50 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JoQKS-00080n-9t for guile-user@m.gmane.org; Tue, 22 Apr 2008 17:47:08 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1JoQKO-00080i-GO for guile-user@gnu.org; Tue, 22 Apr 2008 17:47:04 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1JoQKM-00080V-IP for guile-user@gnu.org; Tue, 22 Apr 2008 17:47:03 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JoQKM-00080S-Fb for guile-user@gnu.org; Tue, 22 Apr 2008 17:47:02 -0400 Original-Received: from a-sasl-fastnet.sasl.smtp.pobox.com ([207.106.133.19] helo=sasl.smtp.pobox.com) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1JoQKM-0001eR-5g for guile-user@gnu.org; Tue, 22 Apr 2008 17:47:02 -0400 Original-Received: from localhost.localdomain (localhost [127.0.0.1]) by a-sasl-fastnet.sasl.smtp.pobox.com (Postfix) with ESMTP id D4DB325C2 for ; Tue, 22 Apr 2008 17:46:53 -0400 (EDT) Original-Received: from unquote (96.Red-83-44-188.dynamicIP.rima-tde.net [83.44.188.96]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-sasl-fastnet.sasl.smtp.pobox.com (Postfix) with ESMTP id F266A25C0 for ; Tue, 22 Apr 2008 17:46:51 -0400 (EDT) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.0.60 (gnu/linux) X-detected-kernel: by monty-python.gnu.org: Solaris 10 (beta) X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.user:6543 Archived-At: 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 ()) (define-method (no-applicable-method (gf ) 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 () (slot-name #:init-keyword #:slot-name)) (define-method (no-applicable-method (gf ) 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 ( )) (define (make-lazy-accessor name) (make #:name name #:setter (make #: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 yet. One day that code will magically spring to utility. Happy hacking, Andy -- http://wingolog.org/