From: Juho Snellman Date: Mon, 15 Jan 2007 21:05:43 +0000 (+0000) Subject: 1.0.1.25: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=b7ec0e2b9f51e41c924c254b837cf64d115567df;p=sbcl.git 1.0.1.25: Add limited support for LET and LET* to the fopcompiler (can only be used for binding lexical variables which aren't closed over). Speeds up McCLIM compilation by 5-10%. --- diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp index 1311ee3..a1f20ff 100644 --- a/src/code/kernel.lisp +++ b/src/code/kernel.lisp @@ -65,6 +65,9 @@ (defun %simple-fun-arglist (func) (%simple-fun-arglist func)) +(defun (setf %simple-fun-arglist) (new-value func) + (setf (%simple-fun-arglist func) new-value)) + ;;; Extract the name from the function header FUNC. (defun %simple-fun-name (func) (%simple-fun-name func)) diff --git a/src/compiler/fopcompile.lisp b/src/compiler/fopcompile.lisp index 7f18013..23c534d 100644 --- a/src/compiler/fopcompile.lisp +++ b/src/compiler/fopcompile.lisp @@ -11,6 +11,11 @@ (in-package "SB!C") +;;; True if the current contour of FOPCOMPILABLE-P has a LET or LET* +;;; with a non-nil bindings list, false otherwise. The effect of this +;;; variable is to +(defvar *fop-complex-lexenv-p* nil) + ;;; SBCL has no proper byte compiler (having ditched the rather ;;; ambitious and slightly flaky byte compiler inherited from CMU CL) ;;; but its FOPs are a sort of byte code which is expressive enough @@ -48,6 +53,9 @@ ;; 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)))))) (and (listp form) (ignore-errors (list-length form)) @@ -69,7 +77,16 @@ ;; are not fopcompileable as such, but we can compile ;; the lambdas with the real compiler, and the rest ;; of the expression with the fop-compiler. - (or (lambda-form-p (car args)) + (or (and (lambda-form-p (car args)) + ;; The lambda might be closing over some + ;; variable, punt. As a further improvement, + ;; we could analyze the lambda body to + ;; see whether it really closes over any + ;; variables. One place where even simple + ;; analysis would be useful are the PCL + ;; slot-definition type-check-functions + ;; -- JES, 2007-01-13 + (not *fop-complex-lexenv-p*)) ;; #'FOO, #'(SETF FOO), etc (legal-fun-name-p (car args))))) ((if) @@ -97,16 +114,36 @@ eval)) nil) (every #'fopcompilable-p (cdr args)))) - ;; A LET or LET* that introduces no bindings or - ;; declarations is trivially fopcompilable. Forms - ;; with no bindings but with declarations could also - ;; be handled, but we're currently punting on any - ;; lexenv manipulation. + ;; A LET or LET* that introduces only lexical + ;; bindings might be fopcompilable, depending on + ;; whether something closes over the bindings. + ;; (And whether there are declarations in the body, + ;; see below) ((let let*) (and (>= (length args) 1) - (null (car args)) - (every #'fopcompilable-p (cdr args)))) - ;; Likewise for LOCALLY + (loop for binding in (car args) + for complexp = *fop-complex-lexenv-p* then + (if (eq operator 'let) + complexp + t) + for name = (if (consp binding) + (first binding) + binding) + for value = (if (consp binding) + (second binding) + nil) + ;; Only allow binding lexicals, + ;; since special bindings can't be + ;; easily expressed with fops. + always (and (eq (info :variable :kind name) + :global) + (let ((*fop-complex-lexenv-p* + complexp)) + (fopcompilable-p value)))) + (let ((*fop-complex-lexenv-p* + (or *fop-complex-lexenv-p* + (not (null (car args)))))) + (every #'fopcompilable-p (cdr args))))) ((locally) (every #'fopcompilable-p args)) (otherwise @@ -213,6 +250,9 @@ (grovel constant)) t)) +;;; An alist mapping lexical varible names to FOP table handles. +(defvar *fop-lexenv* nil) + ;;; FOR-VALUE-P is true if the value will be used (i.e., pushed onto ;;; FOP stack), or NIL if any value will be discarded. FOPCOMPILABLE-P ;;; has already ensured that the form can be fopcompiled. @@ -225,8 +265,14 @@ (if macroexpanded-p ;; Symbol macro (fopcompile macroexpansion path for-value-p) - ;; Special variable - (fopcompile `(symbol-value ',form) 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 + (sb!fasl::dump-push (cdr (assoc form *fop-lexenv*)) + *compile-object*))))))) ((listp form) (multiple-value-bind (macroexpansion macroexpanded-p) (macroexpand form) @@ -277,7 +323,25 @@ (fopcompile (cons 'progn body) path for-value-p) (fopcompile nil path for-value-p)))) ((let let*) - (fopcompile (cons 'progn (cdr args)) path for-value-p)) + (let ((orig-lexenv *fop-lexenv*) + (*fop-lexenv* *fop-lexenv*)) + (loop for binding in (car args) + for name = (if (consp binding) + (first binding) + binding) + for value = (if (consp binding) + (second binding) + nil) + do (let ((*fop-lexenv* + (if (eql operator 'let) + orig-lexenv + *fop-lexenv*))) + (fopcompile value path t)) + do (push (cons name + (sb!fasl::dump-pop + *compile-object*)) + *fop-lexenv*)) + (fopcompile (cons 'progn (cdr args)) path for-value-p))) ;; Otherwise it must be an ordinary funcall. (otherwise (cond diff --git a/tests/fopcompiler.impure-cload.lisp b/tests/fopcompiler.impure-cload.lisp new file mode 100644 index 0000000..b4f58fb --- /dev/null +++ b/tests/fopcompiler.impure-cload.lisp @@ -0,0 +1,80 @@ +;;;; tests of the fop compiler + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(in-package "CL-USER") + +;; Can't use normal ASSERT, since it is not fopcompilable... +(defun assert* (value) + (unless value + (error "assert failed"))) + +;;; Test that the forms that are supposed to be fopcompilable are, and +;;; the ones that aren't aren't. The body might contain further tests to +;;; ensure that the fopcompiled code works as intended. +(defmacro fopcompile-test (fopcompilable-p &body body) + (assert (eql (sb-c::fopcompilable-p `(progn ,@body)) + fopcompilable-p)) + `(progn ,@body)) + +(fopcompile-test t + (let ((a 1)) + (assert* (eql a 1)))) + +(fopcompile-test t + (let ((a 3)) + (let ((a 4)) + (assert* (eql a 4))))) + +(fopcompile-test t + (let* ((a 5)) + (let* ((a 6)) + (assert* (eql a 6))))) + +(fopcompile-test nil + (let ((a 7)) + (assert* (eql (funcall (lambda () a)) 7)))) + +(fopcompile-test nil + (let* ((a 8)) + (assert* (eql (funcall (lambda () a)) 8)))) + +(fopcompile-test t + (let ((a 8) + (b (lambda () 1))) + nil)) + +(fopcompile-test t + (let* ((a (lambda () 1))) + nil)) + +(fopcompile-test nil + (let* ((a 8) + (b (lambda () 1))) + nil)) + +(fopcompile-test nil + (let* ((a 9) + (b (funcall (lambda () a)))) + (assert* (eql b 9)))) + +(fopcompile-test t + (let ((a 10)) + (let ((a 11) + (b a)) + (assert* (eql b 10))))) + +(fopcompile-test t + (let ((a 12)) + (let* ((a 13) + (b a)) + (assert* (eql b 13))))) diff --git a/version.lisp-expr b/version.lisp-expr index b563dc9..ae4989c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.1.24" +"1.0.1.25"