Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Don't delay quasiquote printing #1501

Merged
merged 1 commit into from
Sep 28, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
60 changes: 0 additions & 60 deletions src/lisp/kernel/cmp/activate-clasp-readtables-for-eclector.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
16 changes: 16 additions & 0 deletions src/lisp/kernel/lsp/format-pprint.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down Expand Up @@ -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)
Expand Down
8 changes: 8 additions & 0 deletions src/lisp/kernel/lsp/packages.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
Loading