Changeset 13980


Ignore:
Timestamp:
Jul 18, 2010, 8:53:50 PM (9 years ago)
Author:
gb
Message:

Make the hash table used by INTERN-EQL-SPECIALIZER weak on value.
Don't call RECORD-SOURCE-FILE in ENSURE-METHOD; do call it from the
expansion of DEFMETHOD. (Could do so more concisely, but that involves
a little bit of bootstrapping.)
Fixes ticket:704.

Location:
trunk/source
Files:
3 edited

Legend:

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

    r13647 r13980  
    745745        (when (and doc-p *save-doc-strings*)
    746746          (set-documentation method t documentation))
    747         (record-source-file method 'method)
    748747        (when old-method (%move-method-encapsulations-maybe old-method method))
    749748        method))))
    750        
     749
    751750
    752751(defun %anonymous-method (function specializers qualifiers  lambda-list &optional documentation
  • trunk/source/level-1/l1-dcode.lisp

    r13067 r13980  
    711711
    712712(let* ((eql-specializers-lock (make-lock))
    713        (eql-specializers-hash (make-hash-table :test #'eql)))
     713       (eql-specializers-hash (make-hash-table :test #'eql  :weak :value)))
    714714  (defun intern-eql-specializer (object)
    715715    (with-lock-grabbed (eql-specializers-lock)
  • trunk/source/lib/macros.lisp

    r13675 r13980  
    18301830
    18311831(defmacro defmethod (name &rest args &environment env)
    1832   (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
    1833       (parse-defmethod name args env)
    1834     `(progn
    1835        (eval-when (:compile-toplevel)
    1836          (record-function-info ',(maybe-setf-function-name name)
    1837                                ',(multiple-value-bind (bits keyvect) (encode-lambda-list lambda-list t)
    1838                                    (unless bits ;; verify failed
    1839                                      (signal-program-error "Invalid lambda list ~s"
    1840                                                            (find-if #'listp args)))
    1841                                    (%cons-def-info 'defmethod bits keyvect nil specializers qualifiers))
    1842                                ,env))
    1843        (compiler-let ((*nx-method-warning-name* '(,name ,@qualifiers ,specializers)))
    1844          (ensure-method ',name ,specializers-form
    1845                         :function ,function-form
    1846                         :qualifiers ',qualifiers
    1847                         :lambda-list ',lambda-list
    1848                         ,@(if documentation `(:documentation ,documentation)))))))
     1832  (let* ((method (gensym)))
     1833    (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
     1834        (parse-defmethod name args env)
     1835      `(progn
     1836        (eval-when (:compile-toplevel)
     1837          (record-function-info ',(maybe-setf-function-name name)
     1838                                ',(multiple-value-bind (bits keyvect) (encode-lambda-list lambda-list t)
     1839                                                       (unless bits;; verify failed
     1840                                                         (signal-program-error "Invalid lambda list ~s"
     1841                                                                               (find-if #'listp args)))
     1842                                                       (%cons-def-info 'defmethod bits keyvect nil specializers qualifiers))
     1843                                ,env))
     1844        (compiler-let ((*nx-method-warning-name* '(,name ,@qualifiers ,specializers)))
     1845          (let* ((,method (ensure-method ',name ,specializers-form
     1846                                         :function ,function-form
     1847                                         :qualifiers ',qualifiers
     1848                                         :lambda-list ',lambda-list
     1849                                         ,@(if documentation `(:documentation ,documentation)))))
     1850            (record-source-file ,method 'method)
     1851            ,method))))))
    18491852
    18501853
Note: See TracChangeset for help on using the changeset viewer.