diff --git a/src/code/seq.lisp b/src/code/seq.lisp index 0c4ff02c522b0160f368705c69ba6c74e092ea94..ad5048d193a42c34fecbdd96f4a4280eec250197 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -138,6 +138,16 @@ (t (make-sequence-of-type (result-type-or-lose type) length)))) +(defun list-elt* (sequence index) + (declare (type list sequence)) + (do ((count index (1- count)) + (list sequence (cdr list))) + ((= count 0) + (if (endp list) + (signal-index-too-large-error sequence index) + (car list))) + (declare (type (integer 0) count)))) + (defun elt (sequence index) "Returns the element of SEQUENCE specified by INDEX." (etypecase sequence diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 1e0bd17435d8a192e16446e36a7cfc27aaeb22fd..4dcd7092592cf9f4c1bae75ffd33e2caa30b1655 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -107,8 +107,8 @@ (deftransform elt ((s i) ((simple-array * (*)) *) * :when :both) '(aref s i)) -(deftransform elt ((s i) (list *) * :when :both :policy (< safety 3)) - '(nth i s)) +(deftransform elt ((s i) (list *) * :when :both) + '(lisp::list-elt* s i)) (deftransform %setelt ((s i v) ((simple-array * (*)) * *) * :when :both) '(%aset s i v)) diff --git a/tests/issues.lisp b/tests/issues.lisp index 97d3dc9e8e4c9fb7250a2aa42eb3705863f25337..2684d83ed61a929f4b59159263d88401ad1baaed 100644 --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -23,3 +23,18 @@ (assert-equal '(square x) (funcall (compiler-macro-function 'square) '(funcall #'square x) nil))) + +(define-test issue.5 + (:tag :issues) + (assert-true + (handler-case + (let ((f (compile nil '(lambda (list) + (declare (type list list) + (optimize (speed 1) (safety 1) (compilation-speed 1) (space 1) (debug 1))) + (elt list 3))))) + (funcall f (list 0 1 2))) + ;; ELT should signal an error in this case. + (lisp::index-too-large-error () + t) + (t () + nil))))