From: Nikodemus Siivola Date: Sun, 20 Jan 2013 09:36:56 +0000 (+0200) Subject: fix open coding of FIRST X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c4328785e9e1bd3538ee8d32fa27118ccf7eb388;p=sbcl.git 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 --- 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 --- 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)))))