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

Moved assert_type_readtable() to read.d and added more information to the error message.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-02-25 21:50:32 +01:00
parent 0e68fa26a5
commit e664971e42
3 changed files with 18 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

28
src/c/read.d
View file

@ -1424,6 +1424,14 @@ sharp_dollar_reader(cl_object in, cl_object c, cl_object d)
readtable routines
*/
static void
assert_type_readtable(cl_object function, cl_narg narg, cl_object p)
{
if (type_of(p) != t_readtable)
FEwrong_type_nth_arg(function, narg, p, @'readtable');
}
cl_object
ecl_copy_readtable(cl_object from, cl_object to)
{
@ -1433,7 +1441,7 @@ ecl_copy_readtable(cl_object from, cl_object to)
size_t total_bytes = entry_bytes * RTABSIZE;
cl_object output;
assert_type_readtable(from);
assert_type_readtable(@'copy-readtable', 1, from);
/* For the sake of garbage collector and thread safety we
* create an incomplete object and only copy to the destination
* at the end in a more or less "atomic" (meaning "fast") way.
@ -1460,7 +1468,7 @@ ecl_copy_readtable(cl_object from, cl_object to)
}
#endif
if (!Null(to)) {
assert_type_readtable(to);
assert_type_readtable(@'copy-readtable', 2, to);
to->readtable = output->readtable;
output = to;
}
@ -1869,7 +1877,7 @@ CANNOT_PARSE: FEparse_error("Cannot parse an integer in the string ~S.",
cl_object
cl_readtable_case(cl_object r)
{
assert_type_readtable(r);
assert_type_readtable(@'readtable-case', 1, r);
switch (r->readtable.read_case) {
case ecl_case_upcase: r = @':upcase'; break;
case ecl_case_downcase: r = @':downcase'; break;
@ -1891,7 +1899,7 @@ error_locked_readtable(cl_object r)
cl_object
si_readtable_case_set(cl_object r, cl_object mode)
{
assert_type_readtable(r);
assert_type_readtable(@'readtable-case', 1, r);
if (r->readtable.locked) {
error_locked_readtable(r);
}
@ -1994,8 +2002,8 @@ ecl_invalid_character_p(int c)
}
if (Null(fromrdtbl))
fromrdtbl = cl_core.standard_readtable;
assert_type_readtable(fromrdtbl);
assert_type_readtable(tordtbl);
assert_type_readtable(@'readtable-case', 1, tochr);
assert_type_readtable(@'readtable-case', 2, fromchr);
fc = ecl_char_code(fromchr);
tc = ecl_char_code(tochr);
@ -2036,7 +2044,7 @@ ecl_invalid_character_p(int c)
cl_object table;
int c;
@
assert_type_readtable(readtable);
assert_type_readtable(@'make-dispatch-macro-character', 3, readtable);
c = ecl_char_code(chr);
cat = Null(non_terminating_p)? cat_terminating : cat_non_terminating;
table = cl__make_hash_table(@'eql', MAKE_FIXNUM(128),
@ -2052,7 +2060,7 @@ ecl_invalid_character_p(int c)
cl_object table;
cl_fixnum subcode;
@
assert_type_readtable(readtable);
assert_type_readtable(@'set-dispatch-macro-character', 4, readtable);
ecl_readtable_get(readtable, ecl_char_code(dspchr), &table);
if (readtable->readtable.locked) {
error_locked_readtable(readtable);
@ -2087,7 +2095,7 @@ ecl_invalid_character_p(int c)
if (Null(readtable)) {
readtable = cl_core.standard_readtable;
}
assert_type_readtable(readtable);
assert_type_readtable(@'get-dispatch-macro-character', 3, readtable);
c = ecl_char_code(dspchr);
ecl_readtable_get(readtable, c, &table);
if (type_of(table) != t_hashtable) {
@ -2111,7 +2119,7 @@ si_standard_readtable()
@(defun ext::readtable-lock (r &optional yesno)
cl_object output;
@
assert_type_readtable(r);
assert_type_readtable(@'ext::readtable-lock', 1, r);
output = (r->readtable.locked)? Ct : Cnil;
if (narg > 1) {
r->readtable.locked = !Null(yesno);

7
src/c/typespec.d
View file

@ -231,13 +231,6 @@ assert_type_proper_list(cl_object p)
FEcircular_list(p);
}
void
assert_type_readtable(cl_object p)
{
if (type_of(p) != t_readtable)
FEwrong_type_argument(@'readtable', p);
}
void
assert_type_hash_table(cl_object p)
{

1
src/h/external.h
View file

@ -1686,7 +1686,6 @@ extern ECL_API cl_object cl_get_universal_time(void);
extern ECL_API void assert_type_integer(cl_object p);
extern ECL_API void assert_type_non_negative_integer(cl_object p);
extern ECL_API void assert_type_readtable(cl_object p);
extern ECL_API void assert_type_hash_table(cl_object p);
extern ECL_API void assert_type_proper_list(cl_object p);
extern ECL_API cl_object cl_type_of(cl_object x);