summaryrefslogtreecommitdiff
path: root/libguile/eval.i.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/eval.i.c')
-rw-r--r--libguile/eval.i.c103
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;