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

SI::WRONG-TYPE-ARGUMENT is now linked to cl_symbols

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-12-15 22:06:14 +01:00
parent 0f4aee0101
commit 161a613c07
6 changed files with 16 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/c/cinit.d
View file

@ -123,6 +123,12 @@ si_find_relative_package(cl_narg narg, cl_object package, ...)
@(return ECL_NIL);
}
extern cl_object
si_wrong_type_argument(cl_narg narg, cl_object object, cl_object type, ...)
{
return _ecl_funcall3(@'si::wrong-type-argument', object, type);
}
static cl_object si_simple_toplevel ()
{
cl_env_ptr env = ecl_process_env();

2
src/c/symbols_list.h
View file

@ -1782,7 +1782,7 @@ cl_symbols[] = {
{SYS_ "PACKAGE-CHILDREN", SI_ORDINARY, NULL, -1, OBJNULL},
/* #endif ECL_RELATIVE_PACKAGE_NAMES */
{SYS_ "WRONG-TYPE-ARGUMENT", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "WRONG-TYPE-ARGUMENT", SI_ORDINARY, si_wrong_type_argument, -1, OBJNULL},
{SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, OBJNULL},

5
src/c/symbols_list2.h
View file

@ -1782,7 +1782,7 @@ cl_symbols[] = {
{SYS_ "PACKAGE-CHILDREN",NULL},
/* #endif ECL_RELATIVE_PACKAGE_NAMES */
{SYS_ "WRONG-TYPE-ARGUMENT",NULL},
{SYS_ "WRONG-TYPE-ARGUMENT","si_wrong_type_argument"},
{SYS_ "*CURRENT-FORM*",NULL},
@ -2018,6 +2018,7 @@ cl_symbols[] = {
{SYS_ "ASSERT-FAILURE","ECL_NAME(si_assert_failure)"},
{SYS_ "ECASE-ERROR","ECL_NAME(si_ecase_error)"},
{SYS_ "ETYPECASE-ERROR","ECL_NAME(si_etypecase_error)"},
{SYS_ "DO-CHECK-TYPE","ECL_NAME(si_do_check_type)"},
{SYS_ "SERIALIZE","si_serialize"},
{SYS_ "DESERIALIZE","si_deserialize"},
@ -2315,7 +2316,5 @@ cl_symbols[] = {
{SYS_ "BIND-SIMPLE-RESTARTS","ECL_NAME(si_bind_simple_restarts)"},
{SYS_ "BIND-SIMPLE-HANDLERS","ECL_NAME(si_bind_simple_handlers)"},
{SYS_ "DO-CHECK-TYPE","ECL_NAME(si_do_check_type)"},
/* Tag for end of list */
{NULL,NULL}};

6
src/c/typespec.d
View file

@ -93,9 +93,9 @@ cl_object
ecl_type_error(cl_object function, const char *place, cl_object o,
cl_object type)
{
return funcall(5, @'si::wrong-type-argument', o, type,
(*place? make_constant_base_string(place) : ECL_NIL),
function);
si_wrong_type_argument(4, o, type,
(*place? make_constant_base_string(place) : ECL_NIL),
function);
}
/**********************************************************************/

1
src/cmp/sysfun.lsp
View file

@ -880,6 +880,7 @@
vector-pop adjust-array
;; assert.lsp
si::do-check-type si::ecase-error si::etypecase-error
si::wrong-type-argument
;; assignment.lsp
si::setf-definition
;; conditions.lsp

3
src/h/external.h
View file

@ -2167,6 +2167,9 @@ extern ECL_API cl_object cl_use_value _ECL_ARGS((cl_narg narg, cl_object value,
extern ECL_API cl_object si_bind_simple_restarts(cl_object tag, cl_object names);
extern ECL_API cl_object si_bind_simple_handlers(cl_object tag, cl_object names);
extern ECL_API cl_object si_assert_failure _ECL_ARGS((cl_narg narg, cl_object V1, ...));
/* assert.lsp */
extern ECL_API cl_object si_wrong_type_argument _ECL_ARGS((cl_narg narg, cl_object value, cl_object type, ...));
extern ECL_API cl_object si_ecase_error(cl_object value, cl_object values);
extern ECL_API cl_object si_etypecase_error(cl_object value, cl_object type);
extern ECL_API cl_object si_do_check_type(cl_object value, cl_object type, cl_object type_string, cl_object place);