Changeset 7126


Ignore:
Timestamp:
Aug 31, 2007, 1:20:12 AM (13 years ago)
Author:
gz
Message:

Add a restart for unbound variable/undefined function errors -- if there is a unique bound/fbound symbol of the same name in another package, offer to use it instead.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-error-system.lisp

    r6937 r7126  
    634634;; Some simple restarts for simple error conditions.  Callable from the kernel.
    635635
     636(defun find-unique-homonym (name &optional test)
     637  (let ((pname (and name (symbolp name) (symbol-name name)))
     638        (other-name nil))
     639    (dolist (pkg (list-all-packages) other-name)
     640      (let ((candidate (find-symbol pname pkg)))
     641        (when (and candidate
     642                   (not (eq candidate name))
     643                   (or (null test) (funcall test candidate)))
     644          (when (and other-name (neq other-name candidate))
     645            (return nil)) ;; more than one, too complicated, give up
     646          (setq other-name candidate))))))
    636647
    637648
     
    639650  (unless *level-1-loaded*
    640651    (dbg cell-name))       ;  user should never see this.
    641   (let ((condition (make-condition 'unbound-variable :name cell-name)))
     652  (let ((condition (make-condition 'unbound-variable :name cell-name))
     653        (other-variable (find-unique-homonym cell-name #'boundp)))
    642654    (flet ((new-value ()
    643655             (catch-cancel
     
    651663                  :report (lambda (s) (format s "Retry getting the value of ~S." cell-name))
    652664                  (symbol-value cell-name))
     665        (use-homonym ()
     666                     :test (lambda (c) (and (or (null c) (eq c condition)) other-variable))
     667                     :report (lambda (s) (format s "Use the value of ~s this time." other-variable))
     668                     (symbol-value other-variable))
    653669        (use-value (value)
    654670                   :interactive new-value
     
    881897  (let ((condition (make-condition 'undefined-function-call
    882898                                   :name function-name
    883                                    :function-arguments args)))
     899                                   :function-arguments args))
     900        (other-function (find-unique-homonym function-name #'fboundp)))
    884901    (restart-case (%error condition nil frame-ptr)
    885902      (continue ()
    886903                :report (lambda (s) (format s "Retry applying ~S to ~S." function-name args))
    887904                (apply function-name args))
     905      (use-homonym ()
     906                   :test (lambda (c) (and (or (null c) (eq c condition)) other-function))
     907                   :report (lambda (s) (format s "Apply ~s to ~S this time." other-function args))
     908                   (apply other-function args))
    888909      (use-value (function)
    889910                 :interactive (lambda ()
Note: See TracChangeset for help on using the changeset viewer.