mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 05:43:19 -08:00
Code Issues Projects Releases Packages Wiki Activity

The standard pprint dispatch table in with-standard-io-syntax is now read-only

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2013-03-03 00:10:09 +01:00
parent a17c4d0e7d
commit 20906c6be6
1 changed files with 12 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/lsp/pprint.lsp
View file

@ -1054,6 +1054,7 @@
;;;; Pprint-dispatch tables.
(defvar *standard-pprint-dispatch*)
(defvar *initial-pprint-dispatch*)
(defstruct (pprint-dispatch-entry
@ -1081,6 +1082,8 @@
(defstruct (pprint-dispatch-table
(:print-function %print-pprint-dispatch-table))
;; Are we allowed to modify this table?
(read-only-p nil)
;;
;; A list of all the entries (except for CONS entries below) in highest
;; to lowest priority.
@ -1165,6 +1168,10 @@
(type real priority)
(type pprint-dispatch-table table)
#.+ecl-safe-declarations+)
(when (pprint-dispatch-table-read-only-p table)
(cerror "Ignore and continue"
"Tried to modified a read-only pprint dispatch table: ~A"
table))
;; FIXME! This check should be automatically generated when compiling
;; with high enough safety mode.
(unless (typep priority 'real)
@ -1596,8 +1603,10 @@
(symbol-function (second magic-form))))
(setf *initial-pprint-dispatch* *print-pprint-dispatch*)
)
(setf *print-pprint-dispatch* (copy-pprint-dispatch nil))
(setf (first (cdr si::+io-syntax-progv-list+)) *initial-pprint-dispatch*)
(setf (first (cdr si::+ecl-syntax-progv-list+)) *initial-pprint-dispatch*)
(setf *print-pprint-dispatch* (copy-pprint-dispatch nil)
*standard-pprint-dispatch* *initial-pprint-dispatch*)
(setf (pprint-dispatch-table-read-only-p *standard-pprint-dispatch*) t)
(setf (first (cdr si::+io-syntax-progv-list+)) *standard-pprint-dispatch*)
(setf (first (cdr si::+ecl-syntax-progv-list+)) *standard-pprint-dispatch*)
#-ecl-min
(setf *print-pretty* t))