From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Christopher Allan Webber Newsgroups: gmane.lisp.guile.user Subject: Re: GOOPS functional setter Date: Sat, 14 Jan 2017 15:16:10 -0600 Message-ID: <87shole411.fsf@dustycloud.org> References: <871sw6g4je.fsf@dustycloud.org> <20170113205646.GB10416@tuxteam.de> <87vatie6gf.fsf@dustycloud.org> <20170114100839.GA3366@tuxteam.de> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1484428598 19600 195.159.176.226 (14 Jan 2017 21:16:38 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 14 Jan 2017 21:16:38 +0000 (UTC) User-Agent: mu4e 0.9.18; emacs 25.1.1 Cc: guile-user@gnu.org To: tomas@tuxteam.de Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sat Jan 14 22:16:33 2017 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cSVgc-0004KL-GL for guile-user@m.gmane.org; Sat, 14 Jan 2017 22:16:30 +0100 Original-Received: from localhost ([::1]:49415 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cSVgg-0004Ra-Sd for guile-user@m.gmane.org; Sat, 14 Jan 2017 16:16:34 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36190) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cSVgL-0004RI-TV for guile-user@gnu.org; Sat, 14 Jan 2017 16:16:15 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cSVgK-0003mK-TT for guile-user@gnu.org; Sat, 14 Jan 2017 16:16:13 -0500 Original-Received: from dustycloud.org ([2600:3c02::f03c:91ff:feae:cb51]:52804) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cSVgK-0003lR-Np for guile-user@gnu.org; Sat, 14 Jan 2017 16:16:12 -0500 Original-Received: from oolong (localhost [127.0.0.1]) by dustycloud.org (Postfix) with ESMTPS id 493BC2662C; Sat, 14 Jan 2017 16:16:11 -0500 (EST) In-reply-to: <20170114100839.GA3366@tuxteam.de> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2600:3c02::f03c:91ff:feae:cb51 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.org gmane.lisp.guile.user:13101 Archived-At: --=-=-= Content-Type: text/plain tomas@tuxteam.de writes: > Curiously, Jan (also in this thread) came up with "clone", > independently. Yes you're right. :) Speaking of Jan and I both thinking about clone'ish things, we did a bit of talking on IRC and I think we have a very nice version of functional setters where you can "clone" multiple fields at the same time. Here's what it looks like in practice, adapting from the (srfi srfi-9 gnu) code: (define fsf-address (make
#:street "Franklin Street" #:city "Boston" #:country "USA")) (define rms (make #:age 30 #:email "rms@gnu.org" #:address fsf-address)) (define new-rms (clone rms ((.age) 60) ((.address .street) "Temple Place"))) scheme@(guile-user)> (.age rms) $12 = 30 scheme@(guile-user)> (.age new-rms) $13 = 60 scheme@(guile-user)> (.street (.address rms)) $14 = "Franklin Street" scheme@(guile-user)> (.street (.address new-rms)) $15 = "Temple Place" ... not bad, eh? Updated copy of goops-functional-setter.scm attached! What do other people think? Should I try to get this upstream in Guile? --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=goops-functional-setter.scm ;; By Christopher Allan Webber, LGPLv3+; adapted from shallow-clone in GOOPS (use-modules (oop goops) (ice-9 match)) (define-method (slot-fset (self ) slot-name value) "Return a new copy of SELF, with all slots preserved except SLOT-NAME set to VALUE." (let* ((class (class-of self)) (clone (allocate-instance class '()))) (for-each (lambda (slot) (define slot-n (slot-definition-name slot)) (if (and (not (eq? slot-n slot-name)) (slot-bound? self slot-n)) (slot-set! clone slot-n (slot-ref self slot-n)))) (class-slots class)) ;; Set the particular slot we're overriding (slot-set! clone slot-name value) clone)) ;; By Christopher Allan Webber, LGPLv3+ ;; Inspired by a conversation with Jan Nieuwenhuizen... thanks for the ;; help, Jan! ;; This one does an "immutable" interface cloned-with-adjustments ;; version of things that can change multiple fields at the same time. ;; It uses, and requires, accessors to work on the adjusted fields. (use-modules (oop goops) (ice-9 match)) (define (do-clone obj adjust-fields) (define new (shallow-clone obj)) (for-each (match-lambda ;; Apply just this one field (((accessor) val) (set! (accessor new) val)) ;; Recursively apply fields (((accessor recur-fields ...) val) (set! (accessor new) (do-clone (accessor new) (list (list recur-fields val)))))) adjust-fields) new) (define-syntax-rule (clone obj ((fields ...) val) ...) (do-clone obj (list (list (list fields ...) val) ...))) ;; That's all the code. ;; Now here's an example adapted from the (srfi srfi-9 gnu) ;; documentation. (define-class
() (street #:init-keyword #:street #:accessor .street) (city #:init-keyword #:city #:accessor .city) (country #:init-keyword #:country #:accessor .country)) (define-class () (age #:init-keyword #:age #:accessor .age) (email #:init-keyword #:email #:accessor .email) (address #:init-keyword #:address #:accessor .address)) (define fsf-address (make
#:street "Franklin Street" #:city "Boston" #:country "USA")) (define rms (make #:age 30 #:email "rms@gnu.org" #:address fsf-address)) (define new-rms (clone rms ((.age) 60) ((.address .street) "Temple Place"))) ;; scheme@(guile-user)> (.age rms) ;; $12 = 30 ;; scheme@(guile-user)> (.age new-rms) ;; $13 = 60 ;; scheme@(guile-user)> (.street (.address rms)) ;; $14 = "Franklin Street" ;; scheme@(guile-user)> (.street (.address new-rms)) ;; $15 = "Temple Place" --=-=-=--