From fa8a63394b06f2c093d780fd4cc1480783898a69 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Sun, 11 Feb 2018 11:45:26 +0300
Subject: [PATCH] Better undefined fun error during macroexpansion.

Report if the function is defined in the same file but is not
available at macroexpansion time or is a local function.
---
 src/code/condition.lisp | 15 ++++++++++++---
 src/code/interr.lisp    | 45 ++++++++++++++++++++++++++++-----------------
 2 files changed, 40 insertions(+), 20 deletions(-)

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index d70ec441e..24cc3b818 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -608,13 +608,22 @@
 (define-condition retry-unbound-variable
     (simple-condition unbound-variable) ())
 
-(define-condition undefined-function (cell-error) ()
+(define-condition undefined-function (cell-error)
+  ((not-yet-loaded :initform nil :reader not-yet-loaded :initarg :not-yet-loaded))
   (:report
    (lambda (condition stream)
      (let ((*package* (find-package :keyword)))
        (format stream
-               "The function ~S is undefined."
-               (cell-error-name condition))))))
+               "~@<The function ~S is undefined.~@?~@:>"
+               (cell-error-name condition)
+               (case (not-yet-loaded condition)
+                 (:local
+                  "~:@_It is a local function ~
+                       not available at compile-time.")
+                 ((t) "~:@_It is defined earlier in the ~
+                           file but is not available at compile-time.")
+                 (t
+                  "")))))))
 
 (define-condition retry-undefined-function
     (simple-condition undefined-function) ())
diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 6242dfafc..ad5b2746a 100644
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -45,7 +45,7 @@
 (defvar *current-internal-error-args*)
 
 #!+undefined-fun-restarts
-(defun restart-undefined (name fdefn-or-symbol context)
+(defun restart-undefined (name condition fdefn-or-symbol context)
   (multiple-value-bind (tn-offset pc-offset)
       (if context
           (sb!c::decode-restart-location context)
@@ -127,28 +127,39 @@
                                        (declare (ignore args))
                                        (values))
                                      retrying)))))))
-      (try (make-condition 'undefined-function :name name)))))
+      (try condition))))
 
 (deferr undefined-fun-error (fdefn-or-symbol)
-  (let ((name (etypecase fdefn-or-symbol
-                (symbol fdefn-or-symbol)
-                (fdefn (let ((name (fdefn-name fdefn-or-symbol)))
-                         ;; fasteval stores weird things in the NAME slot
-                         ;; of fdefns of special forms. Have to grab the
-                         ;; special form name out of that.
-                         (cond #!+(and sb-fasteval immobile-code)
-                               ((and (listp name) (functionp (car name)))
-                                (cadr (%fun-name (car name))))
-                               (t
-                                name))))))
-        #!+undefined-fun-restarts
-        context)
+  (let* ((name (etypecase fdefn-or-symbol
+                 (symbol fdefn-or-symbol)
+                 (fdefn (let ((name (fdefn-name fdefn-or-symbol)))
+                          ;; fasteval stores weird things in the NAME slot
+                          ;; of fdefns of special forms. Have to grab the
+                          ;; special form name out of that.
+                          (cond #!+(and sb-fasteval immobile-code)
+                                ((and (listp name) (functionp (car name)))
+                                 (cadr (%fun-name (car name))))
+                                (t
+                                 name))))))
+         (condition
+           (make-condition 'undefined-function
+                           :name name
+                           :not-yet-loaded
+                           (cond ((member name sb!c::*fun-names-in-this-file*
+                                          :test #'equal)
+                                  t)
+                                 ((and (boundp 'sb!c:*lexenv*)
+                                       (sb!c::fun-locally-defined-p
+                                        name sb!c:*lexenv*))
+                                  :local))))
+         #!+undefined-fun-restarts
+         context)
     (cond #!+undefined-fun-restarts
           ((or (= *current-internal-trap-number* sb!vm:cerror-trap)
                (integerp (setf context (sb!di:error-context))))
-           (restart-undefined name fdefn-or-symbol context))
+           (restart-undefined name condition fdefn-or-symbol context))
           (t
-           (error 'undefined-function :name name)))))
+           (error condition)))))
 
 #!+(or arm arm64 x86-64)
 (deferr undefined-alien-fun-error (address)
-- 
2.11.4.GIT