1 ;;;; pretty-printing of backquote expansions
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!IMPL")
17 (defun backq-unparse-expr (form splicing)
22 `((backq-comma-at ,form)))
24 `((backq-comma-dot ,form)))
27 (defun backq-unparse (form &optional splicing)
29 "Given a lisp form containing the magic functions BACKQ-LIST, BACKQ-LIST*,
30 BACKQ-APPEND, etc. produced by the backquote reader macro, will return a
31 corresponding backquote input form. In this form, `,' `,@' and `,.' are
32 represented by lists whose cars are BACKQ-COMMA, BACKQ-COMMA-AT, and
33 BACKQ-COMMA-DOT respectively, and whose cadrs are the form after the comma.
34 SPLICING indicates whether a comma-escape return should be modified for
35 splicing with other forms: a value of T or :NCONC meaning that an extra
36 level of parentheses should be added."
39 (backq-unparse-expr form splicing))
40 ((not (null (cdr (last form))))
41 ;; FIXME: Shouldn't this be an ERROR?
42 "### illegal dotted backquote form ###")
46 (mapcar #'backq-unparse (cdr form)))
48 (do ((tail (cdr form) (cdr tail))
51 (nconc (nreverse accum)
52 (backq-unparse (car tail) t)))
53 (push (backq-unparse (car tail)) accum)))
55 (mapcan #'(lambda (el) (backq-unparse el t))
58 (mapcan #'(lambda (el) (backq-unparse el :nconc))
61 (cons (backq-unparse (cadr form) nil)
62 (backq-unparse (caddr form) t)))
64 (coerce (backq-unparse (cadr form)) 'vector))
68 (backq-unparse-expr form splicing))))))
70 (defun pprint-backquote (stream form &rest noise)
71 (declare (ignore noise))
72 (write-char #\` stream)
73 (write (backq-unparse form) :stream stream))
75 (defun pprint-backq-comma (stream form &rest noise)
76 (declare (ignore noise))
79 (write-char #\, stream))
84 (write (cadr form) :stream stream))
86 ;;; This is called by !PPRINT-COLD-INIT, fairly late, because
87 ;;; SET-PPRINT-DISPATCH doesn't work until the compiler works.
89 ;;; FIXME: It might be cleaner to just make these toplevel forms and
90 ;;; enforce the delay by putting this file late in the build sequence.
91 (defun !backq-pp-cold-init ()
92 (set-pprint-dispatch '(cons (eql backq-list)) #'pprint-backquote)
93 (set-pprint-dispatch '(cons (eql backq-list*)) #'pprint-backquote)
94 (set-pprint-dispatch '(cons (eql backq-append)) #'pprint-backquote)
95 (set-pprint-dispatch '(cons (eql backq-nconc)) #'pprint-backquote)
96 (set-pprint-dispatch '(cons (eql backq-cons)) #'pprint-backquote)
97 (set-pprint-dispatch '(cons (eql backq-vector)) #'pprint-backquote)
99 (set-pprint-dispatch '(cons (eql backq-comma)) #'pprint-backq-comma)
100 (set-pprint-dispatch '(cons (eql backq-comma-at)) #'pprint-backq-comma)
101 (set-pprint-dispatch '(cons (eql backq-comma-dot)) #'pprint-backq-comma))