From 6fa7b9f967304c090078b835c5419d816c017d8d Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 17 Jul 2007 22:26:30 +0000 Subject: [PATCH] 1.0.7.28: compiler being nicer to the compiler * In MAKE-XEP-LAMBDA-EXPRESSION, use EQL instead of = and NOT < instead of >= to avoid additional rounds of deftransforms and lambda-conversion. * Add a source transform for %COERCE-CALLABLE-TO-FUN to pick of simple cases, also avoid inserting additional lambdas to the code. * Use %FUNCALL and %COERCE-CALLABLE-TO-FUN in MAPFOO-TRANSFORM, providing not just faster compilation, but also making (MAPCAR F ...) faster by lifting the %C-C-T-F out of the loop. This work was based on Juho's observation that a major source of compiler slowness are all the lambdas generated by transforms: not that this changes the big picture in any way -- just shaves a few corners. If you wish to get a gut feeling of what is going on, stick a (PRINT (LIST DEBUG-NAME BODY)) in IR1-CONVERT-INLINE-LAMBDA. --- src/compiler/ir1-translators.lisp | 7 +++++- src/compiler/locall.lisp | 6 +++-- src/compiler/seqtran.lisp | 47 ++++++++++++++++++------------------- version.lisp-expr | 2 +- 4 files changed, 34 insertions(+), 28 deletions(-) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 83b4ab4..c4289ed 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -575,7 +575,7 @@ be a lambda expression." ;;; directly to %FUNCALL, instead of waiting around for type ;;; inference. (define-source-transform funcall (function &rest args) - (if (and (consp function) (eq (car function) 'function)) + (if (and (consp function) (member (car function) '(function lambda))) `(%funcall ,function ,@args) (let ((name (constant-global-fun-name function))) (if name @@ -585,6 +585,11 @@ be a lambda expression." (deftransform %coerce-callable-to-fun ((thing) (function) *) "optimize away possible call to FDEFINITION at runtime" 'thing) + +(define-source-transform %coerce-callable-to-fun (thing) + (if (and (consp thing) (member (car thing) '(function lambda))) + thing + (values nil t))) ;;;; LET and LET* ;;;; diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index bc93706..2c41365 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -191,7 +191,7 @@ (optional-dispatch-entry-point-fun fun 0) (loop for ep in (optional-dispatch-entry-points fun) and n from min - do (entries `((= ,n-supplied ,n) + do (entries `((eql ,n-supplied ,n) (%funcall ,(force ep) ,@(subseq temps 0 n))))) `(lambda (,n-supplied ,@temps) ;; FIXME: Make sure that INDEX type distinguishes between @@ -201,7 +201,9 @@ (cond ,@(if more (butlast (entries)) (entries)) ,@(when more - `((,(if (zerop min) t `(>= ,n-supplied ,max)) + ;; KLUDGE: (NOT (< ...)) instead of >= avoids one round of + ;; deftransforms and lambda-conversion. + `((,(if (zerop min) t `(not (< ,n-supplied ,max))) ,(let ((n-context (gensym)) (n-count (gensym))) `(multiple-value-bind (,n-context ,n-count) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 8fae87c..a9bde8f 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -27,31 +27,30 @@ (args-to-fn (if take-car `(car ,v) v)))) (let* ((fn-sym (gensym)) ; for ONCE-ONLY-ish purposes - (call `(funcall ,fn-sym . ,(args-to-fn))) + (call `(%funcall ,fn-sym . ,(args-to-fn))) (endtest `(or ,@(tests)))) - (ecase accumulate - (:nconc - (let ((temp (gensym)) - (map-result (gensym))) - `(let ((,fn-sym ,fn) - (,map-result (list nil))) - (do-anonymous ((,temp ,map-result) . ,(do-clauses)) - (,endtest (cdr ,map-result)) - (setq ,temp (last (nconc ,temp ,call))))))) - (:list - (let ((temp (gensym)) - (map-result (gensym))) - `(let ((,fn-sym ,fn) - (,map-result (list nil))) - (do-anonymous ((,temp ,map-result) . ,(do-clauses)) - (,endtest (truly-the list (cdr ,map-result))) - (rplacd ,temp (setq ,temp (list ,call))))))) - ((nil) - `(let ((,fn-sym ,fn) - (,n-first ,(first arglists))) - (do-anonymous ,(do-clauses) - (,endtest (truly-the list ,n-first)) - ,call)))))))) + + `(let ((,fn-sym (%coerce-callable-to-fun ,fn))) + ,(ecase accumulate + (:nconc + (let ((temp (gensym)) + (map-result (gensym))) + `(let ((,map-result (list nil))) + (do-anonymous ((,temp ,map-result) . ,(do-clauses)) + (,endtest (cdr ,map-result)) + (setq ,temp (last (nconc ,temp ,call))))))) + (:list + (let ((temp (gensym)) + (map-result (gensym))) + `(let ((,map-result (list nil))) + (do-anonymous ((,temp ,map-result) . ,(do-clauses)) + (,endtest (truly-the list (cdr ,map-result))) + (rplacd ,temp (setq ,temp (list ,call))))))) + ((nil) + `(let ((,n-first ,(first arglists))) + (do-anonymous ,(do-clauses) + (,endtest (truly-the list ,n-first)) + ,call))))))))) (define-source-transform mapc (function list &rest more-lists) (mapfoo-transform function (cons list more-lists) nil t)) diff --git a/version.lisp-expr b/version.lisp-expr index fb8db34..ac0b0ce 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.7.27" +"1.0.7.28" -- 1.7.10.4