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/compiler/nx-basic.lisp

    r12411 r12463  
    424424                 (if (non-nil-symbol-p spec)
    425425                   (setq fname spec)
    426                    (if (and (consp spec) (eq (%car spec) 'setf))
     426                   (if (setf-function-name-p spec)
    427427                     (setq fname (setf-function-name (cadr spec)))))
    428428                 (if fname
     
    444444                     (if (not (non-nil-symbol-p fname))
    445445                       (setq fname
    446                              (if (and (consp fname) (eq (%car fname) 'setf))
     446                             (if (setf-function-name-p fname)
    447447                               (setf-function-name (cadr fname)))))
    448448                     (if fname (push (list* fname decltype t) fdecls)))))))
     
    453453                           (if (not (non-nil-symbol-p fname))
    454454                             (setq fname
    455                                    (if (and (consp fname) (eq (%car fname) 'setf))
     455                                   (if (setf-function-name-p fname)
    456456                                     (setf-function-name (cadr fname)))))
    457457                           (if fname (push (list* fname decltype typespec) fdecls))))))
     
    528528       ,@body))))
    529529
     530
     531;; Should be true if compiler warnings UI doesn't use source locations, false if it does.
     532(defvar *merge-compiler-warnings* t "If false, don't merge compiler warnings with different source locations")
     533
    530534;;; If warnings have more than a single entry on their
    531535;;; args slot, don't merge them.
     
    536540        (if
    537541          (or (cdr w-args)
     542              ;; See if W can be merged into an existing warning
    538543              (dolist (w1 warnings t)
    539544                (let ((w1-args (compiler-warning-args w1)))
     
    543548                             (null (cdr w1-args))
    544549                             (eq (%car w-args)
    545                                  (%car w1-args)))
     550                                 (%car w1-args))
     551                             (or *merge-compiler-warnings*
     552                                 (eq (compiler-warning-source-note w)
     553                                     (compiler-warning-source-note w1))))
    546554                    (let ((nrefs (compiler-warning-nrefs w1)))
    547555                      (setf (compiler-warning-nrefs w1)
    548556                            (cons (compiler-warning-source-note w)
    549557                                  (or nrefs
    550                                       (list (compiler-warning-source-note w1))))))
    551                     (return)))))
     558                                      (list (compiler-warning-source-note w1)))))
     559                      (return nil))))))
    552560          (push w warnings))))
    553561    warnings))
     
    644652
    645653
    646 (defun report-compiler-warning (condition stream)
     654(defun report-compiler-warning (condition stream &key short)
    647655  (let* ((warning-type (compiler-warning-warning-type condition))
    648656         (format-string (cdr (assq warning-type *compiler-warning-formats*)))
    649          (name (reverse (compiler-warning-function-name condition))))
    650     (format stream "In ")
    651     (print-nested-name name stream)
    652     (when (every #'null name)
    653       (let ((position (compiler-warning-stream-position condition)))
    654         (when position (format stream " at position ~s" position))))
    655     (format stream ": ")
     657         (warning-args (compiler-warning-args condition)))
     658    (unless short
     659      (let ((name (reverse (compiler-warning-function-name condition))))
     660        (format stream "In ")
     661        (print-nested-name name stream)
     662        (when (every #'null name)
     663          (let ((position (source-note-start-pos (compiler-warning-source-note condition))))
     664            (when position (format stream " at position ~s" position))))
     665        (format stream ": ")))
    656666    (if (typep format-string 'string)
    657       (apply #'format stream format-string (adjust-compiler-warning-args warning-type (compiler-warning-args condition)))
     667      (apply #'format stream format-string (adjust-compiler-warning-args warning-type warning-args))
    658668      (if (null format-string)
    659         (format stream "~A: ~S" warning-type (compiler-warning-args condition))
     669        (format stream "~A: ~S" warning-type warning-args)
    660670        (funcall format-string condition stream)))
    661671    ;(format stream ".")
Note: See TracChangeset for help on using the changeset viewer.