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

STD-COMPUTE-EFFECTIVE-METHOD and friends are called directly

Browse source
This commit is contained in:
Juanjo Garcia-Ripoll 2012-04-27 14:00:03 +02:00
parent a366111a71
commit 2cc751eef8
8 changed files with 44 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/c/cinit.d
View file

@ -46,6 +46,24 @@ si_safe_eval(cl_narg narg, cl_object form, cl_object env, ...)
return cl_funcall(3, @'ext::safe-eval', form, env);
}
extern cl_object
clos_std_compute_applicable_methods(cl_object gf, cl_object arglist)
{
return _ecl_funcall3(@'clos::std-compute-applicable-methods', gf, arglist);
}
extern cl_object
clos_std_compute_effective_method(cl_object gf, cl_object combination, cl_object methods_list)
{
return _ecl_funcall4(@'clos::std-compute-effective-method', gf, combination, methods_list);
}
extern cl_object
clos_compute_effective_method_function(cl_object gf, cl_object combination, cl_object methods_list)
{
return _ecl_funcall4(@'clos::compute-effective-method-function', gf, combination, methods_list);
}
extern cl_object
si_string_to_object(cl_narg narg, cl_object string, ...)
{

3
src/c/eval.d
View file

@ -62,14 +62,13 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x)
return _ecl_standard_dispatch(frame, fun);
case ECL_USER_DISPATCH:
fun = fun->instance.slots[fun->instance.length - 1];
break;
goto AGAIN;
case ECL_READER_DISPATCH:
case ECL_WRITER_DISPATCH:
return APPLY(narg, fun->instance.entry, sp);
default:
FEinvalid_function(fun);
}
goto AGAIN;
#endif
case t_symbol:
if (ecl_unlikely(fun->symbol.stype & stp_macro))

14
src/c/gfun.d
View file

