Optimize CONCATENATE transform.

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

diff --git a/src/compiler/fopcompile.lisp b/src/compiler/fopcompile.lisp
index 16f9daf..2ac2385 100644 (file)
--- a/src/compiler/fopcompile.lisp
+++ b/src/compiler/fopcompile.lisp
@@ -36,26 +36,22 @@
   ;; 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))
       (and (symbolp form)
            (multiple-value-bind (macroexpansion macroexpanded-p)
-               (macroexpand form *lexenv*)
+               (%macroexpand form *lexenv*)
              (if macroexpanded-p
                  (fopcompilable-p macroexpansion)
                  ;; Punt on :ALIEN variables
                  (let ((kind (info :variable :kind form)))
-                   (or (eq kind :special)
-                       ;; Not really a global, but a variable for
-                       ;; which no information exists.
-                       (eq kind :global)
-                       (eq kind :constant))))))
+                   (member kind '(:special :constant :global :unknown))))))
       (and (listp form)
            (ignore-errors (list-length form))
            (multiple-value-bind (macroexpansion macroexpanded-p)
-               (macroexpand form *lexenv*)
+               (%macroexpand form *lexenv*)
              (if macroexpanded-p
                  (fopcompilable-p macroexpansion)
                  (destructuring-bind (operator &rest args) form
@@ -158,11 +154,10 @@
                    for value = (if (consp binding)
                                    (second binding)
                                    nil)
-                   ;; Only allow binding lexicals,
-                   ;; since special bindings can't be
-                   ;; easily expressed with fops.
+                   ;; Only allow binding locals, since special bindings can't
+                   ;; be easily expressed with fops.
                    always (and (eq (info :variable :kind name)
-                                   :global)
+                                   :unknown)
                                (let ((*lexenv* (ecase operator
                                                  (let orig-lexenv)
                                                  (let* *lexenv*))))
@@ -177,7 +172,7 @@
 (defun lambda-form-p (form)
   (and (consp form)
        (member (car form)
-               '(lambda named-lambda instance-lambda lambda-with-lexenv))))
+               '(lambda named-lambda lambda-with-lexenv))))
 
 ;;; Check that a literal form is fopcompilable. It would not for example
 ;;; when the form contains structures with funny MAKE-LOAD-FORMS.
@@ -249,33 +244,39 @@
          (fopcompile-constant form for-value-p))
         ((symbolp form)
          (multiple-value-bind (macroexpansion macroexpanded-p)
-             (sb!xc:macroexpand form *lexenv*)
+             (%macroexpand form *lexenv*)
            (if macroexpanded-p
                ;; Symbol macro
                (fopcompile macroexpansion path for-value-p)
                (let ((kind (info :variable :kind form)))
-                 (if (member kind '(:special :constant))
-                     ;; 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))))))))))
+                 (cond
+                   ((eq :special kind)
+                    ;; Special variable
+                    (fopcompile `(symbol-value ',form) path for-value-p))
+
+                   ((member kind '(:global :constant))
+                    ;; Global variable or constant.
+                    (fopcompile `(symbol-global-value ',form) path for-value-p))
+                   (t
+                    ;; Lexical
+                    (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)
-             (sb!xc:macroexpand form *lexenv*)
+             (%macroexpand form *lexenv*)
            (if macroexpanded-p
                (fopcompile macroexpansion path for-value-p)
                (destructuring-bind (operator &rest args) form