X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=b1c09f5978dd57fa14086af74ff0f5cf7f292c4c;hb=51344a3364f2cd6b14985719a77f697c094ea14d;hp=df05a08eb90ea1fa3bfd9e8a61377b7e8837fbb4;hpb=46a71b1cfad8885e4cff5ed53933ef5118319652;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index df05a08..b1c09f5 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -724,17 +724,30 @@
 
        (let ((fun (fun-info-optimizer info)))
          (unless (and fun (funcall fun node))
-           (dolist (x (fun-info-transforms info))
-             #!+sb-show
-             (when *show-transforms-p*
-               (let* ((lvar (basic-combination-fun node))
-                      (fname (lvar-fun-name lvar t)))
-                 (/show "trying transform" x (transform-function x) "for" fname)))
-             (unless (ir1-transform node x)
-               #!+sb-show
-               (when *show-transforms-p*
-                 (/show "quitting because IR1-TRANSFORM result was NIL"))
-               (return))))))))
+           ;; First give the VM a peek at the call
+           (multiple-value-bind (style transform)
+               (combination-implementation-style node)
+             (ecase style
+               (:direct
+                ;; The VM knows how to handle this.
+                )
+               (:transform
+                ;; The VM mostly knows how to handle this.  We need
+                ;; to massage the call slightly, though.
+                (transform-call node transform (combination-fun-source-name node)))
+               (:default
+                ;; Let transforms have a crack at it.
+                (dolist (x (fun-info-transforms info))
+                  #!+sb-show
+                  (when *show-transforms-p*
+                    (let* ((lvar (basic-combination-fun node))
+                           (fname (lvar-fun-name lvar t)))
+                      (/show "trying transform" x (transform-function x) "for" fname)))
+                  (unless (ir1-transform node x)
+                    #!+sb-show
+                    (when *show-transforms-p*
+                      (/show "quitting because IR1-TRANSFORM result was NIL"))
+                    (return)))))))))))
 
   (values))