In compiler messages, print the actual toplevel form, not the macroexpanded version

src/CHANGELOG

@@ -31,6 +31,8 @@ ECL 10.2.1:
  - The compiler now understands function type proclamations with &optional
    values.
 
+ - The compiler now uses THE forms with a VALUES type.
+
 * Visible changes:
 
  - Significant speedup in access to hash tables of up to 30% by writing
@@ -66,6 +68,13 @@ ECL 10.2.1:
    branch annotation (__builtin_expect) to decrease the size of code that
    checks for errors and improve overall speed.
 
+ - When printing compiler notes, instead of printing the macroexpanded form,
+   ECL now prints the toplevel form, as follows
+    ;;; Warning: in file src:lsp;autoload.lsp.NEWEST, position 1178 and top form
+    ;;;   (DEFMACRO WITH-COMPILATION-UNIT (OPTIONS &REST BODY) ...)
+    ;;; The variable OPTIONS is not used.
+
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***

src/cmp/cmpdefs.lsp

@@ -268,6 +268,7 @@
 ;;; Variables and constants for error handling
 ;;;
 (defvar *current-form* '|compiler preprocess|)
+(defvar *current-toplevel-form* '|compiler preprocess|)
 (defvar *current-c2form* nil)
 (defvar *compile-file-position* -1)
 (defvar *first-error* t)

src/cmp/cmpeval.lsp

@@ -112,8 +112,9 @@
                            ))))))
 
 (defun c2expr (form)
-  (let* ((*file* (c1form-file form))
-         (*file-position* (c1form-file form))
+  (let* ((*compile-file-truename* (c1form-file form))
+         (*compile-file-position* (c1form-file-position form))
+         (*current-toplevel-form* (c1form-toplevel-form form))
          (*current-form* (c1form-form form))
          (*current-c2form* form)
          (name (c1form-name form))

src/cmp/cmpmac.lsp

@@ -79,6 +79,7 @@
   (parent nil)
   (args '())
   (form nil)
+  (toplevel-form nil)
   (file nil)
   (file-position 0))
 
@@ -91,6 +92,7 @@
 			      :sp-change (info-sp-change subform)
 			      :volatile (info-volatile subform)
                               :form *current-form*
+                              :toplevel-form *current-toplevel-form*
                               :file *compile-file-truename*
                               :file-position *compile-file-position*)))
     (c1form-add-info form args)
@@ -112,6 +114,7 @@
 		     l (cdr l))))))
     (let ((form (apply #'do-make-c1form :name name :args form-args
                        :form *current-form*
+                       :toplevel-form *current-toplevel-form*
                        :file *compile-file-truename*
                        :file-position *compile-file-position*
 		       info-args)))

src/cmp/cmptop.lsp

@@ -15,14 +15,17 @@
 (in-package "COMPILER")
 
 (defun t1expr (form)
-  (let ((*cmp-env* (cmp-env-new)))
+  (let* ((*current-toplevel-form* form)
+         (*cmp-env* (cmp-env-new)))
     (push (t1expr* form) *top-level-forms*)))
 
 (defvar *toplevel-forms-to-print*
   '(defun defmacro defvar defparameter defclass defmethod defgeneric))
 
-(defun t1expr* (form &aux (*current-form* form) (*first-error* t)
-		    (*setjmps* 0))
+(defun t1expr* (form &aux
+                     (*current-form* form)
+                     (*first-error* t)
+                     (*setjmps* 0))
   ;(let ((*print-level* 3)) (print form))
   (catch *cmperr-tag*
     (when (consp form)

src/cmp/cmputil.lsp

@@ -20,21 +20,23 @@
 	 :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))
+   (toplevel-form :initarg :form :initform *current-toplevel-form*
+                  :accessor compiler-message-toplevel-form)
+   (form :initarg :form :initform *current-form*
+         :accessor compiler-message-form))
   (:REPORT
    (lambda (c stream)
      (let ((position (compiler-message-file-position c))
            (prefix (compiler-message-prefix c))
            (file (compiler-message-file c))
-           (form (compiler-message-form c)))
+           (form (compiler-message-toplevel-form c)))
        (if (and position
                 (not (minusp position))
                 (not (equalp form '|compiler preprocess|)))
 	   (let* ((*print-length* 3)
                   (*print-level* 2))
-             (unless 
-	     (format stream "~A: in file ~A, position ~D, and form ~%  ~A~%"
-		     prefix file position form)))
+	     (format stream "~A: in file ~A, position ~D and top form~%  ~A~%"
+		     prefix file position form))
 	   (format stream "~A: " prefix))
        (format stream "~?"
 	       (simple-condition-format-control c)