This is the mail archive of the guile@sourceware.cygnus.com mailing list for the Guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: generalized set!


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)))))

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]