Changeset 8667


Ignore:
Timestamp:
Mar 6, 2008, 3:04:15 AM (11 years ago)
Author:
greg
Message:

Added restarts for various commonly-interactive cases as described here: http://blog.technomadic.org/index.php?p=121

in particular:

  • no class found
  • no method found
  • no slot found
  • slot unbound
  • defgeneric incompatible with existing methods
Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos-boot.lisp

    r8533 r8667  
    12321232                (return class)))))
    12331233        (when (or errorp (not (symbolp name)))
    1234           (error "Class named ~S not found." name)))))
     1234          (cerror "Try finding the class again"
     1235                  "Class named ~S not found." name)
     1236          (find-class name errorp environment)))))
    12351237
    12361238(defun set-find-class (name class)
     
    23532355                        method-qualifiers specializers &optional (errorp t))
    23542356  (dolist (m (%gf-methods generic-function)
    2355            (if errorp
    2356              (error "~s has no method for ~s ~s"
    2357                     generic-function method-qualifiers specializers)))
     2357           (when errorp
     2358             (cerror "Try finding the method again"
     2359                     "~s has no method for ~s ~s"
     2360                     generic-function method-qualifiers specializers)
     2361             (find-method generic-function method-qualifiers specializers
     2362                          errorp)))
    23582363    (flet ((err ()
    23592364             (error "Wrong number of specializers: ~s" specializers)))
     
    26022607           (slotd (find-slotd slot-name (%class-slots class))))
    26032608      (if slotd
    2604         (slot-value-using-class class instance slotd)
    2605         (values (slot-missing class instance slot-name 'slot-value)))))
     2609       (slot-value-using-class class instance slotd)
     2610       (restart-case
     2611           (values (slot-missing class instance slot-name 'slot-value))
     2612         (continue ()
     2613           :report "Try accessing the slot again"
     2614           (slot-value instance slot-name))
     2615         (use-value (value)
     2616           :report "Return a value"
     2617           :interactive (lambda ()
     2618                          (format *query-io* "~&Value to use: ")
     2619                          (list (read *query-io*)))
     2620           value)))))
    26062621   
    26072622
     
    26092624(defmethod slot-unbound (class instance slot-name)
    26102625  (declare (ignore class))
    2611   (error 'unbound-slot :name slot-name :instance instance))
     2626  (restart-case (error 'unbound-slot :name slot-name :instance instance)
     2627    (use-value (value)
     2628      :report "Return a value"
     2629      :interactive (lambda ()
     2630                     (format *query-io* "~&Value to use: ")
     2631                     (list (read *query-io*)))
     2632      value)))
    26122633
    26132634
     
    32833304
    32843305(defmethod no-applicable-method (gf &rest args)
    3285   (error "No applicable method for args:~% ~s~% to ~s" args gf))
     3306  (cerror "Try calling it again"
     3307          "No applicable method for args:~% ~s~% to ~s" args gf)
     3308  (apply #'no-applicable-method gf args))
    32863309
    32873310
  • trunk/source/level-1/l1-dcode.lisp

    r7848 r8667  
    124124                               (logbitp $lfbits-rest-bit newbits)
    125125                               (logbitp $lfbits-restv-bit newbits))))
    126             (error "New lambda list ~s of generic function ~s is not
    127 congruent with lambda lists of existing methods." lambda-list gf)))
     126            (cerror (format nil
     127                            "Remove ~d method~:p from the generic-function and ~
     128                             change its lambda list."
     129                            (length (%gf-methods gf)))
     130                    "New lambda list of generic function ~s is not congruent ~
     131                     with lambda lists of existing methods.~%~
     132                     Generic-function's   : ~s~%~
     133                     Method's lambda-list : ~s~%"
     134                    gf lambda-list (%method-lambda-list (car methods)))
     135            (loop
     136               (let ((methods (%gf-methods gf)))
     137                 (if methods
     138                     (remove-method gf (car methods))
     139                     (return))))
     140            (%set-defgeneric-keys gf nil)))
    128141        (when lambda-list-p
    129142          (setf (%gf-%lambda-list gf) lambda-list
Note: See TracChangeset for help on using the changeset viewer.