From ec0ddc11748bc9f65a5cbb49dea2b25a492c39da Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 20 May 2010 12:30:52 +0200 Subject: [PATCH] New function SEQUENCE-START-END --- src/c/sequence.d | 40 +++++++++++++++++++++++++++++++++++++++ src/c/string.d | 32 ------------------------------- src/c/symbols_list.h | 2 ++ src/c/symbols_list2.h | 2 ++ src/cmp/proclamations.lsp | 2 ++ src/h/external.h | 1 + src/h/internal.h | 6 ++++-- src/lsp/seqlib.lsp | 25 +----------------------- 8 files changed, 52 insertions(+), 58 deletions(-) diff --git a/src/c/sequence.d b/src/c/sequence.d index d2212f09f..8515a05ca 100644 --- a/src/c/sequence.d +++ b/src/c/sequence.d @@ -18,6 +18,46 @@ #include #include #include +#include + +cl_index_pair +ecl_sequence_start_end(cl_object fun, cl_object sequence, + cl_object start, cl_object end) +{ + cl_index_pair p; + cl_index l; + l = ecl_length(sequence); + unlikely_if (!ECL_FIXNUMP(start) || ecl_fixnum_minusp(start)) { + FEwrong_type_key_arg(fun, @[:start], start, @[byte]); + } + p.start = fix(start); + if (Null(end)) { + p.end = l; + } else { + unlikely_if (!FIXNUMP(end) || ecl_fixnum_minusp(end)) { + FEwrong_type_key_arg(fun, @[:end], end, + ecl_read_from_cstring("(OR NULL BYTE)")); + } + p.end = fix(end); + unlikely_if (p.end > l) { + cl_object fillp = MAKE_FIXNUM(l); + FEwrong_type_key_arg(fun, @[:end], end, + ecl_make_integer_type(start, fillp)); + } + } + unlikely_if (p.end < p.start) { + FEwrong_type_key_arg(fun, @[:start], start, + ecl_make_integer_type(MAKE_FIXNUM(0), end)); + } + return p; +} + +cl_object +si_sequence_start_end(cl_object fun, cl_object sequence, cl_object start, cl_object end) +{ + cl_index_pair p = ecl_sequence_start_end(fun, sequence, start, end); + @(return MAKE_FIXNUM(p.start) MAKE_FIXNUM(p.end)); +} cl_object cl_elt(cl_object x, cl_object i) diff --git a/src/c/string.d b/src/c/string.d index d97bb59ed..38ee6ec29 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -355,38 +355,6 @@ ecl_char_set(cl_object object, cl_index index, ecl_character value) } } -cl_index_pair -ecl_vector_start_end(cl_object fun, - cl_object string, cl_object start, cl_object end) -{ - /* INV: works on both t_base_string and t_string */ - /* INV: Works with either string or symbol */ - cl_index_pair p; - unlikely_if (!ECL_FIXNUMP(start) || ecl_fixnum_minusp(start)) { - FEwrong_type_key_arg(fun, @[:start], start, @[byte]); - } - p.start = fix(start); - if (Null(end)) { - p.end = string->vector.fillp; - } else { - unlikely_if (!FIXNUMP(end) || ecl_fixnum_minusp(end)) { - FEwrong_type_key_arg(fun, @[:end], end, - ecl_read_from_cstring("(OR NULL BYTE)")); - } - p.end = fix(end); - unlikely_if (p.end > string->vector.fillp) { - cl_object fillp = MAKE_FIXNUM(string->vector.fillp); - FEwrong_type_key_arg(fun, @[:end], end, - ecl_make_integer_type(start, fillp)); - } - } - unlikely_if (p.end < p.start) { - FEwrong_type_key_arg(fun, @[:start], start, - ecl_make_integer_type(MAKE_FIXNUM(0), end)); - } - return p; -} - #ifdef ECL_UNICODE static int compare_strings(cl_object string1, cl_index s1, cl_index e1, diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 815bd449c..00d635794 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1911,5 +1911,7 @@ cl_symbols[] = { {EXT_ "COMPLEX-ARRAY", EXT_ORDINARY, NULL, -1, OBJNULL}, +{SYS_ "SEQUENCE-START-END", SI_ORDINARY, si_sequence_start_end, 4, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 50515e5e0..b634321ed 100755 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1911,5 +1911,7 @@ cl_symbols[] = { {EXT_ "COMPLEX-ARRAY",NULL}, +{SYS_ "SEQUENCE-START-END","si_sequence_start_end"}, + /* Tag for end of list */ {NULL,NULL}}; diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 8526ddbbf..297fa3e39 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -905,6 +905,8 @@ (proclamation si::seq-iterator-ref (sequence t) t :reader) (proclamation si::seq-iterator-set (sequence t t) t :no-sp-change) (proclamation si::seq-iterator-next (sequence t) t :reader) +(proclamation si::sequence-start-end (t sequence sequence-index (or null sequence-index)) + (values fixnum fixnum) :no-side-effects) ;;; ;;; 18. HASH TABLES diff --git a/src/h/external.h b/src/h/external.h index 7a74987b0..1bc7f7222 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -1477,6 +1477,7 @@ extern ECL_API bool ecl_boundp(cl_env_ptr env, cl_object o); /* sequence.c */ +extern ECL_API cl_object si_sequence_start_end(cl_object fun, cl_object sequence, cl_object start, cl_object end); extern ECL_API cl_object cl_elt(cl_object x, cl_object i); extern ECL_API cl_object si_elt_set(cl_object seq, cl_object index, cl_object val); extern ECL_API cl_object cl_copy_seq(cl_object x); diff --git a/src/h/internal.h b/src/h/internal.h index 5b79513b9..ca4c01fe3 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -298,10 +298,12 @@ extern void cl_write_object(cl_object x, cl_object stream); #define RTABSIZE CHAR_CODE_LIMIT /* read table size */ #endif -/* string.d */ +/* sequence.d */ typedef struct { cl_index start, end; } cl_index_pair; -extern ECL_API cl_index_pair ecl_vector_start_end(cl_object fun, cl_object s, cl_object start, cl_object end); +extern ECL_API cl_index_pair ecl_sequence_start_end(cl_object fun, cl_object s, cl_object start, cl_object end); +/* string.d */ +#define ecl_vector_start_end ecl_sequence_start_end /* threads.d */ diff --git a/src/lsp/seqlib.lsp b/src/lsp/seqlib.lsp index 8deb521ce..b0cdae089 100644 --- a/src/lsp/seqlib.lsp +++ b/src/lsp/seqlib.lsp @@ -33,29 +33,6 @@ (optimize (speed 3) (safety 0))) (funcall f x)) -(defun sequence-limits (start end seq) - (declare (si::c-local)) - (let* (x0 x1 (l (length seq))) - (declare (fixnum x0 x1 l)) - (unless (and (fixnump start) (>= (setq x0 start) 0)) - (error 'simple-type-error - :format-control "~S is not a valid :START for sequence ~S" - :format-arguments (list start seq) - :datum start - :expected-type `(integer 0 ,l))) - (if end - (unless (and (fixnump end) (>= (setq x1 end) 0)) - (error 'simple-type-error - :format-control "~S is not a valid :END for sequence ~S" - :format-arguments (list end seq) - :datum end - :expected-type `(or nil (integer 0 ,l)))) - (setq x1 l)) - (unless (<= x0 x1) - (error ":START = ~S should be smaller or equal to :END = ~S" - start end)) - (values x0 x1))) - (eval-when (:compile-toplevel :execute) (defmacro with-predicate ((predicate) &body body) `(let ((,predicate (si::coerce-to-function ,predicate))) @@ -85,7 +62,7 @@ ,@body))) (defmacro with-start-end (start end seq &body body) `(multiple-value-bind (,start ,end) - (sequence-limits ,start ,end ,seq) + (sequence-start-end 'subseq ,seq ,start ,end) (declare (fixnum ,start ,end)) ,@body)))