1.0.26.2: alloc_code_object facelift

[sbcl.git] / src / compiler / fopcompile.lisp

diff --git a/src/compiler/fopcompile.lisp b/src/compiler/fopcompile.lisp
index 3afa7af..4ea842f 100644 (file)
--- a/src/compiler/fopcompile.lisp
+++ b/src/compiler/fopcompile.lisp
@@ -36,7 +36,7 @@
   ;; supporting in the future are LOCALLY (with declarations),
   ;; MACROLET, SYMBOL-MACROLET and THE.
   #+sb-xc-host
-  nil
+  (declare (ignore form))
   #-sb-xc-host
   (or (and (self-evaluating-p form)
            (constant-fopcompilable-p form))
@@ -182,11 +182,7 @@
 ;;; Check that a literal form is fopcompilable. It would not for example
 ;;; when the form contains structures with funny MAKE-LOAD-FORMS.
 (defun constant-fopcompilable-p (constant)
-  (let ((things-processed nil)
-        (count 0))
-    (declare (type (or list hash-table) things-processed)
-             (type (integer 0 #.(1+ list-to-hash-table-threshold)) count)
-             (inline member))
+  (let ((xset (alloc-xset)))
     (labels ((grovel (value)
                ;; Unless VALUE is an object which which obviously
                ;; can't contain other objects
@@ -196,22 +192,9 @@
                                 number
                                 character
                                 string))
-                 (etypecase things-processed
-                   (list
-                    (when (member value things-processed :test #'eq)
-                      (return-from grovel nil))
-                    (push value things-processed)
-                    (incf count)
-                    (when (> count list-to-hash-table-threshold)
-                      (let ((things things-processed))
-                        (setf things-processed
-                              (make-hash-table :test 'eq))
-                        (dolist (thing things)
-                          (setf (gethash thing things-processed) t)))))
-                   (hash-table
-                    (when (gethash value things-processed)
-                      (return-from grovel nil))
-                    (setf (gethash value things-processed) t)))
+                 (if (xset-member-p value xset)
+                     (return-from grovel nil)
+                     (add-to-xset value xset))
                  (typecase value
                    (cons
                     (grovel (car value))
@@ -266,7 +249,7 @@
          (fopcompile-constant form for-value-p))
         ((symbolp form)
          (multiple-value-bind (macroexpansion macroexpanded-p)
-             (macroexpand form *lexenv*)
+             (sb!xc:macroexpand form *lexenv*)
            (if macroexpanded-p
                ;; Symbol macro
                (fopcompile macroexpansion path for-value-p)
@@ -275,24 +258,24 @@
                      ;; Special variable
                      (fopcompile `(symbol-value ',form) path for-value-p)
                      ;; Lexical
-                     (when for-value-p
-                       (let* ((lambda-var (cdr (assoc form (lexenv-vars *lexenv*))))
-                              (handle (when lambda-var
-                                        (lambda-var-fop-value lambda-var))))
-                         (if handle
-                             (sb!fasl::dump-push handle
-                                                 *compile-object*)
-                             (progn
-                               ;; Undefined variable. Signal a warning, and
-                               ;; treat it as a special variable reference,
-                               ;; like the real compiler does.
-                               (note-undefined-reference form :variable)
-                               (fopcompile `(symbol-value ',form)
-                                           path
-                                           for-value-p))))))))))
+                     (let* ((lambda-var (cdr (assoc form (lexenv-vars *lexenv*))))
+                            (handle (when lambda-var
+                                      (lambda-var-fop-value lambda-var))))
+                       (if handle
+                           (when for-value-p
+                             (sb!fasl::dump-push handle *compile-object*))
+                           (progn
+                             ;; Undefined variable. Signal a warning, and
+                             ;; treat it as a special variable reference, like
+                             ;; the real compiler does -- do not elide even if
+                             ;; the value is unused.
+                             (note-undefined-reference form :variable)
+                             (fopcompile `(symbol-value ',form)
+                                         path
+                                         for-value-p)))))))))
         ((listp form)
          (multiple-value-bind (macroexpansion macroexpanded-p)
-             (macroexpand form *lexenv*)
+             (sb!xc:macroexpand form *lexenv*)
            (if macroexpanded-p
                (fopcompile macroexpansion path for-value-p)
                (destructuring-bind (operator &rest args) form
@@ -321,7 +304,7 @@
                                     for-value-p)))
                    ((if)
                     (fopcompile-if args path for-value-p))
-                   ((progn)
+                   ((progn locally)
                     (loop for (arg . next) on args
                           do (fopcompile arg
                                          path (if next