Common Lisp the Language, 2nd Edition


next up previous contents index
Next: References Up: Common Lisp the Language Previous: Discussion

Appendix C.
Backquote

change_begin
Here is the code for an implementation of backquote syntax (see section 22.1.3) that I have found quite useful in explaining to myself the behavior of nested backquotes. It implements the formal rules for backquote processing and optionally applies a code simplifier to the result. One must be very careful in choosing the simplification rules; the rules given here work, but some Common Lisp implementations have run into trouble at one time or another by using a simplification rule that does not work in all cases. Code transformations that are plausible when single forms are involved are likely to fail in the presence of splicing.

At the end of this appendix are some samples of nested backquote syntax with commentary.

;;; Common Lisp backquote implementation, written in Common Lisp. 
;;; Author: Guy L. Steele Jr.     Date: 27 December 1985 
;;; Tested under Symbolics Common Lisp and Lucid Common Lisp. 
;;; This software is in the public domain.

;;; $ is pseudo-backquote and % is pseudo-comma.  This makes it 
;;; possible to test this code without interfering with normal 
;;; Common Lisp syntax.

;;; The following are unique tokens used during processing. 
;;; They need not be symbols; they need not even be atoms.

(defvar *comma* (make-symbol "COMMA")) 
(defvar *comma-atsign* (make-symbol "COMMA-ATSIGN")) 
(defvar *comma-dot* (make-symbol "COMMA-DOT")) 
(defvar *bq-list* (make-symbol "BQ-LIST")) 
(defvar *bq-append* (make-symbol "BQ-APPEND")) 
(defvar *bq-list** (make-symbol "BQ-LIST*")) 
(defvar *bq-nconc* (make-symbol "BQ-NCONC")) 
(defvar *bq-clobberable* (make-symbol "BQ-CLOBBERABLE")) 
(defvar *bq-quote* (make-symbol "BQ-QUOTE")) 
(defvar *bq-quote-nil* (list *bq-quote* nil))

