X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffopcompile.lisp;h=2ac2385c34db61aec2b6c7f6c1e858e0df1459ac;hb=56d227c6c574ca512501202fa1d24384e293c5d2;hp=16f9daf7ea7fcdaab61edec64f9c528e98384862;hpb=cdb975feaadf1dc5554396b8f399708bc9b6f90d;p=sbcl.git diff --git a/src/compiler/fopcompile.lisp b/src/compiler/fopcompile.lisp index 16f9daf..2ac2385 100644 --- 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