This is the mail archive of the
guile@sourceware.cygnus.com
mailing list for the Guile project.
Re: generalized set!
- To: guile at sourceware dot cygnus dot com
- Subject: Re: generalized set!
- From: Michael Livshin <mlivshin at bigfoot dot com>
- Date: 04 Nov 1999 20:26:17 +0200
- Organization: who? me?
- References: <s3g0ymyztb.fsf@bigfoot.com>
Michael Livshin <mlivshin@bigfoot.com> writes:
> the reason I've started to mess with it is a very very neat hack I saw
> in comp.lang.lisp and decided to ape. it assumes that the value
> argument goes last.
and here goes a slightly saner version, which doesn't assume any such
irrelevant things:
--------------->8 cut 8<------------------------------------------
(define-module (locatives)
#:use-module (ice-9 and-let*))
(export-syntax locative)
(export locative? contents)
;; ugh
(export %make-locative)
(define l-rtd (make-record-type 'locative '(getter setter source)
(lambda (o p)
(display "#<locative for " p)
(display (l-source o) p)
(display ">" p))))
(define %make-locative (record-constructor l-rtd))
(define l-getter (record-accessor l-rtd 'getter))
(define l-setter (record-accessor l-rtd 'setter))
(define l-source (record-accessor l-rtd 'source))
(define locative? (record-predicate l-rtd))
(define contents
(make-procedure-with-setter
(lambda (l)
((l-getter l)))
(lambda (l v)
((l-setter l) v))))
(defmacro locative (place)
(let* ((v (gensym 'locative-value))
(trans `(%make-locative
(lambda () ,place)
(lambda (,v) (set! ,place ,v))
',place)))
(cond
((symbol? place)
trans)
((pair? place)
(if (not (and-let* ((proc (car place))
((symbol? proc))
(proc (eval proc)))
(procedure-with-setter? proc)))
(throw 'invalid-place place))
trans)
(else
(throw 'invalid-place place)))))