;;; Reader macro characters: 
;;;    $foo is read in as (BACKQUOTE foo) 
;;;    %foo is read in as (#:COMMA foo) 
;;;    %@foo is read in as (#:COMMA-ATSIGN foo) 
;;;    %.foo is read in as (#:COMMA-DOT foo) 
;;; where #:COMMA is the value of the variable *COMMA*, etc.

;;; BACKQUOTE is an ordinary macro (not a read-macro) that 
;;; processes the expression foo, looking for occurrences of 
;;; #:COMMA, #:COMMA-ATSIGN, and #:COMMA-DOT.  It constructs code 
;;; in strict accordance with the rules on pages 349-350 of 
;;; the first edition (pages 528-529 of this second edition). 
;;; It then optionally applies a code simplifier.

(set-macro-character #\$ 
  #'(lambda (stream char) 
      (declare (ignore char)) 
      (list 'backquote (read stream t nil t))))

(set-macro-character #\% 
  #'(lambda (stream char) 
      (declare (ignore char)) 
        (case (peek-char nil stream t nil t) 
          (#\@ (read-char stream t nil t) 
               (list *comma-atsign* (read stream t nil t))) 
          (#\. (read-char stream t nil t) 
               (list *comma-dot* (read stream t nil t))) 
          (otherwise (list *comma* (read stream t nil t))))))

 
;;; If the value of *BQ-SIMPLIFY* is non-NIL, then BACKQUOTE 
;;; processing applies the code simplifier.  If the value is NIL, 
;;; then the code resulting from BACKQUOTE is exactly that 
;;; specified by the official rules.

(defparameter *bq-simplify* t)

(defmacro backquote (x) 
  (bq-completely-process x))

;;; Backquote processing proceeds in three stages: 
;;; 
;;; (1) BQ-PROCESS applies the rules to remove occurrences of 
;;; #:COMMA, #:COMMA-ATSIGN, and #:COMMA-DOT corresponding to 
;;; this level of BACKQUOTE.  (It also causes embedded calls to 
;;; BACKQUOTE to be expanded so that nesting is properly handled.) 
;;; Code is produced that is expressed in terms of functions 
;;; #:BQ-LIST, #:BQ-APPEND, and #:BQ-CLOBBERABLE.  This is done 
;;; so that the simplifier will simplify only list construction 
;;; functions actually generated by BACKQUOTE and will not involve 
;;; any user code in the simplification.  #:BQ-LIST means LIST, 
;;; #:BQ-APPEND means APPEND, and #:BQ-CLOBBERABLE means IDENTITY 
;;; but indicates places where "%." was used and where NCONC may 
;;; therefore be introduced by the simplifier for efficiency. 
;;; 
;;; (2) BQ-SIMPLIFY, if used, rewrites the code produced by 
;;; BQ-PROCESS to produce equivalent but faster code.  The 
;;; additional functions #:BQ-LIST* and #:BQ-NCONC may be 
;;; introduced into the code. 
;;; 
;;; (3) BQ-REMOVE-TOKENS goes through the code and replaces 
;;; #:BQ-LIST with LIST, #:BQ-APPEND with APPEND, and so on. 
;;; #:BQ-CLOBBERABLE is simply eliminated (a call to it being 
;;; replaced by its argument).  #:BQ-LIST* is replaced by either 
;;; LIST* or CONS (the latter is used in the two-argument case, 
;;; purely to make the resulting code a tad more readable).

(defun bq-completely-process (x) 
  (let ((raw-result (bq-process x))) 
    (bq-remove-tokens (if *bq-simplify* 
                          (bq-simplify raw-result) 
                          raw-result))))

(defun bq-process (x) 
  (cond ((atom x) 
         (list *bq-quote* x)) 
        ((eq (car x) 'backquote) 
         (bq-process (bq-completely-process (cadr x)))) 
        ((eq (car x) *comma*) (cadr x)) 
        ((eq (car x) *comma-atsign*) 
         (error ",@~S after `" (cadr x))) 
        ((eq (car x) *comma-dot*) 
         (error ",.~S after `" (cadr x))) 
        (t (do ((p x (cdr p)) 
                (q '() (cons (bracket (car p)) q))) 
               ((atom p) 
                (cons *bq-append* 
                      (nreconc q (list (list *bq-quote* p))))) 
             (when (eq (car p) *comma*) 
               (unless (null (cddr p)) (error "Malformed ,~S" p)) 
               (return (cons *bq-append* 
                             (nreconc q (list (cadr p)))))) 
             (when (eq (car p) *comma-atsign*) 
               (error "Dotted ,@~S" p)) 
             (when (eq (car p) *comma-dot*) 
               (error "Dotted ,.~S" p))))))

;;; This implements the bracket operator of the formal rules.

(defun bracket (x) 
  (cond ((atom x) 
         (list *bq-list* (bq-process x))) 
        ((eq (car x) *comma*) 
         (list *bq-list* (cadr x))) 
        ((eq (car x) *comma-atsign*) 
         (cadr x)) 
        ((eq (car x) *comma-dot*) 
         (list *bq-clobberable* (cadr x))) 
        (t (list *bq-list* (bq-process x)))))

;;; This auxiliary function is like MAPCAR but has two extra 
;;; purposes: (1) it handles dotted lists; (2) it tries to make 
;;; the result share with the argument x as much as possible.

(defun maptree (fn x) 
  (if (atom x) 
      (funcall fn x) 
      (let ((a (funcall fn (car x))) 
            (d (maptree fn (cdr x)))) 
        (if (and (eql a (car x)) (eql d (cdr x))) 
            x 
            (cons a d)))))

;;; This predicate is true of a form that when read looked 
;;; like %@foo or %.foo.

(defun bq-splicing-frob (x) 
  (and (consp x) 
       (or (eq (car x) *comma-atsign*) 
           (eq (car x) *comma-dot*))))

 
;;; This predicate is true of a form that when read 
;;; looked like %@foo or %.foo or just plain %foo.

(defun bq-frob (x) 
  (and (consp x) 
       (or (eq (car x) *comma*) 
           (eq (car x) *comma-atsign*) 
           (eq (car x) *comma-dot*))))

;;; The simplifier essentially looks for calls to #:BQ-APPEND and 
;;; tries to simplify them.  The arguments to #:BQ-APPEND are 
;;; processed from right to left, building up a replacement form. 
;;; At each step a number of special cases are handled that, 
;;; loosely speaking, look like this: 
;;; 
;;;  (APPEND (LIST a b c) foo) => (LIST* a b c foo) 
;;;       provided a, b, c are not splicing frobs 
;;;  (APPEND (LIST* a b c) foo) => (LIST* a b (APPEND c foo)) 
;;;       provided a, b, c are not splicing frobs 
;;;  (APPEND (QUOTE (x)) foo) => (LIST* (QUOTE x) foo) 
;;;  (APPEND (CLOBBERABLE x) foo) => (NCONC x foo)

(defun bq-simplify (x) 
  (if (atom x) 
      x 
      (let ((x (if (eq (car x) *bq-quote*) 
                   x 
                   (maptree #'bq-simplify x)))) 
        (if (not (eq (car x) *bq-append*)) 
            x 
            (bq-simplify-args x)))))

(defun bq-simplify-args (x) 
  (do ((args (reverse (cdr x)) (cdr args)) 
       (result 
         nil 
         (cond ((atom (car args)) 
                (bq-attach-append *bq-append* (car args) result)) 
               ((and (eq (caar args) *bq-list*) 
                     (notany #'bq-splicing-frob (cdar args))) 
                (bq-attach-conses (cdar args) result)) 
               ((and (eq (caar args) *bq-list**) 
                     (notany #'bq-splicing-frob (cdar args))) 
                (bq-attach-conses 
                  (reverse (cdr (reverse (cdar args)))) 
                  (bq-attach-append *bq-append* 
                                    (car (last (car args))) 
                                    result))) 
               ((and (eq (caar args) *bq-quote*) 
                     (consp (cadar args)) 
                     (not (bq-frob (cadar args))) 
                     (null (cddar args))) 
                (bq-attach-conses (list (list *bq-quote* 
                                              (caadar args))) 
                                  result)) 
               ((eq (caar args) *bq-clobberable*) 
                (bq-attach-append *bq-nconc* (cadar args) result)) 
               (t (bq-attach-append *bq-append* 
                                    (car args) 
                                    result))))) 
      ((null args) result)))

(defun null-or-quoted (x) 
  (or (null x) (and (consp x) (eq (car x) *bq-quote*))))

;;; When BQ-ATTACH-APPEND is called, the OP should be #:BQ-APPEND 
;;; or #:BQ-NCONC.  This produces a form (op item result) but 
;;; some simplifications are done on the fly: 
;;; 
;;;  (op '(a b c) '(d e f g)) => '(a b c d e f g) 
;;;  (op item 'nil) => item, provided item is not a splicable frob 
;;;  (op item 'nil) => (op item), if item is a splicable frob 
;;;  (op item (op a b c)) => (op item a b c)

(defun bq-attach-append (op item result) 
  (cond ((and (null-or-quoted item) (null-or-quoted result)) 
         (list *bq-quote* (append (cadr item) (cadr result)))) 
        ((or (null result) (equal result *bq-quote-nil*)) 
         (if (bq-splicing-frob item) (list op item) item)) 
        ((and (consp result) (eq (car result) op)) 
         (list* (car result) item (cdr result))) 
        (t (list op item result))))

;;; The effect of BQ-ATTACH-CONSES is to produce a form as if by 
;;; `(LIST* ,@items ,result) but some simplifications are done 
;;; on the fly. 
;;; 
;;;  (LIST* 'a 'b 'c 'd) => '(a b c . d) 
;;;  (LIST* a b c 'nil) => (LIST a b c) 
;;;  (LIST* a b c (LIST* d e f g)) => (LIST* a b c d e f g) 
;;;  (LIST* a b c (LIST d e f g)) => (LIST a b c d e f g)

(defun bq-attach-conses (items result) 
  (cond ((and (every #'null-or-quoted items) 
              (null-or-quoted result)) 
         (list *bq-quote* 
               (append (mapcar #'cadr items) (cadr result)))) 
        ((or (null result) (equal result *bq-quote-nil*)) 
         (cons *bq-list* items)) 
        ((and (consp result) 
              (or (eq (car result) *bq-list*) 
                  (eq (car result) *bq-list**))) 
         (cons (car result) (append items (cdr result)))) 
        (t (cons *bq-list** (append items (list result))))))

;;; Removes funny tokens and changes (#:BQ-LIST* a b) into 
;;; (CONS a b) instead of (LIST* a b), purely for readability.

(defun bq-remove-tokens (x) 
  (cond ((eq x *bq-list*) 'list) 
        ((eq x *bq-append*) 'append) 
        ((eq x *bq-nconc*) 'nconc) 
        ((eq x *bq-list**) 'list*) 
        ((eq x *bq-quote*) 'quote) 
        ((atom x) x) 
        ((eq (car x) *bq-clobberable*) 
         (bq-remove-tokens (cadr x))) 
        ((and (eq (car x) *bq-list**) 
              (consp (cddr x)) 
              (null (cdddr x))) 
         (cons 'cons (maptree #'bq-remove-tokens (cdr x)))) 
        (t (maptree #'bq-remove-tokens x))))

Suppose that we first make the following definitions:

(setq q '(r s)) 
(defun r (x) (reduce #'* x)) 
(setq r '(3 5)) 
(setq s '(4 6))

Without simplification, the notation $$(%%q) (which stands for ``(,,q)) is read as the expression

(APPEND (LIST 'APPEND) (LIST (APPEND (LIST 'LIST) (LIST Q))))

The value of this expression is

(APPEND (LIST (R S)))

and the value of this value is (24). We conclude that the net effect of twice-evaluating ``(,,q) is to take the value 24 of the value (r s) of q and plug it into the template ( ) to produce (24).

With simplification, the notation $$(%%q) is read as the expression

(LIST 'LIST Q)

The value of this expression is

(LIST (R S))

and the value of this value is (24). Thus the two ways of reading $$(%%q) do not produce the same expression-this we expected-but the values of the two ways are different as well. Only the values of the values are the same. In general, Common Lisp guarantees the result of an expression with backquotes nested to depth k only after k successive evaluations have been performed; the results after fewer than k evaluations are implementation-dependent.

(Note that in the expression `(foo ,(process `(bar ,x))) the backquotes are not doubly nested. The inner backquoted expression occurs within the textual scope of a comma belonging to the outer backquote. The correct way to determine the backquote nesting level of any subexpression is to start a count at zero and proceed up the S-expression tree, adding one for each backquote and subtracting one for each comma. This is similar to the rule for determining nesting level with respect to parentheses by scanning a character string linearly, adding or subtracting one as parentheses are passed.)

It is convenient to extend the ``=='' notation to handle multiple evaluation: x == == y means that the expressions x and y may have different results but they have the same results when twice evaluated. Similarly, x == ==== y means that the values of the values of the values of x and y are the same, and so on.

We can illustrate the differences between non-splicing and splicing backquote inclusions quite concisely:

$$(%%q)  == 
  (APPEND (LIST 'APPEND) (LIST (APPEND (LIST 'LIST) (LIST Q)))) 
  == == (LIST 'LIST Q) => (LIST (R S)) => (24)

$$(%@%q) == 
  (APPEND (LIST 'APPEND) (LIST Q)) 
  == == Q => (R S) => 24

$$(%%@q) == 
  (APPEND (LIST 'APPEND) (LIST (APPEND (LIST 'LIST) Q))) 
  == == (CONS 'LIST Q) => (LIST R S) => ((3 5) (4 6))

$$(%@%@q) == 
  (APPEND (LIST 'APPEND) Q) 
  == == (CONS 'APPEND Q) => (APPEND R S) => (3 5 4 6)

In each case I have shown both the unsimplified and simplified forms and then traced the intermediate evaluations of the simplified form. (Actually, the unsimplified forms do contain one simplification without which they would be unreadable: the nil that terminates each list has been systematically suppressed, so that one sees (append x y) rather than (append x y 'nil).)

The following driver function is useful for tracing the behavior of nested backquote syntax through multiple evaluations. The argument ls is a list of strings; each string will be processed by the reader (read-from-string). The argument n is the number of evaluations desired.

(defun try (ls &optional (n 0)) 
  (dolist (x ls) 
    (format t "~&~A" 
            (substitute #\` #\$ (substitute #\, #\% x))) 
    (do ((form (macroexpand (read-from-string x)) (eval form)) 
         (str " = " "~% => ") 
         (j 0 (+ j 1))) 
        ((>= j n) 
         (format t str) 
         (write form :pretty t)) 
      (format t str) 
      (write form :pretty t))) 
  (format t "~\&"))

This driver routine makes it easdy to explore a large number of cases systematically. Here is a list of examples that illustrate not only the differences between , and ,@ but also their interaction with '.

(setq fools2 '( 
"$$(foo %%p)" 
"$$(foo %%@q)" 
"$$(foo %'%r)" 
"$$(foo %'%@s)" 
"$$(foo %@%p)" 
"$$(foo %@%@q)" 
"$$(foo %@'%r)" 
"$$(foo %@'%@s)" 
))

Consider this set of sample values:

(setq p '(union x y)) 
(setq q '((union x y) (list 'sqrt 9))) 
(setq r '(union x y)) 
(setq s '((union x y)))

Here is what happened when I executed (try fools2 2) with a non-nil value for the variable *bq-simplify* (to see simplified forms). I have interpolated some remarks.

``(foo ,,p) = (LIST 'LIST ''FOO P) 
 => (LIST 'FOO (UNION X Y)) 
 => (FOO (A B C))

So ,,p means ``the value of p is a form; use the value of the value of p.''

``(foo ,,@q) = (LIST* 'LIST ''FOO Q) 
 => (LIST 'FOO (UNION X Y) (LIST 'SQRT 9)) 
 => (FOO (A B C) (SQRT 9))

So ,,@q means ``the value of q is a list of forms; splice the list of values of the elements of the value of q.''

``(foo ,',r) = (LIST 'LIST ''FOO (LIST 'QUOTE R)) 
 => (LIST 'FOO '(UNION X Y)) 
 => (FOO (UNION X Y))

So ,',r means ``the value of r may be any object; use the value of r that is available at the time of first evaluation, that is, when the outer backquote is evaluated.'' (To use the value of r that is available at the time of second evaluation, that is, when the inner backquote is evaluated, just use ,r.)

``(foo ,',@s) = (LIST 'LIST ''FOO (CONS 'QUOTE S)) 
 => (LIST 'FOO '(UNION X Y)) 
 => (FOO (UNION X Y))

So ,',@s means ``the value of s must be a singleton list of any object; use the element of the value of s that is available at the time of first evaluation, that is, when the outer backquote is evaluated.'' Note that s must be a singleton list because it will be spliced into a form (quote ), and the quote special form requires exactly one subform to appear; this is generally true of the sequence ',@. (To use the value of s that is available at the time of second evaluation, that is, when the inner backquote is evaluated, just use ,@s,in which case the list s is not restricted to be singleton, or ,(car s).)

``(foo ,@,p) = (LIST 'CONS ''FOO P) 
 => (CONS 'FOO (UNION X Y)) 
 => (FOO A B C)

So ,@,p means ``the value of p is a form; splice in the value of the value of p.''

``(foo ,@,@q) = (LIST 'CONS ''FOO (CONS 'APPEND Q)) 
 => (CONS 'FOO (APPEND (UNION X Y) (LIST 'SQRT 9))) 
 => (FOO A B C SQRT 9)

So ,@,@q means ``the value of q is a list of forms; splice each of the values of the elements of the value of q, so that many splicings occur.''

``(foo ,@',r) = (LIST 'CONS ''FOO (LIST 'QUOTE R)) 
 => (CONS 'FOO '(UNION X Y)) 
 => (FOO UNION X Y)

So ,@',r means ``the value of r must be a list; splice in the value of r that is available at the time of first evaluation, that is, when the outer backquote is evaluated.'' (To splice the value of r that is available at the time of second evaluation, that is, when the inner backquote is evaluated, just use ,@r.)

``(foo ,@',@s) = (LIST 'CONS ''FOO (CONS 'QUOTE S)) 
 => (CONS 'FOO '(UNION X Y)) 
 => (FOO UNION X Y)

So ,@',@s means ``the value of s must be a singleton list whose element is a list; splice in the list that is the element of the value of s that is available at the time of first evaluation, that is, when the outer backquote is evaluated.'' (To splice the element of the value of s that is available at the time of second evaluation, that is, when the inner backquote is evaluated, just use ,@(car s).)

I leave it to the reader to explore the possibilities of triply nested backquotes.

(setq fools3 '( 
"$$$(foo %%%p)"     "$$$(foo %%%@q)" 
"$$$(foo %%'%r)"    "$$$(foo %%'%@s)" 
"$$$(foo %%@%p)"    "$$$(foo %%@%@q)" 
"$$$(foo %%@'%r)"   "$$$(foo %%@'%@s)" 
"$$$(foo %'%%p)"    "$$$(foo %'%%@q)" 
"$$$(foo %'%'%r)"   "$$$(foo %'%'%@s)" 
"$$$(foo %'%@%p)"   "$$$(foo %'%@%@q)" 
"$$$(foo %'%@'%r)"  "$$$(foo %'%@'%@s)" 
"$$$(foo %@%%p)"    "$$$(foo %@%%@q)" 
"$$$(foo %@%'%r)"   "$$$(foo %@%'%@s)" 
"$$$(foo %@%@%p)"   "$$$(foo %@%@%@q)" 
"$$$(foo %@%@'%r)"  "$$$(foo %@%@'%@s)" 
"$$$(foo %@'%%p)"   "$$$(foo %@'%%@q)" 
"$$$(foo %@'%'%r)"  "$$$(foo %@'%'%@s)" 
"$$$(foo %@'%@%p)"  "$$$(foo %@'%@%@q)" 
"$$$(foo %@'%@'%r)" "$$$(foo %@'%@'%@s)" 
))

It is a pleasant exercise to construct values for p, q, r, and s that will allow execution of (try fools3 3) without error.
change_end



next up previous contents index
Next: References Up: Common Lisp the Language Previous: Discussion


AI.Repository@cs.cmu.edu