@ -168,11 +168,11 @@ generic_compute_applicable_method(cl_env_ptr env, cl_object frame, cl_object gf)
cl_object memoize;
cl_object methods = _ecl_funcall3(@'clos::compute-applicable-methods-using-classes',
gf, frame_to_classes(frame));
if (Null(memoize = env->values[1])) {
unlikely_if (Null(memoize = env->values[1])) {
cl_object arglist = frame_to_list(frame);
methods = _ecl_funcall3(@'compute-applicable-methods',
gf, arglist);
if (methods == Cnil) {
unlikely_if (methods == Cnil) {
cl_object func = _ecl_funcall3(@'no-applicable-method',
gf, arglist);
frame->frame.base[0] = OBJNULL;
@ -180,8 +180,7 @@ generic_compute_applicable_method(cl_env_ptr env, cl_object frame, cl_object gf)
return func;
}
}
methods = _ecl_funcall4(@'clos::compute-effective-method-function', gf,
GFUN_COMB(gf), methods);
methods = clos_compute_effective_method_function(gf, GFUN_COMB(gf), methods);
env->values[1] = Ct;
return methods;
}
@ -191,15 +190,14 @@ restricted_compute_applicable_method(cl_env_ptr env, cl_object frame, cl_object
{
/* method not cached */
cl_object arglist = frame_to_list(frame);
cl_object methods = _ecl_funcall3(@'clos::std-compute-applicable-methods', gf, arglist);
if (methods == Cnil) {
cl_object methods = clos_std_compute_applicable_methods(gf, arglist);
unlikely_if (methods == Cnil) {
cl_object func = _ecl_funcall3(@'no-applicable-method', gf, arglist);
frame->frame.base[0] = OBJNULL;
env->values[1] = Cnil;
return func;
}
methods = _ecl_funcall4(@'clos::std-compute-effective-method', gf,
GFUN_COMB(gf), methods);
methods = clos_std_compute_effective_method(gf, GFUN_COMB(gf), methods);
env->values[1] = Ct;
return methods;
}

6
src/c/symbols_list.h
View file

@ -1729,10 +1729,10 @@ cl_symbols[] = {
{CLOS_ "STANDARD-READER-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STANDARD-SLOT-DEFINITION", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STANDARD-WRITER-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STD-COMPUTE-APPLICABLE-METHODS", CLOS_ORDINARY, NULL, 2, OBJNULL},
{CLOS_ "STD-COMPUTE-APPLICABLE-METHODS", CLOS_ORDINARY, ECL_NAME(clos_std_compute_applicable_methods), 2, OBJNULL},
{CLOS_ "STD-COMPUTE-APPLICABLE-METHODS-USING-CLASSES", CLOS_ORDINARY, NULL, 2, OBJNULL},
{CLOS_ "STD-COMPUTE-EFFECTIVE-METHOD", CLOS_ORDINARY, NULL, 3, OBJNULL},
{CLOS_ "COMPUTE-EFFECTIVE-METHOD-FUNCTION", CLOS_ORDINARY, NULL, 3, OBJNULL},
{CLOS_ "STD-COMPUTE-EFFECTIVE-METHOD", CLOS_ORDINARY, ECL_NAME(clos_std_compute_effective_method), 3, OBJNULL},
{CLOS_ "COMPUTE-EFFECTIVE-METHOD-FUNCTION", CLOS_ORDINARY, ECL_NAME(clos_compute_effective_method_function), 3, OBJNULL},
{CLOS_ "UPDATE-DEPENDENT", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "VALIDATE-SUPERCLASS", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "WRITER-METHOD-CLASS", CLOS_ORDINARY, NULL, -1, OBJNULL},

6
src/c/symbols_list2.h
View file

@ -1729,10 +1729,10 @@ cl_symbols[] = {
{CLOS_ "STANDARD-READER-METHOD",NULL},
{CLOS_ "STANDARD-SLOT-DEFINITION",NULL},
{CLOS_ "STANDARD-WRITER-METHOD",NULL},
{CLOS_ "STD-COMPUTE-APPLICABLE-METHODS",NULL},
{CLOS_ "STD-COMPUTE-APPLICABLE-METHODS","ECL_NAME(clos_std_compute_applicable_methods)"},
{CLOS_ "STD-COMPUTE-APPLICABLE-METHODS-USING-CLASSES",NULL},
{CLOS_ "STD-COMPUTE-EFFECTIVE-METHOD",NULL},
{CLOS_ "COMPUTE-EFFECTIVE-METHOD-FUNCTION",NULL},
{CLOS_ "STD-COMPUTE-EFFECTIVE-METHOD","ECL_NAME(clos_std_compute_effective_method)"},
{CLOS_ "COMPUTE-EFFECTIVE-METHOD-FUNCTION","ECL_NAME(clos_compute_effective_method_function)"},
{CLOS_ "UPDATE-DEPENDENT",NULL},
{CLOS_ "VALIDATE-SUPERCLASS",NULL},
{CLOS_ "WRITER-METHOD-CLASS",NULL},

7
src/cmp/proclamations.lsp
View file

@ -285,6 +285,13 @@
;; Slot accessors:
; (proclamation unbound-slot-instance (condition) si::instance :predicate)
#+clos
(proclamation clos:std-compute-applicable-methods (generic-function list) list)
#+clos
(proclamation clos:std-compute-effective-method (generic-function method-combination list) function)
#+clos
(proclamation clos:compute-effective-method-function (generic-function method-combination list) function)
;;;
;;; 8. STRUCTURES
;;;

3
src/cmp/sysfun.lsp
View file

@ -920,6 +920,9 @@
,@'(;; combin.lsp
method-combination-error
invalid-method-error
clos:std-compute-applicable-methods
clos:std-compute-effective-method
clos:compute-effective-method-function
;; standard-instance-access ; this function is a synonym for si:instance-ref
;; funcallable-standard-instance-access ; same for this one
subclassp of-class-p

3
src/h/external.h
View file

@ -2099,6 +2099,9 @@ extern ECL_API cl_object cl_set_pprint_dispatch _ARGS((cl_narg narg, cl_object V
/* combin.lsp */
extern ECL_API cl_object cl_method_combination_error _ARGS((cl_narg narg, cl_object format, ...));
extern ECL_API cl_object cl_invalid_method_error _ARGS((cl_narg narg, cl_object method, cl_object format, ...));
extern ECL_API cl_object clos_std_compute_applicable_methods(cl_object gf, cl_object arglist);
extern ECL_API cl_object clos_std_compute_effective_method(cl_object gf, cl_object combination, cl_object methods_list);
extern ECL_API cl_object clos_compute_effective_method_function(cl_object gf, cl_object combination, cl_object methods_list);
/* boot.lsp */
extern ECL_API cl_object cl_slot_boundp(cl_object object, cl_object slot);