From 515d93ece0096aed64d725940a32d1763b28337b Mon Sep 17 00:00:00 2001 From: Christophe Junke Date: Mon, 5 Oct 2020 08:36:25 +0200 Subject: [PATCH] Negative indices mean "from end" - Introduce INDEX to give a canonical index computation in strings - Introduce WITH-INDICES to help canonicalize input indices - Warns when indices are negative because the behaviour differs from previous versions. The warning is an explicit condition class named NEGATIVE-INDEX so that this case can be handled more easily by user code that has automatic tests in place. - Adjust test cases for INSERT --- str.lisp | 91 ++++++++++++++++++++++++++++++++++++---------- test/test-str.lisp | 7 +++- 2 files changed, 76 insertions(+), 22 deletions(-) diff --git a/str.lisp b/str.lisp index e07f462..9711a47 100644 --- a/str.lisp +++ b/str.lisp @@ -32,6 +32,7 @@ :constant-case ;; ours: + :index :remove-punctuation :contains? :containsp @@ -122,6 +123,8 @@ :? :base-displacement + :negative-index + )) (in-package :str) @@ -148,6 +151,57 @@ (defun version () (print +version+)) +;; as a dedicated condition to help detect it in tests +;; (up to 0.18.1 a negative index would mean zero) +(define-condition negative-index (warning) () + (:report + "STR possible breaking change: negative index means 'from end' now")) + +(declaim (inline index)) + +(defun index (string/length index) + "" + (declare (optimize (speed 3)) + #+sbcl ;; inlining: notes in caller code + (sb-ext:muffle-conditions sb-ext:compiler-note) + (type (or null fixnum) index) + (type (or vector array-total-size) string/length)) + (let ((length (etypecase string/length + (string (length string/length)) + (array-total-size string/length)))) + (cond + ((member index '(nil t)) length) + ((= 0 length) 0) + (t + (locally (declare (type (and fixnum (not (eql 0))) length)) + (when (< index 0) + (warn 'negative-index)) + (multiple-value-bind (quotient mod) (floor index length) + (if (<= -1 quotient 0) + ;; wrap when index is between -length and length + mod + ;; otherwise clamp to either side + (if (< quotient 0) 0 length)))))))) + +(defmacro with-indices ((&rest indices) string &body body) + "Ensure INDICES are computed according to INDEX w.r.t. STRING in BODY. + +INDICES is a list of either a symbol NAME or a couple (NAME VALUE); if +only NAME is provided, NAME is expected to be bound in the current +context to the VALUE associaed with NAME. + +Inside BODY, each NAME is bound by LET* to (INDEX STRING VALUE). +" + (let (($string (gensym))) + `(let ((,$string ,string)) + ,(flet ((make-binding (index) + (let ((index (if (listp index) index (list index)))) + (destructuring-bind (name &optional value) index + (let ((index-expr (or value name))) + `(,name (index ,$string ,index-expr))))))) + `(let* ,(mapcar #'make-binding indices) + ,@body))))) + (declaim (inline slice%)) (defun slice% (start end s sharedp) #+sbcl ;; inlining: notes in caller code @@ -163,7 +217,8 @@ (defun slice (start end s &optional (sharedp *sharedp*)) (when s - (slice% start end s sharedp))) + (with-indices ((start (or start 0)) end) s + (slice% start end s sharedp)))) ;; internal (defun whitespacep (char) @@ -230,21 +285,15 @@ (defun insert (string/char index s) "Insert the given string (or character) at the `index' into `s' and return a new string. - If `index' is out of bounds, ignore and return `s'." - (when (characterp string/char) - (setf string/char (string string/char))) + If `index' or `string/char' is NIL, ignore and return `s'." (cond - ((null index) - s) - ((< index 0) - s) - ((> index (length s)) - s) - (t - (concatenate 'string - (subseq s 0 index) - string/char - (subseq s index))))) + ((and s index string/char) + ;; insert _ in "abcd" at -1 means "abcd_", not "abc_d" + (with-indices (index) (1+ (length s)) + (concat (slice 0 index s t) + (string string/char) + (slice index (length s) s t)))) + (t s))) (defun split (separator s &key (omit-nulls *omit-nulls*) limit (start 0) end) "Split s into substring by separator (cl-ppcre takes a regex, we do not). @@ -645,6 +694,7 @@ Returns the string written to file." (string (elt \"test\" 1)) ;; => \"e\"" (cond ((null s) nil) + ;; TODO negative index ((or (empty? s) (minusp n)) "") ((= n 0) (s-first s)) (t (s-nth (1- n) (s-rest s))))) @@ -669,11 +719,12 @@ with `string='. (unless (or (null s) (null substring) (empty? substring)) - (loop :with substring-length := (length substring) - :for position := (search substring s :start2 start :end2 end) - :then (search substring s :start2 (+ position substring-length) :end2 end) - :while (not (null position)) - :summing 1))) + (with-indices ((start (or start 0)) end) s + (loop :with substring-length := (length substring) + :for position := (search substring s :start2 start :end2 end) + :then (search substring s :start2 (+ position substring-length) :end2 end) + :while (not (null position)) + :summing 1)))) ;;; Case diff --git a/test/test-str.lisp b/test/test-str.lisp index 33b7508..d19715b 100644 --- a/test/test-str.lisp +++ b/test/test-str.lisp @@ -64,8 +64,11 @@ (subtest "Insert" (is "hello" (insert "o" 4 "hell")) (is "hello" (insert "h" 0 "ello")) - (is "hell" (insert "l" 200 "hell") "large index") - (is "hell" (insert "l" -2 "hell") "negative index") + (is "helll" (insert "l" 200 "hell") "large index") + (is "hell_" (insert "_" -1 "hell") "negative index last") + (is "_hell" (insert "_" -5 "hell") "negative index first") + (is "hell_" (insert "_" 4 "hell") "positive index last") + (is "_hell" (insert "_" 0 "hell") "positive index first") (is "hell" (insert nil 2 "hell") "insert nil: do nothing") (is "hell" (insert "l" nil "hell") "index nil: do nothing") (is nil (insert "l" 2 nil) "s nil: nil")