Changeset 13980

Timestamp:

Jul 18, 2010, 1:53:50 PM (14 years ago)

Author:

Gary Byers

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:

• level-1/l1-clos-boot.lisp (modified) (1 diff)
• level-1/l1-dcode.lisp (modified) (1 diff)
• lib/macros.lisp (modified) (1 diff)

trunk/source/level-1/l1-clos-boot.lisp

@@ -745 +745 @@
         (when (and doc-p *save-doc-strings*)
           (set-documentation method t documentation))
-        (record-source-file method 'method)
         (when old-method (%move-method-encapsulations-maybe old-method method))
         method))))
-        
+
 
 (defun %anonymous-method (function specializers qualifiers  lambda-list &optional documentation

trunk/source/level-1/l1-dcode.lisp

@@ -711 +711 @@
 
 (let* ((eql-specializers-lock (make-lock))
-       (eql-specializers-hash (make-hash-table :test #'eql)))
+       (eql-specializers-hash (make-hash-table :test #'eql  :weak :value)))
   (defun intern-eql-specializer (object)
     (with-lock-grabbed (eql-specializers-lock)

trunk/source/lib/macros.lisp

@@ -1830 +1830 @@
 
 (defmacro defmethod (name &rest args &environment env)
-  (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
-      (parse-defmethod name args env)
-    `(progn
-       (eval-when (:compile-toplevel)
-         (record-function-info ',(maybe-setf-function-name name)
-                               ',(multiple-value-bind (bits keyvect) (encode-lambda-list lambda-list t)
-                                   (unless bits ;; verify failed
-                                     (signal-program-error "Invalid lambda list ~s"
-                                                           (find-if #'listp args)))
-                                   (%cons-def-info 'defmethod bits keyvect nil specializers qualifiers))
-                               ,env))
-       (compiler-let ((*nx-method-warning-name* '(,name ,@qualifiers ,specializers)))
-         (ensure-method ',name ,specializers-form
-                        :function ,function-form
-                        :qualifiers ',qualifiers
-                        :lambda-list ',lambda-list
-                        ,@(if documentation `(:documentation ,documentation)))))))
+  (let* ((method (gensym)))
+    (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
+        (parse-defmethod name args env)
+      `(progn
+        (eval-when (:compile-toplevel)
+          (record-function-info ',(maybe-setf-function-name name)
+                                ',(multiple-value-bind (bits keyvect) (encode-lambda-list lambda-list t)
+                                                       (unless bits;; verify failed
+                                                         (signal-program-error "Invalid lambda list ~s"
+                                                                               (find-if #'listp args)))
+                                                       (%cons-def-info 'defmethod bits keyvect nil specializers qualifiers))
+                                ,env))
+        (compiler-let ((*nx-method-warning-name* '(,name ,@qualifiers ,specializers)))
+          (let* ((,method (ensure-method ',name ,specializers-form
+                                         :function ,function-form
+                                         :qualifiers ',qualifiers
+                                         :lambda-list ',lambda-list
+                                         ,@(if documentation `(:documentation ,documentation)))))
+            (record-source-file ,method 'method)
+            ,method))))))