;; You should have received a copy of the GNU General Public License
;; along with JSCL. If not, see <http://www.gnu.org/licenses/>.
+(/debug "loading string.lisp!")
+
(defun stringp (s)
(stringp s))
(end2 (or end2 n2)))
(dotimes (i (max (- end1 start1) (- end2 start2)) nil)
(when (or (>= (+ start1 i) n1)
- (>= (+ start2 i) n2))
- (return-from string/= (+ start1 i)))
+ (>= (+ start2 i) n2))
+ (return-from string/= (+ start1 i)))
(unless (char= (char s1 (+ start1 i)) (char s2 (+ start2 i)))
- (return-from string/= (+ start1 i))))))
+ (return-from string/= (+ start1 i))))))
-(defun string< (s1 s2 &key (start1 0) end1 (start2 0) end2)
+
+(defun compare-strings (s1 s2 start1 end1 start2 end2 char-eq char-lt if-eq if-a-sub-b if-b-sub-a)
+ ;; step through strings S1 and S2, using bounds START1 END1 START2 END2.
+ ;; using character comparison functions CHAR-EQ (equality) and CHAR-LT (less-than),
+ ;; find the first difference, if any, and return its index.
+ ;; the IF-* params say what to do if the strings are equal, or a strict prefix substring of the other:
+ ;; if T, it returns the first different index. if NIL, it returns NIL.
(let* ((s1 (string s1))
(s2 (string s2))
- (end1 (or end1 (length s1)))
- (end2 (or end2 (length s2)))
- (len-1 (- end1 start1))
- (len-2 (- end2 start2)))
- (cond ((= len-2 0) nil)
- ((= len-1 0) 0)
- (t (dotimes (i len-1 nil)
- (when (= i len-2) ;; ran off the end of s2
- (return-from string< nil))
- (when (char< (char s1 (+ start1 i)) (char s2 (+ start2 i))) ;; found a difference
- (return-from string< (+ start1 i)))
- (when (char> (char s1 (+ start1 i)) (char s2 (+ start2 i))) ;; found a difference
- (return-from string< nil))
- (when (and (= i (1- len-1)) (> len-2 len-1)) ;; ran off the end of s1
- (return-from string< (+ start1 i 1))))))))
-
-;; just like string< but with everything flipped, except the result is still relative to s1
+ (end1 (or end1 (length s1)))
+ (end2 (or end2 (length s2)))
+ (len-1 (- end1 start1))
+ (len-2 (- end2 start2)))
+ (dotimes (i (max len-1 len-2) (if if-eq (+ start1 i) nil))
+ (when (= i len-1) ;; ran off the end of s1
+ (return-from compare-strings (if if-a-sub-b (+ start1 i) nil)))
+ (when (= i len-2) ;; ran off the end of s2
+ (return-from compare-strings (if if-b-sub-a (+ start1 i) nil)))
+ (let ((c1 (char s1 (+ start1 i)))
+ (c2 (char s2 (+ start2 i))))
+ (when (not (funcall char-eq c1 c2)) ;; found a difference
+ (return-from compare-strings
+ (if (not (funcall char-lt c1 c2))
+ (+ start1 i)
+ nil)))))))
+
+(defun string< (s1 s2 &key (start1 0) end1 (start2 0) end2)
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char= #'char> nil t nil))
+
(defun string> (s1 s2 &key (start1 0) end1 (start2 0) end2)
- (let* ((s1 (string s1))
- (s2 (string s2))
- (end1 (or end1 (length s1)))
- (end2 (or end2 (length s2)))
- (len-1 (- end1 start1))
- (len-2 (- end2 start2)))
- (cond ((= len-1 0) nil)
- ((= len-2 0) 0)
- (t (dotimes (i len-2 nil)
- (when (= i len-1) ;; ran off the end of s1
- (return-from string> nil))
- (when (char> (char s1 (+ start1 i)) (char s2 (+ start2 i))) ;; found a difference
- (return-from string> (+ start1 i)))
- (when (char< (char s1 (+ start1 i)) (char s2 (+ start2 i))) ;; found a difference
- (return-from string> nil))
- (when (and (= i (1- len-2)) (> len-1 len-2)) ;; ran off the end of s2
- (return-from string> (+ start1 i 1))))))))
-
-;; TODO: string<=, string>=
-;; - mostly like string< / string>
-;; - if we run off the end of s1 and s2 at the same time, then it's =, so return len.
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char= #'char< nil nil t))
+
+(defun string<= (s1 s2 &key (start1 0) end1 (start2 0) end2)
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char= #'char> t t nil))
+
+(defun string>= (s1 s2 &key (start1 0) end1 (start2 0) end2)
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char= #'char< t nil t))
+
+(defun string-lessp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char-equal #'char-greaterp nil t nil))
+
+(defun string-greaterp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char-equal #'char-lessp nil nil t))
+
+(defun string-not-greaterp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char-equal #'char-greaterp t t nil))
+
+(defun string-not-lessp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+ (compare-strings s1 s2 start1 end1 start2 end2
+ #'char-equal #'char-lessp t nil t))
(define-setf-expander char (string index)
(let ((g!string (gensym))
(let ((end (or end (length string))))
(dotimes (i (- end start) string)
(aset string (+ start i)
- (char-upcase (char string (+ start i)))))))
+ (char-upcase (char string (+ start i)))))))
(defun string-downcase (string &key (start 0) end)
(let* ((string (string string))
(let ((end (or end (length string))))
(dotimes (i (- end start) string)
(aset string (+ start i)
- (char-downcase (char string (+ start i)))))))
+ (char-downcase (char string (+ start i)))))))
(defun string-capitalize (string &key (start 0) end)
(let* ((string (string string))
- (new (make-string (length string)))
- (just-saw-alphanum-p nil))
+ (new (make-string (length string)))
+ (just-saw-alphanum-p nil))
(dotimes (i (length string) new)
(aset new i
- (cond ((or (and start (< i start))
- (and end (> i end)))
- (char string i))
- ((or (= i start)
- (not just-saw-alphanum-p))
- (char-upcase (char string i)))
- (t
- (char-downcase (char string i)))))
+ (cond ((or (and start (< i start))
+ (and end (> i end)))
+ (char string i))
+ ((or (= i start)
+ (not just-saw-alphanum-p))
+ (char-upcase (char string i)))
+ (t
+ (char-downcase (char string i)))))
(setq just-saw-alphanum-p (alphanumericp (char string i))))))
(defun nstring-capitalize (string &key (start 0) end)
(let ((end (or end (length string)))
- (just-saw-alphanum-p nil))
+ (just-saw-alphanum-p nil))
(dotimes (i (- end start) string)
(aset string (+ start i)
- (if (or (zerop i)
- (not just-saw-alphanum-p))
- (char-upcase (char string (+ start i)))
- (char-downcase (char string (+ start i)))))
+ (if (or (zerop i)
+ (not just-saw-alphanum-p))
+ (char-upcase (char string (+ start i)))
+ (char-downcase (char string (+ start i)))))
(setq just-saw-alphanum-p (alphanumericp (char string (+ start i)))))))
(defun string-equal (s1 s2 &key start1 end1 start2 end2)
(end2 (or end2 n2)))
(dotimes (i (max (- end1 start1) (- end2 start2)) nil)
(when (or (>= (+ start1 i) n1)
- (>= (+ start2 i) n2))
- (return-from string-not-equal (+ start1 i)))
+ (>= (+ start2 i) n2))
+ (return-from string-not-equal (+ start1 i)))
(unless (char-equal (char s1 (+ start1 i)) (char s2 (+ start2 i)))
- (return-from string-not-equal (+ start1 i))))))
+ (return-from string-not-equal (+ start1 i))))))
(defun string-trim (character-bag string)
(string-left-trim character-bag (string-right-trim character-bag string)))
(defun string-left-trim (character-bag string)
(let* ((string (string string))
- (n (length string))
- (start (or (position-if-not (lambda (c) (find c character-bag)) string) n)))
+ (n (length string))
+ (start (or (position-if-not (lambda (c) (find c character-bag)) string) n)))
(subseq string start)))
(defun string-right-trim (character-bag string)
(let* ((string (string string))
- (n (length string)))
+ (n (length string)))
(dotimes (i n "")
(when (not (find (char string (- n i 1)) character-bag))
- (return-from string-right-trim (subseq string 0 (- n i)))))))
+ (return-from string-right-trim (subseq string 0 (- n i)))))))
projects / jscl.git / blobdiff