From: Christophe R. <cr...@us...> - 2004-06-10 15:49:21
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19099/src/code Modified Files: backq.lisp pp-backq.lisp Log Message: 0.8.11.6: Fix countless bugs in backquote printing. ... descend quoted list structure, necessary in nested backquotes; ... fix the fix to Brian Downing's bug: MAPCAR is not sufficiently like MAPCAN. ... add a couple of tests, but frankly we need some more. If someone out there has a test suite for backquote behaviour, that would be rather nice. Index: backq.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/backq.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- backq.lisp 9 Dec 2003 15:12:08 -0000 1.9 +++ backq.lisp 10 Jun 2004 15:47:53 -0000 1.10 @@ -186,13 +186,10 @@ (cons 'backq-list* thing)))) ((eq flag 'vector) (list 'backq-vector thing)) - (t (cons (cdr - (assoc flag - '((cons . backq-cons) - (list . backq-list) - (append . backq-append) - (nconc . backq-nconc)) - :test #'equal)) + (t (cons (ecase flag + ((list) 'backq-list) + ((append) 'backq-append) + ((nconc) 'backq-nconc)) thing)))) ;;;; magic BACKQ- versions of builtin functions Index: pp-backq.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/pp-backq.lisp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- pp-backq.lisp 8 Jun 2004 12:49:28 -0000 1.7 +++ pp-backq.lisp 10 Jun 2004 15:47:53 -0000 1.8 @@ -49,18 +49,26 @@ (backq-unparse (car tail) t))) (push (backq-unparse (car tail)) accum))) (backq-append - (mapcar (lambda (el) (backq-unparse el t)) - (cdr form))) + (apply #'append + (mapcar (lambda (el) (backq-unparse el t)) + (cdr form)))) (backq-nconc - (mapcar (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-unparse (caddr form) t))) (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)))))) |