Coalesce function and variable cells properly

cmpltv.lisp

@@ -268,6 +268,11 @@
 ;;; confuse those things.
 (defvar *oob-coalesce*)
 
+;;; For function cells. EQUAL since function names can be lists.
+(defvar *fcell-coalesce*)
+;;; And variable cells.
+(defvar *vcell-coalesce*)
+
 ;; Look up a value in the existing instructions.
 ;; On success returns the creator, otherwise NIL.
 ;; Could be extended with coalescence relations or made more efficient,
@@ -281,6 +286,9 @@
 (defun find-oob (value)
   (values (gethash value *oob-coalesce*)))
 
+(defun find-fcell (name) (values (gethash name *fcell-coalesce*)))
+(defun find-vcell (name) (values (gethash name *vcell-coalesce*)))
+
 ;;; List of instructions to be executed by the loader.
 ;;; In reverse.
 (defvar *instructions*)
@@ -294,7 +302,10 @@
 
 (defmacro with-constants ((&key) &body body)
   `(let ((*instructions* nil) (*creating* nil)
-         (*coalesce* (make-hash-table)) (*oob-coalesce* (make-hash-table)))
+         (*coalesce* (make-hash-table))
+         (*oob-coalesce* (make-hash-table))
+         (*fcell-coalesce* (make-hash-table :test #'equal))
+         (*vcell-coalesce* (make-hash-table)))
      ,@body))
 
 (defun find-constant (value)
@@ -318,6 +329,14 @@
   (setf (gethash key *oob-coalesce*) instruction)
   (add-instruction instruction))
 
+(defun add-fcell (key instruction)
+  (setf (gethash key *fcell-coalesce*) instruction)
+  (add-instruction instruction))
+
+(defun add-vcell (key instruction)
+  (setf (gethash key *vcell-coalesce*) instruction)
+  (add-instruction instruction))
+
 (defgeneric add-constant (value))
 
 (defun ensure-constant (value &key permanent)
@@ -1130,21 +1149,23 @@
      :form (cmp:ltv-info-form info)
      :info info)))
 
-(defun ensure-fcell (info)
-  (or (find-oob info)
-      (let ((name (cmp:fdefinition-info-name info)))
-        (add-oob info
-                 (make-instance 'fcell-lookup :name (ensure-constant name))))))
+(defun ensure-fcell (name)
+  (or (find-fcell name)
+      (add-fcell name
+                 (make-instance 'fcell-lookup
+                   :name (ensure-constant name)))))
 
 (defmethod ensure-module-literal ((info cmp:fdefinition-info))
-  (ensure-fcell info))
+  (ensure-fcell (cmp:fdefinition-info-name info)))
 
-(defun ensure-vcell (info)
-  (or (find-oob info)
-      (let ((name (cmp:value-cell-info-name info)))
-        (add-oob info
+(defun ensure-vcell (name)
+  (or (find-vcell name)
+      (add-vcell name
                  (make-instance 'vcell-lookup
-                   :name (ensure-constant name))))))
+                   :name (ensure-constant name)))))
+
+(defmethod ensure-module-literal ((info cmp:value-cell-info))
+  (ensure-vcell (cmp:value-cell-info-name info)))
 
 (defun add-module (value)
   ;; Add the module first to prevent recursion.