mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 05:50:26 +02:00
* eval.c (SCM_CEVAL): Added code sections for handling of rpsubrs
with 3 or more args internally to the evaluator.
This commit is contained in:
parent
63a3d814b0
commit
71d3aa6de5
2 changed files with 31 additions and 0 deletions
|
@ -1,3 +1,8 @@
|
|||
Sat Mar 8 03:49:03 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
|
||||
|
||||
* eval.c (SCM_CEVAL): Added code sections for handling of rpsubrs
|
||||
with 3 or more args internally to the evaluator.
|
||||
|
||||
Fri Mar 7 19:38:18 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
|
||||
|
||||
* eval.c (SCM_CEVAL): Added code sections for handling of asubrs
|
||||
|
|
|
@ -2130,7 +2130,20 @@ evapply:
|
|||
RETURN (t.arg1)
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_rpsubr:
|
||||
#ifdef BUILTIN_RPASUBR
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (t.arg1, arg2)))
|
||||
RETURN (SCM_BOOL_F)
|
||||
t.arg1 = SCM_CDR (SCM_CDR (debug.info->a.args));
|
||||
do {
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, SCM_CAR (t.arg1))))
|
||||
RETURN (SCM_BOOL_F)
|
||||
arg2 = SCM_CAR (t.arg1);
|
||||
t.arg1 = SCM_CDR (t.arg1);
|
||||
} while (SCM_NIMP (t.arg1));
|
||||
RETURN (SCM_BOOL_T)
|
||||
#else /* BUILTIN_RPASUBR */
|
||||
RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, SCM_CDR (SCM_CDR (debug.info->a.args)), SCM_EOL)))
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_lsubr_2:
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CDR (SCM_CDR (debug.info->a.args))))
|
||||
case scm_tc7_lsubr:
|
||||
|
@ -2160,7 +2173,20 @@ evapply:
|
|||
RETURN (t.arg1)
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_rpsubr:
|
||||
#ifdef BUILTIN_RPASUBR
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (t.arg1, arg2)))
|
||||
RETURN (SCM_BOOL_F)
|
||||
do {
|
||||
t.arg1 = EVALCAR (x, env);
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, t.arg1)))
|
||||
RETURN (SCM_BOOL_F)
|
||||
arg2 = t.arg1;
|
||||
x = SCM_CDR (x);
|
||||
} while (SCM_NIMP (x));
|
||||
RETURN (SCM_BOOL_T)
|
||||
#else /* BUILTIN_RPASUBR */
|
||||
RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, scm_eval_args (x, env), SCM_EOL)));
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_lsubr_2:
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, scm_eval_args (x, env)));
|
||||
case scm_tc7_lsubr:
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue