fix open coding of FIRST

  Regression from 373df66df093e8c1771069dcc30c2ec32598af6a:
  "more funky &REST smartness".

  Make the source-transform of FIRST never decline, falling back on
  CAR if the argument is not a &REST list.

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 7736902..69c49af 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -4151,14 +4151,17 @@
         `(%rest-ref ,n ,seq ,context ,count)
         (values nil t))))
 
-;;; CAR -> %REST-REF
+;;; CAR/FIRST -> %REST-REF
 (defun source-transform-car (list)
   (multiple-value-bind (context count) (possible-rest-arg-context list)
     (if context
         `(%rest-ref 0 ,list ,context ,count)
         (values nil t))))
-(define-source-transform car (list) (source-transform-car list))
-(define-source-transform first (list) (source-transform-car list))
+(define-source-transform car (list)
+  (source-transform-car list))
+(define-source-transform first (list)
+  (or (source-transform-car list)
+      `(car ,list)))
 
 ;;; LENGTH -> %REST-LENGTH
 (defun source-transform-length (list)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 8e37cf2..624feeb 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4370,3 +4370,11 @@
                              (declare (type (signed-byte 31) x))
                              (sb-c::mask-signed-field 31 (- x 1055131947))))))
     (assert (= (funcall fun 10038) -1055121909))))
+
+(with-rest (:name :first-open-coded)
+  (let ((fun (compile nil `(lambda (x) (first x)))))
+    (assert (not (ctu:find-named-callees fun)))))
+
+(with-rest (:name :second-open-coded)
+  (let ((fun (compile nil `(lambda (x) (second x)))))
+    (assert (not (ctu:find-named-callees fun)))))