Don't try to fold named constant references inside backquote anymore

The gain for doing so was fairly marginal. The thing that really
mattered with the change adding the folding was telling the difference
between a named constant and anonymous constant inside the backq
constant folder, for the sake of sane load form semantics.

Not backq-constant-folding named constant references removes a
load-form hack which also just doesn't work with deferred TLF
processing, as the load form may get evaluated for value before the
constant definition for the named constant is evaluated.

src/compiler/generic/vm-ir2tran.lisp

@@ -297,7 +297,10 @@
               ;; Nonetheless it's far better than it was. In all other scenarios, don't pass
               ;; a constant TN, because we don't know that generated code is better.
               (cond #+x86-64 ; still moar cringe
-                    ((and (or bit-vector-p simple-vector-p) (constant-lvar-p value))
+                    ((and (or bit-vector-p simple-vector-p) (constant-lvar-p value)
+                          ;; check for constant named-ness to not
+                          ;; trigger load form processing.
+                          (not (leaf-has-source-name-p (nth-value 1 (lvar-value value)))))
                      (funcall setter (tnify i) (emit-constant (lvar-value value))))
                     (t
                      ;; FIXME: for simple-vector, fixnums should get stored via an ANY-REG

src/compiler/seqtran.lisp

@@ -2579,41 +2579,25 @@
   (define-trimmer-transform string-trim t t))
 
 
-;;; We use this structure to facilitate named constant reference dumping inside
-;;; constant folded backquoted structures.
-#-sb-xc-host
-(defstruct (named-constant-reference
-             (:constructor make-named-constant-reference (name)))
-  (name (missing-arg) :type symbol :read-only t))
 
-#-sb-xc-host
-(defmethod make-load-form ((object named-constant-reference) &optional environment)
-  (declare (ignore environment))
-  (named-constant-reference-name object))
-
-;;; Wrap the value of lvar-value if it comes from a named
-;;; reference. For bootstrap reasons we don't do this during
-;;; cross-compile.
-(defun maybe-wrapped-lvar-value (lvar)
-  #+sb-xc-host
-  (lvar-value lvar)
-  #-sb-xc-host
-  (multiple-value-bind (value leaf)
-      (lvar-value lvar)
-    (if (leaf-has-source-name-p leaf)
-        (make-named-constant-reference (leaf-source-name leaf))
-        value)))
-
-;;; Pop constant values from the end, list/list* them if any, and link
-;;; the remainder with list* at runtime.
+;;; Pop anonymous constant values from the end, list/list* them if
+;;; any, and link the remainder with list* at runtime. We don't try to
+;;; fold named constant references, because while theoretically
+;;; possible, in addition to needing to make a load form for a
+;;; structure recording the constant name which wraps the constant
+;;; value, the dumper would have to learn how to patch constant values
+;;; into list structure, to deal with the load form potentially being
+;;; evaluated for value earlier than the constant definition is
+;;; loaded.
 (defun transform-backq-list-or-list* (function values)
   (let ((gensyms (make-gensym-list (length values)))
         (reverse (reverse values))
         (constants '()))
     (loop while (and reverse
-                     (constant-lvar-p (car reverse)))
-          do (push (maybe-wrapped-lvar-value (pop reverse))
-                   constants))
+                     (constant-lvar-p (car reverse))
+                     (not (leaf-has-source-name-p
+                           (nth-value 1 (lvar-value (car reverse))))))
+          do (push (lvar-value (pop reverse)) constants))
     (if (null constants)
         `(lambda ,gensyms
            (,function ,@gensyms))
@@ -2644,8 +2628,10 @@
     ;; might avoid consing intermediate lists if ,@ is involved
     ;; though I doubt it would provide benefit to many real-world scenarios.
     (dolist (elt elts)
-      (cond ((constant-lvar-p elt)
-             (push (maybe-wrapped-lvar-value elt) constants))
+      (cond ((and (constant-lvar-p elt)
+                  (not (leaf-has-source-name-p
+                        (print (nth-value 1 (lvar-value elt))))))
+             (push (lvar-value elt) constants))
             (t
              (setq constants :fail)
              (return))))

tests/backq-const-fold.impure-cload.lisp

@@ -9,7 +9,7 @@
       (make-instance 'foo)))
 
 ;;; The `(,+foo+) expression was being compile-time-folded to (#<foo
-;;; xxxx>).  Consequently it is unclear whether the #<foo> inside that
+;;; xxxx>). Consequently it was unclear whether the #<foo> inside that
 ;;; list should require a load-form. We now track whether something
 ;;; comes from a named constant reference and dump the constant
 ;;; appropriately.

tests/block-compile.impure.lisp

@@ -106,3 +106,20 @@
    :block-compile t
    :load t)
   (assert (eq (bar) (symbol-value 'testconstant4))))
+
+
+(with-test (:name :block-defconstant-hairy-backq-dumping-test)
+  (ctu:file-compile
+   `((defconstant +stuff+
+       (if (boundp '+stuff+)
+           (symbol-value '+stuff+)
+           '(0 0)))
+
+     (defvar *backq-stuff*
+       `((0 ,(random 10))
+         (,@+stuff+ 1 2 (3 . 4))
+         (5 6 ,+stuff+))))
+   :block-compile t
+   :before-load (lambda () (unintern (find-symbol "+STUFF+")))
+   :load t)
+  (assert (= 0 (first (third (third (symbol-value '*backq-stuff*)))))))