Mercurial > emacs

comparison lisp/emacs-lisp/cl-macs.el @ 41695:73a58db610c2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(shiftf): Fix more. Simplify.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Fri, 30 Nov 2001 08:22:46 +0000
parents fce351ce81cf
children b0754865d85c
comparison
equal deleted inserted replaced
41694:835717f56bf2 41695:73a58db610c2
1842 1842
1843 (defmacro shiftf (place &rest args) 1843 (defmacro shiftf (place &rest args)
1844 "(shiftf PLACE PLACE... VAL): shift left among PLACEs. 1844 "(shiftf PLACE PLACE... VAL): shift left among PLACEs.
1845 Example: (shiftf A B C) sets A to B, B to C, and returns the old A. 1845 Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
1846 Each PLACE may be a symbol, or any generalized variable allowed by `setf'." 1846 Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
1847 (if (not (memq nil (mapcar 'symbolp (butlast (cons place args))))) 1847 (cond
1848 (list 'prog1 place 1848 ((null args) place)
1849 (let ((sets nil)) 1849 ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
1850 (while args 1850 (t
1851 (cl-push (list 'setq place (car args)) sets) 1851 (let ((method (cl-setf-do-modify place 'unsafe)))
1852 (setq place (cl-pop args))) 1852 `(let* ,(car method)
1853 `(setq ,(cadar sets) 1853 (prog1 ,(nth 2 method)
1854 (prog1 ,(caddar sets) 1854 ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args))))))))
1855 ,@(nreverse (cdr sets))))))
1856 (let* ((places (reverse (cons place args)))
1857 (form (cl-pop places)))
1858 (while places
1859 (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe)))
1860 (setq form (list 'let* (car method)
1861 (list 'prog1 (nth 2 method)
1862 (cl-setf-do-store (nth 1 method) form))))))
1863 form)))
1864 1855
1865 (defmacro rotatef (&rest args) 1856 (defmacro rotatef (&rest args)
1866 "(rotatef PLACE...): rotate left among PLACEs. 1857 "(rotatef PLACE...): rotate left among PLACEs.
1867 Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. 1858 Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
1868 Each PLACE may be a symbol, or any generalized variable allowed by `setf'." 1859 Each PLACE may be a symbol, or any generalized variable allowed by `setf'."