Ignore:
Timestamp:
Jul 26, 2009, 1:24:19 PM (10 years ago)
Author:
gz
Message:

Some changes in support of Slime:

Implement CCL:COMPUTE-APPLICABLE-METHODS-USING-CLASSES

Add a :stream-args argument to CCL:ACCEPT-CONNECTION, for one-time initargs for the stream being created. E.g. (accept-connection listener :stream-args `(:external-format ,external-format-for-this-connection-only))

Add CCL:TEMP-PATHNAME

Bind new var CCL:*TOP-ERROR-FRAME* to the error frame in break loops, to make it available to debugger/break hooks.

Add CCL:*SELECT-INTERACTIVE-PROCESS-HOOK* and call it to select the process to use for handling SIGINT.

Add CCL:*MERGE-COMPILER-WARNINGS* to control whether warnings with the same format string and args but different source locations should be merged.

Export CCL:COMPILER-WARNING, CCL:STYLE-WARNING, CCL:COMPILER-WARNING-FUNCTION-NAME and CCL:COMPILER-WARNING-SOURCE-NOTE.

Create a CCL:COMPILER-WARNING-SOURCE-NOTE even if not otherwise saving source locations, just using the fasl file and toplevel stream position, but taking into account compile-file-original-truename and compiler-file-original-buffer-offset. Get rid of stream-position and file-name slots in compiler warnings.

Export CCL:REPORT-COMPILER-WARNING, and make it accept a :SHORT keyword arg to skip the textual representation of the warning location.

Export CCL:NAME-OF, and make it return the fully qualified name for methods, return object for eql-specializer

Make CCL:FIND-DEFINITION-SOURCES handle xref-entries.

Export CCL:SETF-FUNCTION-SPEC-NAME, make it explicitly ignore the long-form setf method case.

Export the basic inspector API from the inspector package.

Export EQL-SPECIALIZER and SLOT-DEFINITION-DOCUMENTATION from OPENMCL-MOP

Refactor things a bit in backtrace code, define and export an API for examining backtraces:

CCL:MAP-CALL-FRAMES
CCL:FRAME-FUNCTION
CCL:FRAME-SUPPLIED-ARGUMENTS
CCL:FRAME-NAMED-VARIABLES

other misc new exports:

CCL:DEFINITION-TYPE
CCL;CALLER-FUNCTIONS
CCL:SLOT-DEFINITION-DOCUMENTATION
CCL:*SAVE-ARGLIST-INFO*
CCL:NATIVE-TRANSLATED-NAMESTRING
CCL:NATIVE-TO-PATHNAME
CCL:HASH-TABLE-WEAK-P
CCL;PROCESS-SERIAL-NUMBER
CCL:PROCESS-EXHAUSTED-P
CCL:APPLY-IN-FRAME

Other misc tweaks:

Make cbreak-loop use the break message when given a uselessly empty condition.

Use setf-function-name-p more consistently

Make find-applicable-methods handle eql specializers better.

Try to more consistently recognize lists of the form (:method ...) as method names.

Add xref-entry-full-name (which wasn't needed in the end)

File:
1 edited

Legend:

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

    r12219 r12463  
    35923592  (%compute-applicable-methods* gf args))
    35933593
     3594(defmethod compute-applicable-methods-using-classes ((gf standard-generic-function) args)
     3595  (let ((res (%compute-applicable-methods* gf args t)))
     3596    (if (eq res :undecidable)
     3597      (values nil nil)
     3598      (values res t))))
     3599
    35943600(defun %compute-applicable-methods+ (gf &rest args)
    35953601  (declare (dynamic-extent args))
    35963602  (%compute-applicable-methods* gf args))
    35973603
    3598 (defun %compute-applicable-methods* (gf args)
     3604(defun %compute-applicable-methods* (gf args &optional using-classes-p)
    35993605  (let* ((methods (%gf-methods gf))
    36003606         (args-length (length args))
     
    36173623            ((null cpls-tail))
    36183624          (setf (car cpls-tail)
    3619                 (%class-precedence-list (class-of (car args-tail)))))
     3625                (%class-precedence-list (if using-classes-p
     3626                                          ;; extension for use in source location support
     3627                                          (if (typep (car args-tail) 'eql-specializer)
     3628                                            (class-of (eql-specializer-object (car args-tail)))
     3629                                            (car args-tail))
     3630                                          (class-of (car args-tail))))))
    36203631        (dolist (m methods)
    3621           (if (%method-applicable-p m args cpls)
    3622             (push m res)))
     3632          (let ((appp (%method-applicable-p m args cpls using-classes-p)))
     3633            (when appp
     3634              (when (eq appp :undecidable) ;; can only happen if using-classes-p
     3635                (return-from %compute-applicable-methods* appp))
     3636              (push m res))))
    36233637        (sort-methods res cpls (%gf-precedence-list gf))))))
    36243638
    36253639
    3626 (defun %method-applicable-p (method args cpls)
     3640(defun %method-applicable-p (method args cpls &optional using-classes-p)
    36273641  (do* ((specs (%method-specializers method) (%cdr specs))
    36283642        (args args (%cdr args))
    36293643        (cpls cpls (%cdr cpls)))
    36303644      ((null specs) t)
    3631     (let ((spec (%car specs)))
     3645    (let ((spec (%car specs))
     3646          (arg (%car args)))
    36323647      (if (typep spec 'eql-specializer)
    3633         (unless (eql (%car args) (eql-specializer-object spec))
    3634           (return nil))
     3648        (if using-classes-p
     3649          (if (typep arg 'eql-specializer) ;; extension for use in source location support
     3650            (unless (eql (eql-specializer-object arg) (eql-specializer-object spec))
     3651              (return nil))
     3652            (if (typep (eql-specializer-object spec) arg)
     3653              ;; Can't tell if going to be applicable or not based on class alone
     3654              ;; Except for the special case of NULL which is a singleton
     3655              (unless (eq arg *null-class*)
     3656                (return :undecidable))
     3657              (return nil)))
     3658          (unless (eql arg (eql-specializer-object spec))
     3659            (return nil)))
    36353660        (unless (memq spec (%car cpls))
    36363661          (return nil))))))
Note: See TracChangeset for help on using the changeset viewer.