Merge pull request #1501 from clasp-developers/bq

Don't delay quasiquote printing

src/lisp/kernel/cmp/activate-clasp-readtables-for-eclector.lisp

@@ -132,63 +132,3 @@
   (let ((patcher (core:make-record-patcher (lambda (object)
                                              (patch-object client object seen-objects)))))
     (core:patch-object object patcher)))
-
-(in-package :sys)
-
-(defun pprint-quote (stream list &rest noise)
-  (declare (ignore noise))
-  (if (and (consp list)
-	   (consp (cdr list))
-	   (null (cddr list)))
-      (case (car list)
-	(function
-	 (write-string "#'" stream)
-	 (write-object (cadr list) stream))
-	(quote
-	 (write-char #\' stream)
-	 (write-object (cadr list) stream))
-        ((eclector.reader:quasiquote core:quasiquote)
-         (write-char #\` stream)
-         (write-object (cadr list) stream))
-        ((eclector.reader:unquote core:unquote)
-         (write-char #\, stream)
-         (write-object (cadr list) stream))
-        ((eclector.reader:unquote-splicing core:unquote-splice)
-         (write-string ",@" stream)
-         (write-object (cadr list) stream))
-	(t
-	 (pprint-fill stream list)))
-      (pprint-fill stream list)))
-
-(defparameter +quasiquote-magic-forms+
-  '((eclector.reader:quasiquote pprint-quote)
-    (eclector.reader:unquote pprint-quote)
-    (eclector.reader:unquote-splicing pprint-quote)
-    (core:quasiquote pprint-quote)
-    (core:unquote pprint-quote)
-    (core:unquote-splice pprint-quote)))
-
-(progn
-  (setf (pprint-dispatch-table-read-only-p *standard-pprint-dispatch*) nil)
-  (dolist (magic-form +quasiquote-magic-forms+)
-    (set-pprint-dispatch `(cons (eql ,(first magic-form)))
-			 (symbol-function (second magic-form))
-                         0 *standard-pprint-dispatch*))
-  (setf *print-pprint-dispatch* (copy-pprint-dispatch nil)
-        (pprint-dispatch-table-read-only-p *standard-pprint-dispatch*) t))
-
-(defmethod print-object ((l cons) stream)
-  (if (cdr l)
-      (case (first l)
-        ((eclector.reader:quasiquote core:quasiquote)
-         (write-char #\` stream)
-         (core:write-object (second l) stream))
-        ((eclector.reader:unquote core:unquote)
-         (write-char #\, stream)
-         (core:write-object (second l) stream))
-        ((eclector.reader:unquote-splicing core:unquote-splice)
-         (write-string ",@" stream)
-         (core:write-object (second l) stream))
-        (otherwise
-         (call-next-method)))
-      (call-next-method)))

src/lisp/kernel/lsp/format-pprint.lisp

@@ -646,6 +646,18 @@
 	(quote
 	 (write-char #\' stream)
 	 (write-object (cadr list) stream))
+        (core:quasiquote
+         (write-char #\` stream)
+         (write-object (cadr list) stream))
+        (core:unquote
+         (write-char #\, stream)
+         (write-object (cadr list) stream))
+        (core:unquote-splice
+         (write-string ",@" stream)
+         (write-object (cadr list) stream))
+        (core:unquote-nsplice
+         (write-string ",." stream)
+         (write-object (cadr list) stream))
 	(t
 	 (pprint-fill stream list)))
       (pprint-fill stream list)))
@@ -801,6 +813,10 @@
     (tagbody pprint-tagbody)
     (throw pprint-block)
     (unwind-protect pprint-block)
+    (core:quasiquote pprint-quote)
+    (core:unquote pprint-quote)
+    (core:unquote-splice pprint-quote)
+    (core:unquote-nsplice pprint-quote)
 
     ;; Macros.
     (case pprint-case)

src/lisp/kernel/lsp/packages.lisp

@@ -149,6 +149,10 @@
           core:weak-pointer-valid
           core:weak-pointer-value
           core:num-logical-processors
+          core:quasiquote
+          core:unquote
+          core:unquote-splice
+          core:unquote-nsplice
           gctools:finalize
           gctools:garbage-collect
           gctools:save-lisp-and-die)
@@ -205,6 +209,10 @@
             getpid argc argv rmdir temporary-directory mkstemp weak-pointer-value
             make-weak-pointer weak-pointer-valid hash-table-weakness
             num-logical-processors
+            quasiquote
+            unquote
+            unquote-splice
+            unquote-nsplice
             compiler-note
             muffle-note
             segmentation-violation