Function: cl--letf

cl--letf is a byte-compiled function defined in cl-macs.el.gz.

Signature

(cl--letf BINDINGS SIMPLEBINDS BINDS BODY)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/cl-macs.el.gz
;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
;; previous state.  If the getter/setter loses information, that info is
;; not recovered.

(defun cl--letf (bindings simplebinds binds body)
  ;; It's not quite clear what the semantics of cl-letf should be.
  ;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
  ;; that the actual assignments ("bindings") should only happen after
  ;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
  ;; PLACE1 and PLACE2 should be evaluated.  Should we have
  ;;    PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
  ;; or
  ;;    VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
  ;; or
  ;;    VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
  ;; Common-Lisp's `psetf' does the first, so we'll do the same.
  (if (null bindings)
      (if (and (null binds) (null simplebinds)) (macroexp-progn body)
        (let ((body-form
               (macroexp-progn
                (append
                 (delq nil
                       (mapcar (lambda (x)
                                 (pcase x
                                   ;; If there's no vnew, do nothing.
                                   (`(,_vold ,_getter ,setter ,vnew)
                                    (funcall setter vnew))))
                               binds))
                 body))))
        `(let* (,@(mapcar (lambda (x)
                            (pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
                              (list vold getter)))
                          binds)
                ,@simplebinds)
           ,(if binds
                `(unwind-protect ,body-form
                   ,@(mapcar (lambda (x)
                               (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
                                 (funcall setter vold)))
                             binds))
              body-form))))
    (let* ((binding (car bindings))
           (place (car binding)))
      (gv-letplace (getter setter) place
        (macroexp-let2 nil vnew (cadr binding)
          (if (and (symbolp place)
                   ;; `place' could be some symbol-macro.
                   (eq place getter))
              ;; Special-case for simple variables.
              ;; FIXME: We currently only use this special case when `place'
              ;; is a simple var.  Should we also use it when the
              ;; macroexpansion of `place' is a simple var (i.e. when
              ;; getter+setter is the same as that of a simple var)?
              (cl--letf (cdr bindings)
                        (cons `(,getter ,(if (cdr binding) vnew getter))
                              simplebinds)
                        binds body)
            (cl--letf (cdr bindings) simplebinds
                      (cons `(,(make-symbol "old") ,getter ,setter
                              ,@(if (cdr binding) (list vnew)))
                            binds)
                      body)))))))