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

* debug.c (scm_make_memoized): Made it available at scheme level.

Browse source 
(scm_unmemoize, scm_memoized_environment): Bugfix: Check for
SCM_NIMP before applying heavier predicates in argument checking.
(scm_local_eval): Also take memoized object as argument.
This commit is contained in:
Mikael Djurfeldt 1996-10-17 23:32:40 +00:00
parent d043d8c221
commit 6c1797119b
1 changed files with 10 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/debug.c
View file

@ -160,12 +160,14 @@ scm_memoized_p (obj)
return SCM_NIMP (obj) && SCM_MEMOIZEDP (obj) ? SCM_BOOL_T : SCM_BOOL_F; return SCM_NIMP (obj) && SCM_MEMOIZEDP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
} }
SCM_PROC (s_make_memoized, "make-memoized", 2, 0, 0, scm_make_memoized);
SCM SCM
scm_make_memoized (exp, env) scm_make_memoized (exp, env)
SCM exp; SCM exp;
SCM env; SCM env;
{ {
/* *fixme* Check that env is a valid environment. */
register SCM z, ans; register SCM z, ans;
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_NEWCELL (z); SCM_NEWCELL (z);
@ -184,7 +186,7 @@ SCM
scm_unmemoize (m) scm_unmemoize (m)
SCM m; SCM m;
{ {
SCM_ASSERT (SCM_MEMOIZEDP (m), m, SCM_ARG1, s_unmemoize); SCM_ASSERT (SCM_NIMP (m) && SCM_MEMOIZEDP (m), m, SCM_ARG1, s_unmemoize);
return scm_unmemocopy (SCM_MEMOIZED_EXP (m), SCM_MEMOIZED_ENV (m)); return scm_unmemocopy (SCM_MEMOIZED_EXP (m), SCM_MEMOIZED_ENV (m));
} }
@ -194,7 +196,7 @@ SCM
scm_memoized_environment (m) scm_memoized_environment (m)
SCM m; SCM m;
{ {
SCM_ASSERT (SCM_MEMOIZEDP (m), m, SCM_ARG1, s_unmemoize); SCM_ASSERT (SCM_NIMP (m) && SCM_MEMOIZEDP (m), m, SCM_ARG1, s_unmemoize);
return SCM_MEMOIZED_ENV (m); return SCM_MEMOIZED_ENV (m);
} }
@ -293,13 +295,18 @@ scm_procedure_environment (proc)
* evaluating. Probably the best solution would be to have eval.c generate * evaluating. Probably the best solution would be to have eval.c generate
* yet another evaluator. They are not very big actually. * yet another evaluator. They are not very big actually.
*/ */
SCM_PROC (s_local_eval, "local-eval", 2, 0, 0, scm_local_eval); SCM_PROC (s_local_eval, "local-eval", 1, 1, 0, scm_local_eval);
SCM SCM
scm_local_eval (exp, env) scm_local_eval (exp, env)
SCM exp; SCM exp;
SCM env; SCM env;
{ {
if (SCM_UNBNDP (env))
{
SCM_ASSERT (SCM_NIMP (exp) && SCM_MEMOIZEDP (exp));
return scm_eval_3 (SCM_MEMOIZED_EXP (exp), 0, SCM_MEMOIZED_ENV (exp));
}
return scm_eval_3 (exp, 1, env); return scm_eval_3 (exp, 1, env);
} }