1.0.18.16: many STYLE-WARNING changes.
[sbcl.git] / src / compiler / fopcompile.lisp
index 3ddc35c..16f9daf 100644 (file)
 ;;; 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
                                 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))
                                     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