to...@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 <address>
#:street "Franklin Street"
#:city "Boston"
#:country "USA"))
(define rms
(make <person>
#:age 30
#:email "r...@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?
;; By Christopher Allan Webber, LGPLv3+; adapted from shallow-clone in GOOPS
(use-modules (oop goops)
(ice-9 match))
(define-method (slot-fset (self <object>) 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 <address> ()
(street #:init-keyword #:street
#:accessor .street)
(city #:init-keyword #:city
#:accessor .city)
(country #:init-keyword #:country
#:accessor .country))
(define-class <person> ()
(age #:init-keyword #:age
#:accessor .age)
(email #:init-keyword #:email
#:accessor .email)
(address #:init-keyword #:address
#:accessor .address))
(define fsf-address
(make <address>
#:street "Franklin Street"
#:city "Boston"
#:country "USA"))
(define rms
(make <person>
#:age 30
#:email "r...@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"
