mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-17 06:42:18 -08:00
Code Issues Projects Releases Packages Wiki Activity

Replaced ecl_check_type_string with FEwrong_type_*_arg

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-02-25 22:22:12 +01:00
parent c41efce884
commit 9da71f93a9
11 changed files with 23 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/array.d
View file

@ -858,7 +858,7 @@ cl_array_displacement(cl_object a)
cl_index offset;
if (!ECL_ARRAYP(a))
FEwrong_type_only_arg(@'adjustable-displacement', a, @'array');
FEwrong_type_only_arg(@'array-displacement', a, @'array');
to_array = a->array.displaced;
if (Null(to_array)) {
offset = 0;

6
src/c/hash.d
View file

@ -28,7 +28,7 @@ static void corrupted_hash(cl_object hashtable) /*__attribute__((noreturn))*/;
#define SYMBOL_NAME(x) (Null(x)? Cnil_symbol->symbol.name : (x)->symbol.name)
static void
assert_type_hash_table(cl_object fun, cl_narg narg, cl_object p)
assert_type_hash_table(cl_object function, cl_narg narg, cl_object p)
{
if (type_of(p) != t_hashtable)
FEwrong_type_nth_arg(function, narg, p, @'hash-table');
@ -446,7 +446,7 @@ _ecl_sethash(cl_object key, cl_object hashtable, cl_object value)
cl_object
ecl_sethash(cl_object key, cl_object hashtable, cl_object value)
{
assert_type_hash_table(@'si::sethash', 2, hashtable);
assert_type_hash_table(@'si::hash-set', 2, hashtable);
HASH_TABLE_LOCK(hashtable);
hashtable = hashtable->hash.set(key, hashtable, value);
HASH_TABLE_UNLOCK(hashtable);
@ -460,7 +460,7 @@ ecl_extend_hashtable(cl_object hashtable)
cl_index old_size, new_size, i;
cl_object new_size_obj;
assert_type_hash_table(@'si::sethash', 2, hashtable);
assert_type_hash_table(@'si::hash-set', 2, hashtable);
old_size = hashtable->hash.size;
/* We do the computation with lisp datatypes, just in case the sizes contain
* weird numbers */

4
src/c/list.d
View file

@ -683,7 +683,7 @@ cl_ldiff(cl_object x, cl_object y)
cl_object
cl_rplaca(cl_object x, cl_object v)
{
if (!ECL_CONSP(x))
if (!CONSP(x))
FEwrong_type_nth_arg(@'rplaca', 1, x, @'cons');
ECL_RPLACA(x, v);
@(return x)
@ -692,7 +692,7 @@ cl_rplaca(cl_object x, cl_object v)
cl_object
cl_rplacd(cl_object x, cl_object v)
{
if (!ECL_CONSP(x))
if (!CONSP(x))
FEwrong_type_nth_arg(@'rplacd', 1, x, @'cons');
ECL_RPLACD(x, v);
@(return x)

3
src/c/package.d
View file

@ -305,7 +305,8 @@ ecl_intern(cl_object name, cl_object p, int *intern_flag)
{
cl_object s, ul;
name = ecl_check_type_string(@'intern', name);
if (!ECL_STRINGP(name))
FEwrong_type_nth_arg(@'intern', 1, name, @'string');
p = si_coerce_to_package(p);
TRY_AGAIN_LABEL:
s = find_symbol_inner(name, p, intern_flag);

7
src/c/pathname.d
View file

@ -1387,7 +1387,8 @@ coerce_to_from_pathname(cl_object x, cl_object host)
cl_object pair, l;
@
/* Check that host is a valid host name */
host = ecl_check_type_string(@'si::pathname-translations',host);
if (!ECL_STRINGP(host))
FEwrong_type_nth_arg(@'si::pathname-translations', 1, host, @'string');
len = ecl_length(host);
parse_word(host, is_null, WORD_LOGICAL, 0, len, &parsed_len);
if (parsed_len < len) {
@ -1399,7 +1400,9 @@ coerce_to_from_pathname(cl_object x, cl_object host)
@(return ((pair == Cnil)? Cnil : CADR(pair)));
}
/* Set the new translation list */
assert_type_list(set);
if (!LISTP(set)) {
FEwrong_type_nth_arg(@'si::pathname-translations', 2, set, @'list');
}
if (pair == Cnil) {
pair = CONS(host, CONS(Cnil, Cnil));
cl_core.pathname_translations = CONS(pair, cl_core.pathname_translations);

6
src/c/print.d
View file

@ -1905,7 +1905,8 @@ potential_number_p(cl_object strng, int base)
@(defun write-string (strng &o strm &k (start MAKE_FIXNUM(0)) end)
@
strng = ecl_check_type_string(@'write-string', strng);
if (!ECL_STRINGP(strng))
FEwrong_type_nth_arg(@'write-string', 1, strng, @'string');
strm = stream_or_default_output(strm);
#ifdef ECL_CLOS_STREAMS
if (type_of(strm) != t_stream)
@ -1918,7 +1919,8 @@ potential_number_p(cl_object strng, int base)
@(defun write-line (strng &o strm &k (start MAKE_FIXNUM(0)) end)
@
strng = ecl_check_type_string(@'write-line', strng);
if (!ECL_STRINGP(strng))
FEwrong_type_nth_arg(@'write-line', 1, strng, @'string');
strm = stream_or_default_output(strm);
#ifdef ECL_CLOS_STREAMS
if (type_of(strm) != t_stream)

3
src/c/read.d
View file

@ -1805,7 +1805,8 @@ EOFCHK: if (c == EOF && TOKEN_STRING_FILLP(token) == 0) {
cl_index s, e, ep;
cl_object rtbl = ecl_current_readtable();
@ {
strng = ecl_check_type_string(@'parse-integer', strng);
if (!ECL_STRINGP(strng))
FEwrong_type_nth_arg(@'parse-integer', 1, strng, @'string');
get_string_start_end(strng, start, end, &s, &e);
if (!FIXNUMP(radix) ||
fix(radix) < 2 || fix(radix) > 36)

3
src/c/string.d
View file

@ -865,7 +865,8 @@ nstring_case(cl_narg narg, cl_object fun, ecl_casefun casefun, cl_va_list ARGS)
KEYS[1]=@':end';
cl_parse_key(ARGS, 2, KEYS, KEY_VARS, NULL, FALSE);
strng = ecl_check_type_string(fun,strng);
if (!ECL_STRINGP(strng))
FEwrong_type_nth_arg(fun, 1, strng, @'string');
if (startp == Cnil) start = MAKE_FIXNUM(0);
get_string_start_end(strng, start, end, &s, &e);
b = TRUE;

3
src/c/symbol.d
View file

@ -358,7 +358,8 @@ cl_symbol_name(cl_object x)
cl_object output, s;
int intern_flag;
@
prefix = ecl_check_type_string(@'gentemp', prefix);
if (!ECL_STRINGP(prefix))
FEwrong_type_nth_arg(@'gentemp', 1, prefix, @'string');
pack = si_coerce_to_package(pack);
ONCE_MORE:
output = ecl_make_string_output_stream(64, 1);

19
src/c/typespec.d
View file

@ -180,25 +180,6 @@ ecl_check_cl_type(cl_object fun, cl_object p, cl_type t)
return p;
}
cl_object
ecl_check_type_string(cl_object fun, cl_object p)
{
cl_type t;
AGAIN:
t = type_of(p);
if (t != t_base_string) {
#ifdef ECL_UNICODE
if (t != t_string)
#endif
{
p = ecl_type_error(fun,"",p,@'string');
goto AGAIN;
}
}
return p;
}
void
assert_type_integer(cl_object p)
{

1
src/h/external.h
View file

@ -1700,7 +1700,6 @@ extern ECL_API void FEtype_error_array(cl_object x) ecl_attr_noreturn;
extern ECL_API void FEdivision_by_zero(cl_object x, cl_object y) ecl_attr_noreturn;
extern ECL_API cl_object ecl_type_error(cl_object function, const char *place, cl_object o, cl_object type);
extern ECL_API cl_object ecl_check_cl_type(cl_object fun, cl_object p, cl_type t);
extern ECL_API cl_object ecl_check_type_string(cl_object fun, cl_object p);
/* unixfsys.c */