From c4328785e9e1bd3538ee8d32fa27118ccf7eb388 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 20 Jan 2013 11:36:56 +0200 Subject: [PATCH] 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. --- src/compiler/srctran.lisp | 9 ++++++--- tests/compiler.pure.lisp | 8 ++++++++ 2 files changed, 14 insertions(+), 3 deletions(-) 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))))) -- 1.7.10.4