From 20906c6be60359a1646960eb0f9be6bcb0dfed41 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 3 Mar 2013 00:10:09 +0100 Subject: [PATCH] The standard pprint dispatch table in with-standard-io-syntax is now read-only --- src/lsp/pprint.lsp | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/lsp/pprint.lsp b/src/lsp/pprint.lsp index 05bcc60e4..47ee9f88e 100644 --- a/src/lsp/pprint.lsp +++ b/src/lsp/pprint.lsp @@ -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))