Commit 78cce51d authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix ticket:81 and fix ticket:83.

From ticket 81, the tests are now:

(time (prog1 t (time-rev *s*)))
; Evaluation took:
;   0.49 seconds of real time
;   0.481813 seconds of user run time
;   0.003624 seconds of system run time
;   1,490,776,936 CPU cycles
;   [Run times include 0.13 seconds GC run time]
;   0 page faults and
;   200,073,704 bytes consed.

(time (prog1 t (time-rev *s2*)))
; Evaluation took:
;   0.97 seconds of real time
;   0.965893 seconds of user run time
;   0.005139 seconds of system run time
;   2,980,415,911 CPU cycles
;   [Run times include 0.23 seconds GC run time]
;   0 page faults and
;   400,005,560 bytes consed.

So the new string-reverse* is 20 times faster for strings without
surrogates and 10 times faster for strings containing only surrogates.
parent 0b5c1254
...@@ -1172,13 +1172,24 @@ ...@@ -1172,13 +1172,24 @@
(type string sequence)) (type string sequence))
(with-string sequence (with-string sequence
(let* ((length (- end start)) (let* ((length (- end start))
(string (make-string length)) (r (make-string length)))
(j length)) (do ((dst-index (1- length) (1- dst-index))
(declare (type kernel:index length j)) (src-index start (1+ src-index)))
(loop for i = start then n as n = (%glyph-f sequence i) do ((minusp dst-index))
(replace string sequence :start1 (decf j (- n i)) :start2 i :end2 n) (declare (fixnum src-index dst-index))
while (< n end)) (let ((current-char (schar sequence src-index)))
string))) (cond ((and (lisp::surrogatep current-char :leading)
(plusp dst-index))
;; Reverse surrogate pairs correctly, which means the
;; pair isn't reversed at all.
(incf src-index)
(setf (schar r dst-index) (schar sequence src-index))
(decf dst-index)
(setf (schar r dst-index) current-char))
;; Easy case
(setf (schar r dst-index) current-char)))))
#+unicode #+unicode
(defun string-nreverse* (sequence) (defun string-nreverse* (sequence)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment