projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.16.31: --control-stack-size runtime argument
[sbcl.git]
/
src
/
code
/
pp-backq.lisp
diff --git
a/src/code/pp-backq.lisp
b/src/code/pp-backq.lisp
index
9c4c7c9
..
c1268d0
100644
(file)
--- a/
src/code/pp-backq.lisp
+++ b/
src/code/pp-backq.lisp
@@
-35,32
+35,40
@@
((atom form)
(backq-unparse-expr form splicing))
((not (null (cdr (last form))))
((atom form)
(backq-unparse-expr form splicing))
((not (null (cdr (last form))))
- ;; FIXME: Shouldn't this be an ERROR?
- "### illegal dotted backquote form ###")
+ ;; FIXME: this probably throws a recursive error
+ (bug "found illegal dotted backquote form: ~S" form))
(t
(case (car form)
(backq-list
(mapcar #'backq-unparse (cdr form)))
(backq-list*
(do ((tail (cdr form) (cdr tail))
(t
(case (car form)
(backq-list
(mapcar #'backq-unparse (cdr form)))
(backq-list*
(do ((tail (cdr form) (cdr tail))
- (accum nil))
- ((null (cdr tail))
- (nconc (nreverse accum)
- (backq-unparse (car tail) t)))
- (push (backq-unparse (car tail)) accum)))
+ (accum nil))
+ ((null (cdr tail))
+ (nconc (nreverse accum)
+ (backq-unparse (car tail) t)))
+ (push (backq-unparse (car tail)) accum)))
(backq-append
(backq-append
- (mapcan (lambda (el) (backq-unparse el t))
- (cdr form)))
+ (apply #'append
+ (mapcar (lambda (el) (backq-unparse el t))
+ (cdr form))))
(backq-nconc
(backq-nconc
- (mapcan (lambda (el) (backq-unparse el :nconc))
- (cdr form)))
+ (apply #'append
+ (mapcar (lambda (el) (backq-unparse el :nconc))
+ (cdr form))))
(backq-cons
(cons (backq-unparse (cadr form) nil)
(backq-cons
(cons (backq-unparse (cadr form) nil)
- (backq-unparse (caddr form) t)))
+ (backq-unparse (caddr form) t)))
(backq-vector
(coerce (backq-unparse (cadr form)) 'vector))
(quote
(backq-vector
(coerce (backq-unparse (cadr form)) 'vector))
(quote
- (cadr form))
+ (cond
+ ((atom (cadr form)) (cadr form))
+ ((and (consp (cadr form))
+ (member (caadr form) *backq-tokens*))
+ (backq-unparse-expr form splicing))
+ (t (cons (backq-unparse `(quote ,(caadr form)))
+ (backq-unparse `(quote ,(cdadr form)))))))
(t
(backq-unparse-expr form splicing))))))
(t
(backq-unparse-expr form splicing))))))
@@
-75,9
+83,9
@@
(backq-comma
(write-char #\, stream))
(backq-comma-at
(backq-comma
(write-char #\, stream))
(backq-comma-at
- (princ ",@" stream))
+ (write-string ",@" stream))
(backq-comma-dot
(backq-comma-dot
- (princ ",." stream)))
+ (write-string ",." stream)))
;; Ha! an example of where the per-process specials for stream
;; attributes rather than per-stream actually makes life easier.
;; Since all of the attributes are shared in the dynamic state, we
;; Ha! an example of where the per-process specials for stream
;; attributes rather than per-stream actually makes life easier.
;; Since all of the attributes are shared in the dynamic state, we
@@
-89,12
+97,12
@@
;; work for pretty streams which need to do margin calculations. Oh
;; well. It was good while it lasted. -- CSR, 2003-12-15
(let ((output (with-output-to-string (s)
;; work for pretty streams which need to do margin calculations. Oh
;; well. It was good while it lasted. -- CSR, 2003-12-15
(let ((output (with-output-to-string (s)
- (write (cadr form) :stream s))))
+ (write (cadr form) :stream s))))
(unless (= (length output) 0)
(when (and (eql (car form) 'backq-comma)
(unless (= (length output) 0)
(when (and (eql (car form) 'backq-comma)
- (or (char= (char output 0) #\.)
- (char= (char output 0) #\@)))
- (write-char #\Space stream))
+ (or (char= (char output 0) #\.)
+ (char= (char output 0) #\@)))
+ (write-char #\Space stream))
(write (cadr form) :stream stream))))
;;; This is called by !PPRINT-COLD-INIT, fairly late, because
(write (cadr form) :stream stream))))
;;; This is called by !PPRINT-COLD-INIT, fairly late, because