mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 23:10:21 +02:00
Code Activity

* eval.c (SCM_CEVAL): Added code sections for handling of rpsubrs

Browse source 
with 3 or more args internally to the evaluator.
This commit is contained in:
Mikael Djurfeldt 1997-03-08 03:03:16 +00:00
parent 63a3d814b0
commit 71d3aa6de5
2 changed files with 31 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/ChangeLog
View file

@ -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

26
libguile/eval.c
View file

@ -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: