diff options
Diffstat (limited to 'libguile/eval.i.c')
-rw-r--r-- | libguile/eval.i.c | 103 |
1 files changed, 45 insertions, 58 deletions
diff --git a/libguile/eval.i.c b/libguile/eval.i.c index 16ca837b4..d78f498d7 100644 --- a/libguile/eval.i.c +++ b/libguile/eval.i.c @@ -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,33 +1227,33 @@ 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) - { - x = SCM_GENERIC_METHOD_CACHE (proc); -#ifdef DEVAL - arg1 = debug.info->a.args; -#else - arg1 = scm_list_2 (arg1, arg2); -#endif - goto type_dispatch; - } - else if (SCM_STRUCT_APPLICABLE_P (proc)) + if (SCM_STRUCT_APPLICABLE_P (proc)) { operatorn: #ifdef DEVAL RETURN (SCM_APPLY (SCM_STRUCT_PROCEDURE (proc), - scm_cons (proc, debug.info->a.args), + 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, + 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 + arg1 = debug.info->a.args; +#else + arg1 = scm_list_2 (arg1, arg2); +#endif + goto type_dispatch; + } 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,33 +1759,25 @@ 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 - args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args); -#else - args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args)); + debug.vect[0].a.proc = proc; #endif - RETURN (scm_apply_generic (proc, args)); + if (SCM_NIMP (proc)) + goto tail; + else + goto badproc; } - else if (SCM_STRUCT_APPLICABLE_P (proc)) + else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) { - /* 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; + RETURN (scm_apply_generic (proc, args)); } else goto badproc; |