Changeset 7792 for branches

Timestamp:

Nov 30, 2007, 12:46:53 PM (17 years ago)

Author:

Gary Byers

Message:

Track SETF function name inverses.

File:

• branches/working-0711/ccl/level-1/l1-aprims.lisp (modified) (2 diffs)

branches/working-0711/ccl/level-1/l1-aprims.lisp

@@ -229 +229 @@
 
 (defvar %setf-function-names% (make-hash-table :weak t :test 'eq))
+(defvar %setf-function-name-inverses% (make-hash-table :weak t :test 'eq))
 
 (defun setf-function-name (sym)
    (or (gethash sym %setf-function-names%)
-       (setf (gethash sym %setf-function-names%) (construct-setf-function-name sym))))
-
-
+       (progn
+         (let* ((setf-package-sym (construct-setf-function-name sym)))
+           (setf (gethash setf-package-sym %setf-function-name-inverses%) sym
+                 (gethash sym %setf-function-names%) setf-package-sym)))))
+
+
+(defun maybe-setf-name (sym)
+  (let* ((other (gethash sym %setf-function-name-inverses%)))
+    (if other
+      `(setf ,other)
+      sym)))
 
                      
@@ -247 +256 @@
       (values
        (intern
-        ;I wonder, if we didn't check, would anybody report it as a bug?
+        ;;I wonder, if we didn't check, would anybody report it as a bug?
         (if (not (%str-member #\: (setq pkg (package-name pkg))))
           (%str-cat pkg "::" sym)