diff --git a/src/lisp/kernel/cmp/activate-clasp-readtables-for-eclector.lisp b/src/lisp/kernel/cmp/activate-clasp-readtables-for-eclector.lisp index 8605841ed3..c7c146b501 100644 --- a/src/lisp/kernel/cmp/activate-clasp-readtables-for-eclector.lisp +++ b/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))) diff --git a/src/lisp/kernel/lsp/format-pprint.lisp b/src/lisp/kernel/lsp/format-pprint.lisp index 4ec1a8d87e..4df5afabf9 100644 --- a/src/lisp/kernel/lsp/format-pprint.lisp +++ b/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) diff --git a/src/lisp/kernel/lsp/packages.lisp b/src/lisp/kernel/lsp/packages.lisp index 9d5367d9ef..896d4b791f 100644 --- a/src/lisp/kernel/lsp/packages.lisp +++ b/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