diff --git a/cmpltv.lisp b/cmpltv.lisp index 83c61ba..1d2a2b2 100644 --- a/cmpltv.lisp +++ b/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.