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.

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 83b4ab4..c4289ed 100644 (file)
--- 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)))
 \f
 ;;;; LET and LET*
 ;;;;

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index bc93706..2c41365 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"