Skip to content
Snippets Groups Projects
Commit 8b89a71b authored by Jan Moringen's avatar Jan Moringen
Browse files

use EMPTYP instead of e.g. PLUSP and LENGTH were appropriate

EMPTYP usually (except, maybe, for some user-defined sequence types) has
two advantages:

1. it has O(1) runtime while LENGTH can be O(n)

2. it can work on user-defined, infinite sequences (given implementation
   support and integration of ALEXANDRIA:EMPTYP with the
   implementation's mechanism as is the case for SBCL)
parent dce97236
No related branches found
No related tags found
No related merge requests found
...@@ -230,7 +230,7 @@ not a sequence, or is an empty sequence." ...@@ -230,7 +230,7 @@ not a sequence, or is an empty sequence."
;; type-error. ;; type-error.
(cond ((consp sequence) (cond ((consp sequence)
(car sequence)) (car sequence))
((and (typep sequence '(and sequence (not list))) (plusp (length sequence))) ((and (typep sequence 'sequence) (not (emptyp sequence)))
(elt sequence 0)) (elt sequence 0))
(t (t
(error 'type-error (error 'type-error
...@@ -244,8 +244,7 @@ not a sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE. ...@@ -244,8 +244,7 @@ not a sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE.
;; type-error. ;; type-error.
(cond ((consp sequence) (cond ((consp sequence)
(setf (car sequence) object)) (setf (car sequence) object))
((and (typep sequence '(and sequence (not list))) ((and (typep sequence 'sequence) (not (emptyp sequence)))
(plusp (length sequence)))
(setf (elt sequence 0) object)) (setf (elt sequence 0) object))
(t (t
(error 'type-error (error 'type-error
...@@ -327,38 +326,33 @@ the last (length SUFFIX) elements of SEQUENCE are equal to SUFFIX." ...@@ -327,38 +326,33 @@ the last (length SUFFIX) elements of SEQUENCE are equal to SUFFIX."
(defun starts-with (object sequence &key (test #'eql) (key #'identity)) (defun starts-with (object sequence &key (test #'eql) (key #'identity))
"Returns true if SEQUENCE is a sequence whose first element is EQL to OBJECT. "Returns true if SEQUENCE is a sequence whose first element is EQL to OBJECT.
Returns NIL if the SEQUENCE is not a sequence or is an empty sequence." Returns NIL if the SEQUENCE is not a sequence or is an empty sequence."
(funcall test (let ((first-elt (typecase sequence
(funcall key (cons (car sequence))
(typecase sequence (sequence
(cons (car sequence)) (if (emptyp sequence)
(sequence (return-from starts-with nil)
(if (plusp (length sequence)) (elt sequence 0)))
(elt sequence 0) (t
(return-from starts-with nil))) (return-from starts-with nil)))))
(t (funcall test (funcall key first-elt) object)))
(return-from starts-with nil))))
object))
(defun ends-with (object sequence &key (test #'eql) (key #'identity)) (defun ends-with (object sequence &key (test #'eql) (key #'identity))
"Returns true if SEQUENCE is a sequence whose last element is EQL to OBJECT. "Returns true if SEQUENCE is a sequence whose last element is EQL to OBJECT.
Returns NIL if the SEQUENCE is not a sequence or is an empty sequence. Signals Returns NIL if the SEQUENCE is not a sequence or is an empty sequence. Signals
an error if SEQUENCE is an improper list." an error if SEQUENCE is an improper list."
(funcall test (let ((last-elt (typecase sequence
(funcall key (cons
(typecase sequence (lastcar sequence)) ; signals for improper lists
(cons (sequence
;; signals for improper lists ;; Can't use last-elt, as that signals an error
(lastcar sequence)) ;; for empty sequences
(sequence (let ((len (length sequence)))
;; Can't use last-elt, as that signals an error (if (plusp len)
;; for empty sequences (elt sequence (1- len))
(let ((len (length sequence))) (return-from ends-with nil))))
(if (plusp len) (t
(elt sequence (1- len)) (return-from ends-with nil)))))
(return-from ends-with nil)))) (funcall test (funcall key last-elt) object)))
(t
(return-from ends-with nil))))
object))
(defun map-combinations (function sequence &key (start 0) end length (copy t)) (defun map-combinations (function sequence &key (start 0) end length (copy t))
"Calls FUNCTION with each combination of LENGTH constructable from the "Calls FUNCTION with each combination of LENGTH constructable from the
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment