0.9.16.42:

[sbcl.git] / src / compiler / srctran.lisp

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index d2d096e..d93c082 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -114,6 +114,20 @@
 (define-source-transform ninth (x) `(nth 8 ,x))
 (define-source-transform tenth (x) `(nth 9 ,x))
 
+;;; LIST with one arg is an extremely common operation (at least inside
+;;; SBCL itself); translate it to CONS to take advantage of common
+;;; allocation routines.
+(define-source-transform list (&rest args)
+  (case (length args)
+    (1 `(cons ,(first args) nil))
+    (t (values nil t))))
+
+;;; And similarly for LIST*.
+(define-source-transform list* (&rest args)
+  (case (length args)
+    (2 `(cons ,(first args) ,(second args)))
+    (t (values nil t))))
+
 ;;; Translate RPLACx to LET and SETF.
 (define-source-transform rplaca (x y)
   (once-only ((n-x x))
@@ -169,8 +183,8 @@
 (define-source-transform 1+ (x) `(+ ,x 1))
 (define-source-transform 1- (x) `(- ,x 1))
 
-(define-source-transform oddp (x) `(not (zerop (logand ,x 1))))
-(define-source-transform evenp (x) `(zerop (logand ,x 1)))
+(define-source-transform oddp (x) `(logtest ,x 1))
+(define-source-transform evenp (x) `(not (logtest ,x 1)))
 
 ;;; Note that all the integer division functions are available for
 ;;; inline expansion.
@@ -3272,15 +3286,17 @@
 ;;; -- If both args are characters, convert to CHAR=. This is better than
 ;;;    just converting to EQ, since CHAR= may have special compilation
 ;;;    strategies for non-standard representations, etc.
-;;; -- If either arg is definitely a fixnum we punt and let the backend
-;;;    deal with it.
+;;; -- If either arg is definitely a fixnum, we check to see if X is
+;;;    constant and if so, put X second. Doing this results in better
+;;;    code from the backend, since the backend assumes that any constant
+;;;    argument comes second.
 ;;; -- If either arg is definitely not a number or a fixnum, then we
 ;;;    can compare with EQ.
 ;;; -- Otherwise, we try to put the arg we know more about second. If X
 ;;;    is constant then we put it second. If X is a subtype of Y, we put
 ;;;    it second. These rules make it easier for the back end to match
 ;;;    these interesting cases.
-(deftransform eql ((x y) * *)
+(deftransform eql ((x y) * * :node node)
   "convert to simpler equality predicate"
   (let ((x-type (lvar-type x))
         (y-type (lvar-type y))
@@ -3297,7 +3313,7 @@
               (csubtypep y-type char-type))
          '(char= x y))
         ((or (fixnum-type-p x-type) (fixnum-type-p y-type))
-         (give-up-ir1-transform))
+         (commutative-arg-swap node))
         ((or (simple-type-p x-type) (simple-type-p y-type))
          '(eq x y))
         ((and (not (constant-lvar-p y))
@@ -3692,6 +3708,12 @@
        (funcall control *standard-output* ,@arg-names)
        nil)))
 
+(deftransform pathname ((pathspec) (pathname) *)
+  'pathspec)
+
+(deftransform pathname ((pathspec) (string) *)
+  '(values (parse-namestring pathspec)))
+
 (macrolet
     ((def (name)
          `(defoptimizer (,name optimizer) ((control &rest args))
@@ -4053,3 +4075,4 @@
   `(let* ((acons (assoc quality-name policy))
           (result (or (cdr acons) 1)))
      result))
+