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

make STARTS-WITH-SUBSEQ not cons unnecessarily

parent 5a17c072
No related branches found
No related tags found
No related merge requests found
......@@ -280,16 +280,22 @@ sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE."
:datum sequence
:expected-type '(and proper-sequence (not (satisfies emptyp))))))))
(defun starts-with-subseq (prefix sequence &rest args &key (return-suffix nil) &allow-other-keys)
(defun starts-with-subseq (prefix sequence &rest args
&key
(return-suffix nil return-suffix-supplied-p)
&allow-other-keys)
"Test whether the first elements of SEQUENCE are the same (as per TEST) as the elements of PREFIX.
If RETURN-SUFFIX is T the functions returns, as a second value, a
If RETURN-SUFFIX is T the function returns, as a second value, a
displaced array pointing to the sequence after PREFIX."
(remove-from-plistf args :return-suffix)
(declare (dynamic-extent args))
(let ((sequence-length (length sequence))
(prefix-length (length prefix)))
(if (<= prefix-length sequence-length)
(let ((mismatch (apply #'mismatch prefix sequence args)))
(let ((mismatch (apply #'mismatch prefix sequence
(if return-suffix-supplied-p
(remove-from-plist args :return-suffix)
args))))
(if mismatch
(if (< mismatch prefix-length)
(values nil nil)
......
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