mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-28 16:00:22 +02:00
generics now dispatch as applicable structs
* libguile/eval.i.c (CEVAL, SCM_APPLY): Dispatch applicable structs before pure generics. In practice what this means is that we never hit the mcache case, because all pure generics are applicable structs. We're moving over to having generics dispatch themselves. Also, they don't prepend the struct as an arg; in order to have that effect, the user has closures. * libguile/goops.c (scm_apply_generic, scm_call_generic_0): (scm_call_generic_1, scm_call_generic_2, scm_call_generic_3): Dispatch directly to the struct procedures. (scm_var_make_extended_generic): Remove a duplicate definition for scm_var_make_extended_generic. (create_standard_classes): Mark all instances of <applicable-struct-class> (themselves classes) as applicable classes. Meaning: generics are now applicable structs. * libguile/goops.h (SCM_CLASS_CLASS_LAYOUT): The hashsets are actually uw slots -- or at least, making subclasses maps the int slots to be uw slots * libguile/vm-i-system.c (call, goto/args, mv-call): Dispatch applicable structs in the VM. * module/oop/goops/dispatch.scm (emit-linear-dispatch): Fix bug in the non-rest cache miss case. (delayed-compile): Rework to avoid fluids. (cache-dispatch): Don't call `equal?', it causes bootstrapping problems with the primitive-generic equal?. Using our own version is faster anyway.
This commit is contained in:
parent
9f63ce021c
commit
2f652c6884
5 changed files with 107 additions and 112 deletions
|
@ -1026,22 +1026,20 @@ dispatch:
|
|||
goto nontoplevel_begin;
|
||||
}
|
||||
case scm_tcs_struct:
|
||||
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||
#ifdef DEVAL
|
||||
debug.info->a.proc = proc;
|
||||
#endif
|
||||
goto evap0;
|
||||
}
|
||||
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
{
|
||||
x = SCM_GENERIC_METHOD_CACHE (proc);
|
||||
arg1 = SCM_EOL;
|
||||
goto type_dispatch;
|
||||
}
|
||||
else if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
arg1 = proc;
|
||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||
#ifdef DEVAL
|
||||
debug.info->a.proc = proc;
|
||||
debug.info->a.args = scm_list_1 (arg1);
|
||||
#endif
|
||||
goto evap1;
|
||||
}
|
||||
else
|
||||
goto badfun;
|
||||
case scm_tc7_subr_1:
|
||||
|
@ -1153,7 +1151,15 @@ dispatch:
|
|||
goto nontoplevel_begin;
|
||||
}
|
||||
case scm_tcs_struct:
|
||||
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||
#ifdef DEVAL
|
||||
debug.info->a.proc = proc;
|
||||
#endif
|
||||
goto evap1;
|
||||
}
|
||||
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
{
|
||||
x = SCM_GENERIC_METHOD_CACHE (proc);
|
||||
#ifdef DEVAL
|
||||
|
@ -1163,17 +1169,6 @@ dispatch:
|
|||
#endif
|
||||
goto type_dispatch;
|
||||
}
|
||||
else if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
arg2 = arg1;
|
||||
arg1 = proc;
|
||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||
#ifdef DEVAL
|
||||
debug.info->a.args = scm_cons (arg1, debug.info->a.args);
|
||||
debug.info->a.proc = proc;
|
||||
#endif
|
||||
goto evap2;
|
||||
}
|
||||
else
|
||||
goto badfun;
|
||||
case scm_tc7_subr_2:
|
||||
|
@ -1232,7 +1227,24 @@ dispatch:
|
|||
RETURN (scm_i_gsubr_apply (proc, arg1, arg2, SCM_UNDEFINED));
|
||||
#endif
|
||||
case scm_tcs_struct:
|
||||
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
operatorn:
|
||||
#ifdef DEVAL
|
||||
RETURN (SCM_APPLY (SCM_STRUCT_PROCEDURE (proc),
|
||||
debug.info->a.args,
|
||||
SCM_EOL));
|
||||
#else
|
||||
RETURN (SCM_APPLY (SCM_STRUCT_PROCEDURE (proc),
|
||||
scm_cons (arg1,
|
||||
scm_cons (arg2,
|
||||
scm_ceval_args (x,
|
||||
env,
|
||||
proc))),
|
||||
SCM_EOL));
|
||||
#endif
|
||||
}
|
||||
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
{
|
||||
x = SCM_GENERIC_METHOD_CACHE (proc);
|
||||
#ifdef DEVAL
|
||||
|
@ -1242,23 +1254,6 @@ dispatch:
|
|||
#endif
|
||||
goto type_dispatch;
|
||||
}
|
||||
else if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
operatorn:
|
||||
#ifdef DEVAL
|
||||
RETURN (SCM_APPLY (SCM_STRUCT_PROCEDURE (proc),
|
||||
scm_cons (proc, debug.info->a.args),
|
||||
SCM_EOL));
|
||||
#else
|
||||
RETURN (SCM_APPLY (SCM_STRUCT_PROCEDURE (proc),
|
||||
scm_cons2 (proc, arg1,
|
||||
scm_cons (arg2,
|
||||
scm_ceval_args (x,
|
||||
env,
|
||||
proc))),
|
||||
SCM_EOL));
|
||||
#endif
|
||||
}
|
||||
else
|
||||
goto badfun;
|
||||
case scm_tc7_subr_0:
|
||||
|
@ -1458,7 +1453,9 @@ dispatch:
|
|||
}
|
||||
#endif /* DEVAL */
|
||||
case scm_tcs_struct:
|
||||
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
goto operatorn;
|
||||
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
{
|
||||
#ifdef DEVAL
|
||||
arg1 = debug.info->a.args;
|
||||
|
@ -1468,8 +1465,6 @@ dispatch:
|
|||
x = SCM_GENERIC_METHOD_CACHE (proc);
|
||||
goto type_dispatch;
|
||||
}
|
||||
else if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
goto operatorn;
|
||||
else
|
||||
goto badfun;
|
||||
case scm_tc7_subr_2:
|
||||
|
@ -1764,7 +1759,18 @@ tail:
|
|||
#endif
|
||||
goto tail;
|
||||
case scm_tcs_struct:
|
||||
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||
#ifdef DEVAL
|
||||
debug.vect[0].a.proc = proc;
|
||||
#endif
|
||||
if (SCM_NIMP (proc))
|
||||
goto tail;
|
||||
else
|
||||
goto badproc;
|
||||
}
|
||||
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
{
|
||||
#ifdef DEVAL
|
||||
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
|
||||
|
@ -1773,25 +1779,6 @@ tail:
|
|||
#endif
|
||||
RETURN (scm_apply_generic (proc, args));
|
||||
}
|
||||
else if (SCM_STRUCT_APPLICABLE_P (proc))
|
||||
{
|
||||
/* operator */
|
||||
#ifdef DEVAL
|
||||
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
|
||||
#else
|
||||
args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
|
||||
#endif
|
||||
arg1 = proc;
|
||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||
#ifdef DEVAL
|
||||
debug.vect[0].a.proc = proc;
|
||||
debug.vect[0].a.args = scm_cons (arg1, args);
|
||||
#endif
|
||||
if (SCM_NIMP (proc))
|
||||
goto tail;
|
||||
else
|
||||
goto badproc;
|
||||
}
|
||||
else
|
||||
goto badproc;
|
||||
default:
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue