From edb7390a0f7a79712551fd1afc81ccffa82eb46b Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Tue, 19 Aug 2008 23:57:36 +0200 Subject: [PATCH] Implemented compiler conditions --- src/CHANGELOG | 5 + src/cmp/cmpdefs.lsp | 7 +- src/cmp/cmpenv.lsp | 56 ++++++----- src/cmp/cmplet.lsp | 2 +- src/cmp/cmpmain.lsp | 219 ++++++++++++++++++++------------------------ src/cmp/cmpopt.lsp | 4 +- src/cmp/cmputil.lsp | 142 ++++++++++++++++++---------- src/cmp/cmpwt.lsp | 2 +- 8 files changed, 233 insertions(+), 204 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 76acb7cbb..b92953e0d 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -1,6 +1,11 @@ ECL 0.9l-p1: ============ +* Visible changes: + + - The compiler now signals compiler-error, compiler-warning and compiler-note + for errors, warnings and notes, respectively. + * Bugs fixed: - The optimizer for COERCE might enter an infinite loop for certain diff --git a/src/cmp/cmpdefs.lsp b/src/cmp/cmpdefs.lsp index 92c427252..6a71fe18a 100644 --- a/src/cmp/cmpdefs.lsp +++ b/src/cmp/cmpdefs.lsp @@ -247,11 +247,14 @@ ;;; Variables and constants for error handling ;;; (defvar *current-form* '|compiler preprocess|) +(defvar *compile-file-position* nil) (defvar *first-error* t) -(defvar *error-count* 0) (defvar *error-p* nil) (defconstant *cmperr-tag* (cons nil nil)) +(defvar *compiler-conditions* '() + "This variable determines whether conditions are printed or just accumulated.") + (defvar *compile-print* t "This variable controls whether the compiler displays messages about each form it processes. The default value is NIL.") @@ -324,6 +327,8 @@ The default value is NIL.") (defvar *next-cmacro* 0) ; holds the last cmacro number used. (defvar *next-cfun* 0) ; holds the last cfun used. +(defvar *max-stack* 0) ; maximum space used in lisp stack + ;;; ;;; *tail-recursion-info* holds NIL, if tail recursion is impossible. ;;; If possible, *tail-recursion-info* holds diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp index b5cc935c5..eeafca6ba 100644 --- a/src/cmp/cmpenv.lsp +++ b/src/cmp/cmpenv.lsp @@ -18,35 +18,33 @@ ;;; If (safe-compile) is ON, some kind of run-time checks are not ;;; included in the compiled code. The default value is OFF. -(defun init-env () - (setq *compiler-phase* 't1) - (setq *callbacks* nil) - (setq *max-stack* 0) - (setq *max-temp* 0) - (setq *temp* 0) - (setq *next-cmacro* 0) - (setq *next-cfun* 0) - (setq *last-label* 0) - (setq *load-objects* (make-hash-table :size 128 :test #'equal)) - (setq *make-forms* nil) - (setq *permanent-objects* nil) - (setq *temporary-objects* nil) - (setq *local-funs* nil) - (setq *global-var-objects* nil) - (setq *global-vars* nil) - (setq *global-funs* nil) - (setq *linking-calls* nil) - (setq *global-entries* nil) - (setq *undefined-vars* nil) - (setq *reservations* nil) - (setq *top-level-forms* nil) - (setq *compile-time-too* nil) - (setq *clines-string-list* '()) - (setq *function-declarations* nil) - (setq *inline-functions* nil) - (setq *inline-blocks* 0) - (setq *notinline* nil) - ) +(defconstant +init-env-form+ + '((*compiler-phase* 't1) + (*callbacks* nil) + (*max-stack* 0) + (*max-temp* 0) + (*temp* 0) + (*next-cmacro* 0) + (*next-cfun* 0) + (*last-label* 0) + (*load-objects* (make-hash-table :size 128 :test #'equal)) + (*make-forms* nil) + (*permanent-objects* nil) + (*temporary-objects* nil) + (*local-funs* nil) + (*global-var-objects* nil) + (*global-vars* nil) + (*global-funs* nil) + (*linking-calls* nil) + (*global-entries* nil) + (*undefined-vars* nil) + (*reservations* nil) + (*top-level-forms* nil) + (*compile-time-too* nil) + (*clines-string-list* '()) + (*inline-functions* nil) + (*inline-blocks* 0) + (*notinline* nil))) (defun next-lcl () (list 'LCL (incf *lcl*))) diff --git a/src/cmp/cmplet.lsp b/src/cmp/cmplet.lsp index 4c3e5bf8c..7314f7cb3 100644 --- a/src/cmp/cmplet.lsp +++ b/src/cmp/cmplet.lsp @@ -297,7 +297,7 @@ :args used-vars (nreverse used-forms) body)) (let* ((var (first vs)) (form (and-form-type (var-type var) (car fs) (cadar args) - :unsafe "~&;;; In LET* body")) + :unsafe "In LET* body")) (form-type (c1form-primary-type form)) (rest-forms (cons body (rest fs)))) ;; Automatic treatement for READ-ONLY variables: diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index 142a27573..7b5af0964 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -60,7 +60,7 @@ (defun cmp-delete-file (file) (cond ((null *delete-files*)) (*debug-compiler* - (format t "~%Postponing deletion of ~A" file) + (cmpprogress "~%Postponing deletion of ~A" file) (push file *files-to-be-deleted*)) (t (delete-file file)))) @@ -471,7 +471,6 @@ static cl_object VV[VM]; (*compiler-in-use* *compiler-in-use*) (*package* *package*) (*print-pretty* nil) - (*error-count* 0) (*compile-file-pathname* nil) (*compile-file-truename* nil) (*compile-verbose* verbose) @@ -515,9 +514,7 @@ Cannot compile ~a." (setq *error-p* nil *compiler-in-use* t) - (when *compile-verbose* - (format t "~&;;; Compiling ~a." - (namestring input-pathname))) + (cmpprogress "~&;;; Compiling ~a." (namestring input-pathname)) (let* ((eof '(NIL)) (*load-time-values* nil) ;; Load time values are compiled @@ -532,8 +529,9 @@ Cannot compile ~a." (shared-data-pathname (get-output-pathname o-pathname shared-data-file :sdata))) - (with-lock (+load-compile-lock+) - (init-env) + (with-compiler-env (*error-p*) + + (print-compiler-info) (when (probe-file "./cmpinit.lsp") (load "./cmpinit.lsp" :verbose *compile-verbose*)) @@ -548,13 +546,14 @@ Cannot compile ~a." (with-open-file (*compiler-input* *compile-file-pathname*) (do ((ext:*source-location* (cons *compile-file-pathname* 0)) (form (read *compiler-input* nil eof) - (read *compiler-input* nil eof))) + (read *compiler-input* nil eof)) + (*compile-file-position* 0 (1+ *compile-file-position*))) ((eq form eof)) (t1expr form) (incf (cdr ext:*source-location*)))) - (when (zerop *error-count*) - (when *compile-verbose* (format t "~&;;; End of Pass 1. ")) + (unless *error-p* + (cmpprogress "~&;;; End of Pass 1.") (setf init-name (guess-init-name output-file :kind (if system-p :object :fasl))) (compiler-pass2 c-pathname h-pathname data-pathname system-p @@ -565,58 +564,50 @@ Cannot compile ~a." (data-dump shared-data-pathname t) (data-dump data-pathname)) - (init-env) - );; with-lock - - (if (zerop *error-count*) - (progn - (cond (output-file - (when *compile-verbose* - (format t "~&;;; Calling the C compiler... ")) - (compiler-cc c-pathname o-pathname) - #+dlopen - (unless system-p (bundle-cc (si::coerce-to-filename so-pathname) - init-name - (si::coerce-to-filename o-pathname))) - (cond #+dlopen - ((and (not system-p) (probe-file so-pathname)) - (when load (load so-pathname)) - (when *compile-verbose* - (print-compiler-info) - (format t "~&;;; Finished compiling ~a.~%" - (namestring input-pathname)))) - ((and system-p (probe-file o-pathname)) - (when *compile-verbose* - (print-compiler-info) - (format t "~&;;; Finished compiling ~a.~%" - (namestring input-pathname)))) - (t (format t "~&;;; The C compiler failed to compile the intermediate file.~%") - (setq *error-p* t)))) - (*compile-verbose* - (print-compiler-info) - (format t "~&;;; Finished compiling ~a.~%" - (namestring input-pathname)))) - (unless c-file (cmp-delete-file c-pathname)) - (unless h-file (cmp-delete-file h-pathname)) - (unless (or data-file shared-data-file) - (cmp-delete-file data-pathname)) - #+dlopen - (unless system-p (cmp-delete-file o-pathname)) - (values (truename #+dlopen (if system-p o-pathname so-pathname) - #-dlopen o-pathname) - nil nil)) - (progn - (when (probe-file c-pathname) (cmp-delete-file c-pathname)) - (when (probe-file h-pathname) (cmp-delete-file h-pathname)) - (when (probe-file data-pathname) (cmp-delete-file data-pathname)) - (when (probe-file shared-data-pathname) (cmp-delete-file shared-data-pathname)) - (when (probe-file o-pathname) (cmp-delete-file o-pathname)) - (format t "~&;;; Due to errors in the compilation process, no FASL was generated. + (if (null *error-p*) + (progn + (cond (output-file + (compiler-cc c-pathname o-pathname) + #+dlopen + (unless system-p (bundle-cc (si::coerce-to-filename so-pathname) + init-name + (si::coerce-to-filename o-pathname))) + (cond #+dlopen + ((and (not system-p) (probe-file so-pathname)) + (when load (load so-pathname)) + (cmpprogress "~&;;; Finished compiling ~a.~%" + (namestring input-pathname))) + ((and system-p (probe-file o-pathname)) + (cmpprogress "~&;;; Finished compiling ~a.~%" + (namestring input-pathname))) + (t + (cmpprogress "~&;;; The C compiler failed to compile the intermediate file.~%") + (setq *error-p* t)))) + (*compile-verbose* + (cmpprogress "~&;;; Finished compiling ~a.~%" + (namestring input-pathname)))) + (unless c-file (cmp-delete-file c-pathname)) + (unless h-file (cmp-delete-file h-pathname)) + (unless (or data-file shared-data-file) + (cmp-delete-file data-pathname)) + #+dlopen + (unless system-p (cmp-delete-file o-pathname)) + (values (truename #+dlopen (if system-p o-pathname so-pathname) + #-dlopen o-pathname) + nil nil)) + (progn + (when (probe-file c-pathname) (cmp-delete-file c-pathname)) + (when (probe-file h-pathname) (cmp-delete-file h-pathname)) + (when (probe-file data-pathname) (cmp-delete-file data-pathname)) + (when (probe-file shared-data-pathname) (cmp-delete-file shared-data-pathname)) + (when (probe-file o-pathname) (cmp-delete-file o-pathname)) + (cmpprogress "~&;;; Due to errors in the compilation process, no FASL was generated. ;;; Search above for the \"Error:\" tag to find the error messages.~%") - (setq *error-p* t) - (values nil t t)) - )) - ) + (setq *error-p* t) + (values nil t t)) + )) + ) +) #-dlopen (defun compile (name &optional (def nil supplied-p)) @@ -639,8 +630,7 @@ Cannot compile ~a." (*package* *package*) (*compile-print* nil) (*print-pretty* nil) - (*compiler-constants* t) - (*error-count* 0)) + (*compiler-constants* t)) (unless (symbolp name) (error "~s is not a symbol." name)) @@ -688,55 +678,49 @@ Cannot compile ~a." (so-pathname (compile-file-pathname data-pathname)) (init-name (guess-init-name so-pathname :kind :fasl))) - (with-lock (+load-compile-lock+) - (init-env) + (with-compiler-env (*error-p*) + (print-compiler-info) (data-init) (t1expr form) - (when (zerop *error-count*) - (when *compile-verbose* (format t "~&;;; End of Pass 1. ")) + (unless *error-p* + (cmpprogress "~&;;; End of Pass 1.") (let (#+(or mingw32 msvc cygwin)(*self-destructing-fasl* t)) (compiler-pass2 c-pathname h-pathname data-pathname nil init-name nil))) (setf *compiler-constants* (data-dump data-pathname)) - (init-env) - ) - (if (zerop *error-count*) - (progn - (when *compile-verbose* - (format t "~&;;; Calling the C compiler... ")) - (compiler-cc c-pathname o-pathname) - (bundle-cc (si::coerce-to-filename so-pathname) - init-name - (si::coerce-to-filename o-pathname)) - (cmp-delete-file c-pathname) - (cmp-delete-file h-pathname) - (cmp-delete-file o-pathname) - (cmp-delete-file data-pathname) - (cond ((probe-file so-pathname) - (load so-pathname :verbose nil) - #-(or mingw32 msvc cygwin)(cmp-delete-file so-pathname) - #+msvc (delete-msvc-generated-files so-pathname) - (when *compile-verbose* (print-compiler-info)) - (setf name (or name (symbol-value 'GAZONK))) - ;; By unsetting GAZONK we avoid spurious references to the - ;; loaded code. - (set 'GAZONK nil) - (si::gc t) - (values name nil nil)) - (t (format t "~&;;; The C compiler failed to compile~ - ~the intermediate code for ~s.~%" name) - (setq *error-p* t) - (values name t t)))) - (progn - (when (probe-file c-pathname) (cmp-delete-file c-pathname)) - (when (probe-file h-pathname) (cmp-delete-file h-pathname)) - (when (probe-file so-pathname) (cmp-delete-file so-pathname)) - (when (probe-file data-pathname) (cmp-delete-file data-pathname)) - #+msvc (delete-msvc-generated-files so-pathname) - (format t "~&;;; Failed to compile ~s.~%" name) - (setq *error-p* t) - (values name t t))))) + (if (null *error-p*) + (progn + (compiler-cc c-pathname o-pathname) + (bundle-cc (si::coerce-to-filename so-pathname) + init-name + (si::coerce-to-filename o-pathname)) + (cmp-delete-file c-pathname) + (cmp-delete-file h-pathname) + (cmp-delete-file o-pathname) + (cmp-delete-file data-pathname) + (cond ((probe-file so-pathname) + (load so-pathname :verbose nil) + #-(or mingw32 msvc cygwin)(cmp-delete-file so-pathname) + #+msvc (delete-msvc-generated-files so-pathname) + (setf name (or name (symbol-value 'GAZONK))) + ;; By unsetting GAZONK we avoid spurious references to the + ;; loaded code. + (set 'GAZONK nil) + (si::gc t) + (values name nil nil)) + (t (cmpprogress "~&;;; The C compiler failed to compile the intermediate code for ~s.~%" name) + (setq *error-p* t) + (values name t t)))) + (progn + (when (probe-file c-pathname) (cmp-delete-file c-pathname)) + (when (probe-file h-pathname) (cmp-delete-file h-pathname)) + (when (probe-file so-pathname) (cmp-delete-file so-pathname)) + (when (probe-file data-pathname) (cmp-delete-file data-pathname)) + #+msvc (delete-msvc-generated-files so-pathname) + (cmpprogress "~&;;; Failed to compile ~s.~%" name) + (setq *error-p* t) + (values name t t)))))) (defun disassemble (thing &key (h-file nil) (data-file nil) &aux def disassembled-form @@ -766,8 +750,7 @@ Cannot compile ~a." :format-control "DISASSEMBLE cannot accept ~A" :format-arguments (list thing)))) (when *compiler-in-use* - (format t "~&;;; The compiler was called recursively.~ - ~%Cannot disassemble ~a." thing) + (cmpprogress "~&;;; The compiler was called recursively.~%Cannot disassemble ~a." thing) (setq *error-p* t) (return-from disassemble nil)) (setq *error-p* nil @@ -778,27 +761,21 @@ Cannot compile ~a." (*compiler-output2* (if h-file (open h-file :direction :output) null-stream)) - (*error-count* 0) (t3local-fun (symbol-function 'T3LOCAL-FUN))) - (with-lock (+load-compile-lock+) + (with-compiler-env (*error-p*) (unwind-protect (progn (setf (symbol-function 'T3LOCAL-FUN) #'(lambda (&rest args) (let ((*compiler-output1* *standard-output*)) (apply t3local-fun args)))) - (init-env) (data-init) (t1expr disassembled-form) - (if (zerop *error-count*) - (catch *cmperr-tag* - (ctop-write (guess-init-name "foo" :kind :fasl) - (if h-file h-file "") - (if data-file data-file ""))) - (setq *error-p* t)) - (data-dump data-file) - (init-env) - ) + (unless *error-p* + (ctop-write (guess-init-name "foo" :kind :fasl) + (if h-file h-file "") + (if data-file data-file ""))) + (data-dump data-file)) (setf (symbol-function 'T3LOCAL-FUN) t3local-fun) (when h-file (close *compiler-output2*))))) nil @@ -856,8 +833,8 @@ Cannot compile ~a." )) (defun print-compiler-info () - (format t "~&;;; OPTIMIZE levels: Safety=~d, Space=~d, Speed=~d, Debug=~d~%" - *safety* *space* *speed* *debug*)) + (cmpprogress "~&;;; OPTIMIZE levels: Safety=~d, Space=~d, Speed=~d, Debug=~d~%" + *safety* *space* *speed* *debug*)) (defmacro with-compilation-unit (options &rest body) `(progn ,@body)) diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp index 60f4ff3c5..3645fe249 100644 --- a/src/cmp/cmpopt.lsp +++ b/src/cmp/cmpopt.lsp @@ -189,7 +189,7 @@ ;;; form. ;;; (defparameter +coercion-table+ - '((integer . (check-type x 'integer)) + '((integer . (let ((y x)) (check-type y integer) x)) (float . (float x)) (short-float . (float x 0.0s0)) (single-float . (float x 0.0f0)) @@ -305,5 +305,3 @@ (define-compiler-macro coerce (&whole form value type &environment env) (expand-coerce form value type env)) - -(trace c::expand-coerce) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 69eb5a852..31c351197 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -14,6 +14,61 @@ (in-package "COMPILER") +(define-condition compiler-message (condition) + ((file :initarg :file :initform *compile-file-pathname* + :accessor compiler-message-file) + (position :initarg :file :initform *compile-file-position* + :accessor compiler-message-file-position) + (form :initarg :form :initform *current-form* :accessor compiler-message-form))) + +(define-condition compiler-note (compiler-message simple-condition warning) ()) + +(define-condition compiler-warning (compiler-message simple-condition style-warning) ()) + +(define-condition compiler-error (compiler-message simple-error) ()) + +(define-condition compiler-fatal-error (compiler-error) ()) + +(define-condition compiler-internal-error (compiler-fatal-error) ()) + +(define-condition compiler-undefined-variable (compiler-message warning) + ((variable :initarg :name :initform nil)) + (:report + (lambda (condition stream) + (format stream "Variable ~A was undefined. Compiler assumes it is a global." + (slot-value condition 'variable))))) + +(defun handle-fatal-error (c) + (push c *compiler-conditions*) + (abort)) + +(defun handle-note (c) + (when *suppress-compiler-notes* + (muffle-warning c))) + +(defun handle-warning (c) + (push c *compiler-conditions*) + (when *suppress-compiler-warnings* + (muffle-warning c))) + +(defun handle-error (c) + (push c *compiler-conditions*) + (format t "~&~@<;;; ~@;Error:~%~A~:>" c) + (invoke-restart (find-restart-never-fail 'abort-form c))) + +(defmacro with-compiler-env ((error-flag) &body body) + `(with-lock (+load-compile-lock+) + (restart-case + (handler-bind ((compiler-note #'handle-note) + (compiler-warning #'handle-warning) + (compiler-error #'handle-error) + (compiler-fatal-error #'handle-fatal-error)) + (let ,+init-env-form+ + (setf ,error-flag nil) + ,@body)) + (abort (c) (setf ,error-flag t)) + (abort-form (c) (setf ,error-flag t))))) + (defvar *c1form-level* 0) (defun print-c1forms (form) (cond ((consp form) @@ -34,12 +89,14 @@ (defun print-var (var-object stream) (format stream "#" (var-name var-object) (var-kind var-object))) -(defun cmperr (string &rest args &aux (*print-case* :upcase)) - (print-current-form) - (format t "~&;;; Error: ") - (apply #'format t string args) - (incf *error-count*) - (throw *cmperr-tag* '*cmperr-tag*)) +(defun cmpprogress (&rest args) + (when *compile-verbose* + (apply #'format t args))) + +(defun cmperr (string &rest args) + (signal 'compiler-error + :format-control string + :format-arguments args)) (defun check-args-number (operator args &optional (min 0) (max nil)) (let ((l (length args))) @@ -49,41 +106,35 @@ (too-many-args operator max l)))) (defun too-many-args (name upper-bound n &aux (*print-case* :upcase)) - (print-current-form) - (format t - "~&;;; ~S requires at most ~R argument~:p, ~ - but ~R ~:*~[were~;was~:;were~] supplied.~%" + (cmperr "~S requires at most ~R argument~:p, but ~R ~:*~[were~;was~:;were~] supplied.~%" name upper-bound - n) - (incf *error-count*) - (throw *cmperr-tag* '*cmperr-tag*)) + n)) -(defun too-few-args (name lower-bound n &aux (*print-case* :upcase)) - (print-current-form) - (format t - "~&;;; ~S requires at least ~R argument~:p, ~ - but only ~R ~:*~[were~;was~:;were~] supplied.~%" +(defun too-few-args (name lower-bound n) + (cmperr "~S requires at least ~R argument~:p, but only ~R ~:*~[were~;was~:;were~] supplied.~%" name lower-bound - n) - (incf *error-count*) - (throw *cmperr-tag* '*cmperr-tag*)) + n)) -(defun cmpwarn (string &rest args &aux (*print-case* :upcase)) - (unless *suppress-compiler-warnings* - (print-current-form) - (format t "~&;;; Warning: ") - (apply #'format t string args) - (terpri)) - nil) +(defun warn-or-note (message &rest args) + (declare (si::c-local)) + (let ((condition (apply #'make-condition args))) + (restart-case (signal condition) + (muffle-warning () + :REPORT "Skip warning" + (return-from warn-or-note nil))) + (format *error-output* "~&;;; ~A: ~A~%" message condition))) -(defun cmpnote (string &rest args &aux (*print-case* :upcase)) - (unless *suppress-compiler-notes* - (format t "~&;;; Note: ") - (apply #'format t string args) - (terpri)) - nil) +(defun cmpwarn (string &rest args) + (warn-or-note "Warning" 'compiler-warning + :format-control string + :format-arguments args)) + +(defun cmpnote (string &rest args) + (warn-or-note "Note" 'compiler-note + :format-control string + :format-arguments args)) (defun print-current-form () (unless *suppress-compiler-notes* @@ -99,19 +150,14 @@ (when (and name (not *suppress-compiler-notes*)) (format t "~&;;; Emitting code for ~s.~%" name)))) -(defun undefined-variable (sym &aux (*print-case* :upcase)) - (print-current-form) - (format t - "~&;;; The variable ~s is undefined.~ - ~%;;; The compiler will assume this variable is a global.~%" - sym) - nil) - +(defun undefined-variable (sym) + (signal 'compiler-undefined-variable :name sym)) + (defun baboon (&aux (*print-case* :upcase)) - (print-current-form) - (incf *error-count*) - (error "~&;;; A bug was found in the compiler. Contact jjgarcia@users.sourceforge.net.~%")) - + (signal 'compiler-internal-error + :format-control "A bug was found in the compiler. Contact jjgarcia@users.sourceforge.net" + :format-arguments nil)) + (defmacro with-cmp-protection (main-form error-form) `(let* ((si::*break-enable* *compiler-break-enable*) (throw-flag t)) @@ -125,12 +171,12 @@ (cmperr "~&;;; The form ~s was not evaluated successfully.~ ~%;;; You are recommended to compile again.~%" form))) - + (defun cmp-macroexpand (form &optional (env *cmp-env*)) (with-cmp-protection (macroexpand form env) (cmperr "~&;;; The macro form ~S was not expanded successfully.~ ~%;;; You are recommended to compile again.~%" form))) - + (defun cmp-expand-macro (fd form &optional (env *cmp-env*)) (with-cmp-protection (let ((new-form (funcall *macroexpand-hook* fd form env))) diff --git a/src/cmp/cmpwt.lsp b/src/cmp/cmpwt.lsp index 41bbb99b9..5b1e3478f 100644 --- a/src/cmp/cmpwt.lsp +++ b/src/cmp/cmpwt.lsp @@ -250,7 +250,7 @@ :test #'(lambda (k record) (eq k (first record)))))) (if x (progn - (cmpnote "Reusing keywords lists for ~S" keywords) + (cmpnote "~@" keywords) (second (elt *permanent-objects* x))) (prog1 (add-object (pop keywords) :duplicate t :permanent t)