mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 21:32:49 -08:00
Code Issues Projects Releases Packages Wiki Activity

Optimized COPY-SUBARRAY and used it for improving REPLACE

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-28 23:46:00 +02:00
parent 1ab49768fb
commit a7a221e136
7 changed files with 71 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/CHANGELOG
View file

@ -62,7 +62,7 @@ ECL 10.5.1:
SAFETY are below 2.
- Important performance improvements in sequence functions, such as FIND,
POSITION, COUNT, REMOVE, DELETE, SUBSTITUTE, NSUBSTITUTE,
REPLACE, POSITION, COUNT, REMOVE, DELETE, SUBSTITUTE, NSUBSTITUTE,
DELETE-DUPLICATES, REMOVE-DUPLICATES and their possible IF/IF-NOT
variants. Except COUNT, for efficiency, some of the previously mentioned
functions may run through the sequences in arbitrary orders one or more

39
src/c/array.d
View file

@ -1107,17 +1107,28 @@ ecl_copy_subarray(cl_object dest, cl_index i0, cl_object orig,
if (i1 + l > orig->array.dim) {
l = orig->array.dim - i1;
}
if (t != ecl_array_elttype(orig) || t == aet_bit) {
while (l--) {
ecl_aset_unsafe(dest, i0++, ecl_aref_unsafe(orig, i1++));
}
} else if (t >= 0 && t <= aet_last_type) {
if (dest == orig && i0 > i1) {
if (t != ecl_array_elttype(orig) || t == aet_bit) {
for (i0 += l, i1 += l; l--; ) {
ecl_aset_unsafe(dest, --i0,
ecl_aref_unsafe(orig, --i1));
}
} else {
cl_index elt_size = ecl_aet_size[t];
memmove(dest->array.self.bc + i0 * elt_size,
orig->array.self.bc + i1 * elt_size,
l * elt_size);
}
} else if (t != ecl_array_elttype(orig) || t == aet_bit) {
while (l--) {
ecl_aset_unsafe(dest, i0++,
ecl_aref_unsafe(orig, i1++));
}
} else {
cl_index elt_size = ecl_aet_size[t];
memcpy(dest->array.self.bc + i0 * elt_size,
orig->array.self.bc + i1 * elt_size,
l * elt_size);
} else {
FEbad_aet();
orig->array.self.bc + i1 * elt_size,
l * elt_size);
}
}
@ -1235,6 +1246,16 @@ ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
}
}
cl_object
si_copy_subarray(cl_object dest, cl_object start0,
cl_object orig, cl_object start1, cl_object length)
{
ecl_copy_subarray(dest, fixnnint(start0),
orig, fixnnint(start1),
fixnnint(length));
@(return dest)
}
cl_object
si_fill_array_with_elt(cl_object x, cl_object elt, cl_object start, cl_object end)
{

2
src/c/symbols_list.h
View file

@ -1914,7 +1914,7 @@ cl_symbols[] = {
{SYS_ "SEQUENCE-START-END", SI_ORDINARY, si_sequence_start_end, 4, OBJNULL},
{SYS_ "SEQUENCE-COUNT", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "SHRINK-VECTOR", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "COPY-SUBARRAY", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "COPY-SUBARRAY", SI_ORDINARY, si_copy_subarray, 5, OBJNULL},
{SYS_ "CONS-CAR", SI_ORDINARY, cl_car, 1, OBJNULL},
{SYS_ "CONS-CDR", SI_ORDINARY, cl_cdr, 1, OBJNULL},

2
src/c/symbols_list2.h
View file

@ -1914,7 +1914,7 @@ cl_symbols[] = {
{SYS_ "SEQUENCE-START-END","si_sequence_start_end"},
{SYS_ "SEQUENCE-COUNT",NULL},
{SYS_ "SHRINK-VECTOR",NULL},
{SYS_ "COPY-SUBARRAY",NULL},
{SYS_ "COPY-SUBARRAY","si_copy_subarray"},
{SYS_ "CONS-CAR","cl_car"},
{SYS_ "CONS-CDR","cl_cdr"},

1
src/cmp/cmputil.lsp
View file

@ -211,6 +211,7 @@
`(unless ,condition (cmperr ,string ,@args)))
(defun cmperr (string &rest args)
(break)
(let ((c (make-condition 'compiler-error
:format-control string
:format-arguments args)))

1
src/h/external.h
View file

@ -340,6 +340,7 @@ extern ECL_API cl_object si_replace_array(cl_object old_obj, cl_object new_obj);
extern ECL_API cl_object cl_aref _ARGS((cl_narg narg, cl_object x, ...));
extern ECL_API cl_object si_aset _ARGS((cl_narg narg, cl_object x, ...));
extern ECL_API cl_object si_make_pure_array(cl_object etype, cl_object dims, cl_object adj, cl_object fillp, cl_object displ, cl_object disploff);
extern ECL_API cl_object si_copy_subarray(cl_object dest, cl_object start0, cl_object orig, cl_object start1, cl_object length);
extern ECL_API cl_object si_fill_array_with_elt(cl_object array, cl_object elt, cl_object start, cl_object end);
extern ECL_API void FEwrong_dimensions(cl_object a, cl_index rank) ecl_attr_noreturn;

73
src/lsp/seqlib.lsp
View file

@ -18,6 +18,14 @@
(eval-when (:execute)
(load (merge-pathnames "seqmacros.lsp" *load-truename*)))
#-ecl-min
(eval-when (:compile-toplevel)
(define-compiler-macro copy-subarray (&rest args)
`(ffi:c-inline ,args (:object :fixnum :object :fixnum :fixnum) :void
"ecl_copy_subarray(#0,#1,#2,#3,#4)"
:one-liner t))
)
(defun seqtype (sequence)
(declare (si::c-local))
(cond ((listp sequence) 'list)
@ -118,29 +126,29 @@
(defun replace (sequence1 sequence2 &key (start1 0) end1 (start2 0) end2)
(with-start-end (start1 end1 sequence1)
(with-start-end (start2 end2 sequence2)
(if (and (eq sequence1 sequence2)
(> start1 start2))
(do* ((i 0 (1+ i))
(l (if (< (the fixnum (- end1 start1))
(the fixnum (- end2 start2)))
(- end1 start1)
(- end2 start2)))
(s1 (+ start1 (the fixnum (1- l))) (the fixnum (1- s1)))
(s2 (+ start2 (the fixnum (1- l))) (the fixnum (1- s2))))
((>= i l) sequence1)
(declare (fixnum i l s1 s2))
(setf (elt sequence1 s1) (elt sequence2 s2)))
(do ((i 0 (1+ i))
(l (if (< (the fixnum (- end1 start1))
(the fixnum (- end2 start2)))
(- end1 start1)
(- end2 start2)))
(s1 start1 (1+ s1))
(s2 start2 (1+ s2)))
((>= i l) sequence1)
(declare (fixnum i l s1 s2))
(setf (elt sequence1 s1) (elt sequence2 s2)))))))
(declare (optimize (speed 3) (safety 0) (debug 0)))
(let ((length (min (- end2 start2) (- end1 start1))))
(declare (fixnum length))
;; If the two sequences are arrays, we can use COPY-SUBARRAY.
;; Otherwise we have our own loop, which relies on sequence
;; iterators. It becomes inefficient when sequences overlap
;; because it has to save the data.
(if (and (vectorp sequence1)
(vectorp sequence2))
(copy-subarray sequence1 start1 sequence2 start2 length)
(do* ((data (if (and (eq sequence1 sequence2)
(> start1 start2))
(subseq sequence2 start2 end2)
sequence2))
(it2 (make-seq-iterator data start2)
(seq-iterator-next data it2))
(it1 (make-seq-iterator sequence1 start1)
(seq-iterator-next sequence1 it1)))
((or (<= length 0) (null it1) (null it2)))
(seq-iterator-set sequence1 it1
(seq-iterator-ref sequence2 it2))
(decf length))))))
sequence1)
(defun filter-vector (which out in start end from-end count
test test-not key)
@ -198,17 +206,8 @@
(setf (aref (the vector out) start) elt
start (1+ start))))
;; ... and copy the elements outside the limits
(values out (copy-subarray out start in end l)))))))
(defun copy-subarray (out start-out in start-in end-in)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(do* ((n end-in)
(i start-in (1+ i))
(j start-out (1+ j)))
((>= i n)
j)
(declare (fixnum i j n))
(row-major-aset out j (row-major-aref in i))))
(copy-subarray out start in end l)
(values out (+ start (- l end))))))))
(defun remove-list (which sequence start end count test test-not key)
(with-tests (test test-not key)
@ -580,9 +579,9 @@ Returns a copy of SEQUENCE without duplicated elements."
(declare (fixnum index jndex))
(loop
(when (= index end)
(return (if out
(copy-subarray out jndex in end length)
(+ jndex (- length end)))))
(return (progn
(when out (copy-subarray out jndex in end length))
(+ jndex (- length end)))))
(unless (already-in-vector-p in start index end from-end)
(when out
(setf (aref (the vector out) jndex)