X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=b1c09f5978dd57fa14086af74ff0f5cf7f292c4c;hb=942e45e3bb73fd55786e4a0ab4590324063c0c89;hp=11021125a30a02e9235570c4386b5ecce8b17dc3;hpb=8fa5c056f5e1898d2bc5688aaf35105d8de112c0;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 1102112..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))
 
@@ -1879,3 +1892,6 @@
 
   (unless do-not-optimize
     (setf (node-reoptimize cast) nil)))
+
+(deftransform make-symbol ((string) (simple-string))
+  `(%make-symbol string))