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

New function SEQUENCE-START-END

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-20 12:30:52 +02:00
parent 8a29b98f94
commit ec0ddc1174
8 changed files with 52 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

40
src/c/sequence.d
View file

@ -18,6 +18,46 @@
#include <ecl/ecl.h>
#include <limits.h>
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
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)

32
src/c/string.d
View file

@ -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,

2
src/c/symbols_list.h
View file

@ -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}};

2
src/c/symbols_list2.h
View file

@ -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}};

2
src/cmp/proclamations.lsp
View file

@ -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

1
src/h/external.h
View file

@ -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);

6
src/h/internal.h
View file

@ -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 */

25
src/lsp/seqlib.lsp
View file

@ -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)))