Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.lisp > #60996

Re: slot-value-using-class to remap "virtual" slots & closer-mop

From steve g <Sgonedes1977@gmail.com>
Newsgroups comp.lang.lisp
Subject Re: slot-value-using-class to remap "virtual" slots & closer-mop
References <m3ldebnkqu.fsf@pison.robolove.meer.net>
Date 2026-06-19 22:00 -0400
Message-ID <87ik7ehsxo.fsf@gmail.com> (permalink)

Show all headers | View raw


Madhu <enometh@meer.net> writes:

> I had occasion to want to have certain slot-value accesses "redirect" to
> other slots, so accessing one would seem to affect the other.

I am thinking of letf. i will post it again. the cmucl version is
probably better...


(defmacro letf (forms &body body &environment env)
  (flet ((make-vars (count)
           (loop repeat count collect (gensym)))
         (equal-gensyms (x y)
           (if (and (symbolp x) (symbolp y))
			   (or (string= x y)        ; this seems to work, probably compares symbol-name
                   ;; this should be first test
                   (string= (symbol-name x) (symbol-name y)))
			   (equalp x y)))
         (extract-setf-subforms (forms)
           (mapcar #'(lambda (form)
             (if (null (cddr form))
                 (cadr form)
                 (error 'program-error
                  :format-arguments (list (cdr form))
                  :format-control
                  "~@<Odd number of subforms to setf: ~_~:w.~:@>")))
             forms)))

    (let ((getters ()) (getvars ())
          (setters ()) (storevars ())
          (valuevars (make-vars (length forms)))
          (valueforms (extract-setf-subforms forms)))
      (dolist (form forms)
        (multiple-value-bind (vars vals store-vars writer-form reader-form)
            (get-setf-expansion (car form) env)
          (setq getvars (nconc (mapcar #'list vars vals) getvars))
          (push reader-form getters)
          (push writer-form setters)
          (if (cdr store-vars)
              (error 'program-error
                :format-control "~@<Cannot expand form: ~_~:w.~:@>"
                :format-arguments (list form))
              (push (car store-vars) storevars))))

      (labels ((unroll-body (tempsetters body resetters)
                 (cond ((endp tempsetters)
                        (cons 'progn body))
                       (t `(unwind-protect
                      (progn ,(car tempsetters)
                        ,(unroll-body (cdr tempsetters) body (cdr resetters)))
                    ,(car resetters))))))

        (let ((tempsetters
             (sublis (pairlis storevars valuevars)
                setters :test #'equal-gensyms)))

        `(let* (
                ,@(mapcar #'list valuevars valueforms)
                ,@getvars
                ,@(mapcar #'list storevars getters))
           ,(unroll-body tempsetters body setters)))))))



LETF
CL-USER> (defvar *tart* (make-tart :numval 3 :chr-val #\z))
CL-USER> *tart*
#S(TART :NUMVAL 3 :CHRVAL #\d)
CL-USER> (progn
           (letf (((tart-numval *tart*) 37)
                  ((tart-chrval *tart*) #\z))
             (pprint *tart*))
           (pprint *tart*))

#S(TART :NUMVAL #\z :CHRVAL 37)
#S(TART :NUMVAL 3 :CHRVAL #\d)
; No value


this is the best idea I know of; and this idea is risky in my opinion.

Back to comp.lang.lisp | Previous | NextPrevious in thread | Find similar | Unroll thread


Thread

slot-value-using-class to remap "virtual" slots & closer-mop Madhu <enometh@meer.net> - 2026-04-25 20:35 +0530
  Re: slot-value-using-class to remap "virtual" slots & closer-mop tfb <no_email@invalid.invalid> - 2026-04-25 18:27 +0000
  Re: slot-value-using-class to remap "virtual" slots & closer-mop Madhu <enometh@meer.net> - 2026-05-07 05:22 +0530
    Re: slot-value-using-class to remap "virtual" slots & closer-mop Stefan Monnier <monnier@iro.umontreal.ca> - 2026-05-07 15:14 -0400
      Re: slot-value-using-class to remap "virtual" slots & closer-mop Madhu <enometh@meer.net> - 2026-05-08 09:48 +0530
        Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <sgonedes1977@gmail.com> - 2026-06-02 21:50 -0400
          Re: slot-value-using-class to remap "virtual" slots & closer-mop Madhu <enometh@meer.net> - 2026-06-03 09:21 +0530
            Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <sgonedes1977@gmail.com> - 2026-06-03 22:48 -0400
            Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-04 03:22 +0000
              Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <sgonedes1977@gmail.com> - 2026-06-04 17:01 -0400
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-04 22:42 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Madhu <enometh@meer.net> - 2026-06-08 04:13 +0530
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-07 23:22 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop tfb <no_email@invalid.invalid> - 2026-06-08 07:52 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Paul Rubin <no.email@nospam.invalid> - 2026-06-13 12:41 -0700
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-14 01:04 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Paul Rubin <no.email@nospam.invalid> - 2026-06-14 01:48 -0700
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-14 23:52 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Paul Rubin <no.email@nospam.invalid> - 2026-06-14 17:31 -0700
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-16 00:14 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <Sgonedes1977@gmail.com> - 2026-06-19 22:05 -0400
                Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <Sgonedes1977@gmail.com> - 2026-06-19 22:04 -0400
              Re: slot-value-using-class to remap "virtual" slots & closer-mop tfb <no_email@invalid.invalid> - 2026-06-07 16:42 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-07 23:24 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Nuno Silva <nunojsilva@invalid.invalid> - 2026-06-08 00:57 +0100
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Stefan Monnier <monnier@iro.umontreal.ca> - 2026-06-08 09:25 -0400
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Nuno Silva <nunojsilva@invalid.invalid> - 2026-06-15 10:22 +0100
            Re: slot-value-using-class to remap "virtual" slots & closer-mop tfb <no_email@invalid.invalid> - 2026-06-07 16:31 +0000
              Re: slot-value-using-class to remap "virtual" slots & closer-mop Paul Rubin <no.email@nospam.invalid> - 2026-06-07 12:31 -0700
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-08 02:27 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop tfb <no_email@invalid.invalid> - 2026-06-08 07:36 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop Lawrence D’Oliveiro <ldo@nz.invalid> - 2026-06-09 00:30 +0000
                Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <sgonedes1977@gmail.com> - 2026-06-09 00:25 -0400
                Re: slot-value-using-class to remap "virtual" slots & closer-mop tfb <no_email@invalid.invalid> - 2026-06-09 05:49 +0000
              Re: slot-value-using-class to remap "virtual" slots & closer-mop Madhu <enometh@meer.net> - 2026-06-08 04:06 +0530
              Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <Sgonedes1977@gmail.com> - 2026-06-19 23:10 -0400
  Re: slot-value-using-class to remap "virtual" slots & closer-mop steve g <Sgonedes1977@gmail.com> - 2026-06-19 22:00 -0400

csiph-web