From f68c911ece52233f10cdd4ec6addd655de82ca06 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 09:19:52 +0100
Subject: [PATCH] cmp: allow specifying the type of vv

This will be useful for inline locations where we don't know the real value, but
we can infer the type.
---
 src/cmp/cmplocs.lsp | 17 +++++++++--------
 src/cmp/cmpprop.lsp |  2 +-
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index f14ac7c8d..ee9b9407d 100644
--- a/src/cmp/cmplocs.lsp
+++ b/src/cmp/cmplocs.lsp
@@ -23,21 +23,22 @@
 ;;; second pass the backend decides if the referenced object can be inlined, or
 ;;; if it needs to be put in the data segment and initialized at load-time.
 
-(defstruct vv
+(defstruct (vv (:constructor %make-vv))
   (location nil)
   (used-p nil)
   (always nil)       ; when true then vv is never optimized
   (permanent-p t)
   (value nil)
+  (type nil)
   (host-type :object))
 
-;;; When the value is the "empty location" then it was created to be filled
-;;; later and the real type of the object is not known. See DATA-EMPTY-LOC.
-(defun vv-type (loc)
-  (let ((value (vv-value loc)))
-    (if (eq value *empty-loc*)
-        t
-        (type-of value))))
+(defun make-vv (&rest args &key location used-p always permanent-p value type host-type)
+  (declare (ignore location used-p always permanent-p host-type))
+  (unless type
+    ;; When the value is the "empty location" then it was created to be filled
+    ;; later and the real type of the object is not known. See DATA-EMPTY-LOC.
+    (setf type (if (eq value *empty-loc*) t (type-of value))))
+  (apply #'%make-vv :type type args))
 
 (defun loc-movable-p (loc)
   (if (atom loc)
diff --git a/src/cmp/cmpprop.lsp b/src/cmp/cmpprop.lsp
index 56bb324e0..cf74a5a1c 100644
--- a/src/cmp/cmpprop.lsp
+++ b/src/cmp/cmpprop.lsp
@@ -53,7 +53,7 @@
 
 (defun p1var (form var loc)
   ;; Use the type of C1FORM because it might have been coerced by a THE form.
-  (let* ((loc-type (if loc (object-type (vv-value loc)) t))
+  (let* ((loc-type (if loc (vv-type loc) t))
          (var-type (var-type var))
          (type (type-and (type-and loc-type var-type)
                          (c1form-primary-type form))))