Function: backquote-process

backquote-process is a byte-compiled function defined in backquote.el.gz.

Signature

(backquote-process S &optional LEVEL)

Documentation

Process the body of a backquote.

S is the body. Returns a cons cell whose cdr is piece of code which is the macro-expansion of S, and whose car is a small integer whose value can either indicate that the code is constant (0), or not (1), or returns a list which should be spliced into its environment (2). LEVEL is only used internally and indicates the nesting level:
0 (the default) is for the toplevel nested inside a single backquote.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/backquote.el.gz
(defun backquote-process (s &optional level)
  "Process the body of a backquote.
S is the body.  Returns a cons cell whose cdr is piece of code which
is the macro-expansion of S, and whose car is a small integer whose value
can either indicate that the code is constant (0), or not (1), or returns
a list which should be spliced into its environment (2).
LEVEL is only used internally and indicates the nesting level:
0 (the default) is for the toplevel nested inside a single backquote."
  (unless level (setq level 0))
  (cond
   ((vectorp s)
    (let ((n (backquote-process (append s ()) level)))
      (if (= (car n) 0)
	  (cons 0 s)
	(cons 1 (cond
		 ((not (listp (cdr n)))
		  (list 'vconcat (cdr n)))
		 ((eq (nth 1 n) 'list)
		  (cons 'vector (nthcdr 2 n)))
		 ((eq (nth 1 n) 'append)
		  (cons 'vconcat (nthcdr 2 n)))
		 (t
		  (list 'apply '(function vector) (cdr n))))))))
   ((atom s)
    ;; FIXME: Use macroexp-quote!
    (cons 0 (if (or (null s) (eq s t) (not (symbolp s)))
		s
	      (list 'quote s))))
   ((eq (car s) backquote-unquote-symbol)
    (if (<= level 0)
        (cond
         ((> (length s) 2)
          ;; We could support it with: (cons 2 `(list . ,(cdr s)))
          ;; But let's not encourage such uses.
          (error "Multiple args to , are not supported: %S" s))
         (t (cons (if (eq (car-safe (nth 1 s)) 'quote) 0 1)
                  (nth 1 s))))
      (backquote-delay-process s (1- level))))
   ((eq (car s) backquote-splice-symbol)
    (if (<= level 0)
        (if (> (length s) 2)
            ;; (cons 2 `(append . ,(cdr s)))
            (error "Multiple args to ,@ are not supported: %S" s)
          (cons 2 (nth 1 s)))
      (backquote-delay-process s (1- level))))
   ((eq (car s) backquote-backquote-symbol)
      (backquote-delay-process s (1+ level)))
   (t
    (let ((rest s)
	  item firstlist list lists expression)
      ;; Scan this list-level, setting LISTS to a list of forms,
      ;; each of which produces a list of elements
      ;; that should go in this level.
      ;; The order of LISTS is backwards.
      ;; If there are non-splicing elements (constant or variable)
      ;; at the beginning, put them in FIRSTLIST,
      ;; as a list of tagged values (TAG . FORM).
      ;; If there are any at the end, they go in LIST, likewise.
      (while (and (consp rest)
                  ;; Stop if the cdr is an expression inside a backquote or
                  ;; unquote since this needs to go recursively through
                  ;; backquote-process.
                  (not (or (eq (car rest) backquote-unquote-symbol)
                           (eq (car rest) backquote-backquote-symbol))))
	(setq item (backquote-process (car rest) level))
	(cond
	 ((= (car item) 2)
	  ;; Put the nonspliced items before the first spliced item
	  ;; into FIRSTLIST.
	  (if (null lists)
	      (setq firstlist list
		    list nil))
	  ;; Otherwise, put any preceding nonspliced items into LISTS.
	  (if list
	      (push (backquote-listify list '(0 . nil)) lists))
	  (push (cdr item) lists)
	  (setq list nil))
	 (t
	  (setq list (cons item list))))
	(setq rest (cdr rest)))
      ;; Handle nonsplicing final elements, and the tail of the list
      ;; (which remains in REST).
      (if (or rest list)
	  (push (backquote-listify list (backquote-process rest level))
                lists))
      ;; Turn LISTS into a form that produces the combined list.
      (setq expression
	    (if (or (cdr lists)
		    (eq (car-safe (car lists)) backquote-splice-symbol))
		(cons 'append (nreverse lists))
	      (car lists)))
      ;; Tack on any initial elements.
      (if firstlist
	  (setq expression (backquote-listify firstlist (cons 1 expression))))
      (cons (if (eq (car-safe expression) 'quote) 0 1) expression)))))