Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
348 views
in Technique[技术] by (71.8m points)

macros - what is to append as push is to cons, in Lisp?

(push x list)

expands to

(setq list (cons x list))

What expands to the following:

(setq list (append list2 list))

? Is there a standard macro for this?

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

As other answers and comments have pointed out, there's not a standard macro for this, and you can write your own. In my opinion, this is a good case for define-modify-macro, and I'll describe that first. You can also write such a macro manually, using get-setf-expansion, and I'll show an example of that, too.

Using define-modify-macro

One of the examples on the HyperSpec page for define-modify-macro is appendf:

Description:

define-modify-macro defines a macro named name to read and write a place.

The arguments to the new macro are a place, followed by the arguments that are supplied in lambda-list. Macros defined with define-modify-macro correctly pass the environment parameter to get-setf-expansion.

When the macro is invoked, function is applied to the old contents of the place and the lambda-list arguments to obtain the new value, and the place is updated to contain the result.

Examples

(define-modify-macro appendf (&rest args) 
   append "Append onto list") =>  APPENDF
(setq x '(a b c) y x) =>  (A B C)
(appendf x '(d e f) '(1 2 3)) =>  (A B C D E F 1 2 3)
x =>  (A B C D E F 1 2 3)
y =>  (A B C)

The appendf in the example is reversed from what you're looking for, since the extra arguments are appended as the tail of the place argument. However, we can write the functional version of the desired behavior (it's just append with argument order swapped), and then use define-modify-macro:

(defun swapped-append (tail head)
  (append head tail))

(define-modify-macro swapped-appendf (&rest args)
  swapped-append)

(let ((x '(1 2 3))
      (y '(4 5 6)))
  (swapped-appendf x y)
  x)
; => (4 5 6 1 2 3)

If you don't want to define swapped-append as a function, you can give a lambda-expression to define-modify-macro:

(define-modify-macro swapped-appendf (&rest args)
  (lambda (tail head) 
    (append head tail)))

(let ((x '(1 2 3))
? ? ? (y '(4 5 6)))
? (swapped-appendf x y)
? x)
; => (4 5 6 1 2 3)

So, the answer is that, conceptually, (swapped-appendf list list2) expands to (setq list (append list2 list)). It's still the case that the arguments to swapped-appendf may seem to be in the wrong order. After all, if we defined push using define-modify-macro and cons, the arguments would be in a different order from the standard push:

(define-modify-macro new-push (&rest args)
  (lambda (list item)
    (cons item list)))

(let ((x '(1 2 3)))
  (new-push x 4)
  x)
; => (4 1 2 3)

define-modify-macro is a handy tool to know about, and I've found it useful when functional (i.e., non-side-effecting) versions of functions are easy to write and a modifying version is also desired for an API.

Using get-setf-expansion

new-push's arguments are list and item, whereas push's arguments are item and list. I don't think the argument order in swapped-appendf is quite as important, since it's not a standard idiom. However, it is possible to achieve the other order by writing a prependf macro whose implementation uses get-setf-expansion to safely get the Setf Expansion for the place, and to avoid multiple evaluation.

(defmacro prependf (list place &environment environment)
  "Store the value of (append list place) into place."
  (let ((list-var (gensym (string '#:list-))))
    (multiple-value-bind (vars vals store-vars writer-form reader-form)
        (get-setf-expansion place environment)
      ;; prependf works only on a single place, so there
      ;; should be a single store-var.  This means we don't
      ;; handle, e.g., (prependf '(1 2 3) (values list1 list2))
      (destructuring-bind (store-var) store-vars
        ;; Evaluate the list form (since its the first argument) and
        ;; then bind all the temporary variables to the corresponding
        ;; value forms, and get the initial value of the place.
        `(let* ((,list-var ,list)
                ,@(mapcar #'list vars vals)
                (,store-var ,reader-form))
           (prog1 (setq ,store-var (append ,list-var ,store-var))
             ,writer-form))))))

(let ((x '(1 2 3))
      (y '(4 5 6)))
  (prependf y x)
  x)
; => (4 5 6 1 2 3)

The use of get-setf-expansion means that this macro works on more complicated places, too:

(let ((x (list 1 2 3))
      (y (list 4 5 6)))
  (prependf y (cddr x))
  x)
; => (1 2 4 5 6 3)

For educational purposes, it's interesting to see the relevant macroexpansions, and how they avoid multiple evaluations of the forms, and what the writer-forms are that are used to actually set the value. There's a lot of functionality bundled into get-setf-expansion, and some of it is implementation specific:

;; lexical variables just use SETQ
CL-USER> (pprint (macroexpand-1 '(prependf y x)))
(LET* ((#:LIST-885 Y)
       (#:NEW886 X))
  (PROG1 (SETQ #:NEW886 (APPEND #:LIST-885 #:NEW886))
    (SETQ X #:NEW886)))

;; (CDDR X) gets an SBCL internal RPLACD
CL-USER> (pprint (macroexpand-1 '(prependf y (cddr x))))
(LET* ((#:LIST-882 Y)
       (#:G883 X)
       (#:G884 (CDDR #:G883)))
  (PROG1 (SETQ #:G884 (APPEND #:LIST-882 #:G884))
    (SB-KERNEL:%RPLACD (CDR #:G883) #:G884)))

;; Setting in an array gets another SBCL internal ASET function
CL-USER> (pprint (macroexpand-1 '(prependf y (aref some-array i j))))
(LET* ((#:LIST-887 Y)
       (#:TMP891 SOME-ARRAY)
       (#:TMP890 I)
       (#:TMP889 J)
       (#:NEW888 (AREF #:TMP891 #:TMP890 #:TMP889)))
  (PROG1 (SETQ #:NEW888 (APPEND #:LIST-887 #:NEW888))
    (SB-KERNEL:%ASET #:TMP891 #:TMP890 #:TMP889 #:NEW888)))

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...