mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

* eval.c (unmemocar, sym_three_question_marks, scm_unmemocar):

Browse source 
Grouped together with unmemocopy, without modifications.

	(build_binding_list, unmemocopy): Renamed names of list arguments
	and variables to reflect the actual order of the list elements.
This commit is contained in:
Dirk Herrmann 2003-10-25 07:00:50 +00:00
parent 70c1c10864
commit 60a4984209
2 changed files with 62 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/ChangeLog
View file

@ -1,3 +1,11 @@
2003-10-25 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (unmemocar, sym_three_question_marks, scm_unmemocar):
Grouped together with unmemocopy, without modifications.
(build_binding_list, unmemocopy): Renamed names of list arguments
and variables to reflect the actual order of the list elements.
2003-10-22 Dirk Herrmann <D.Herrmann@tu-bs.de> 2003-10-22 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (s_defun): New static identifier. * eval.c (s_defun): New static identifier.

106
libguile/eval.c
View file

@ -633,40 +633,6 @@ literal_p (const SCM symbol, const SCM env)
return 0; return 0;
} }
#define unmemocar scm_unmemocar
SCM_SYMBOL (sym_three_question_marks, "???");
SCM
scm_unmemocar (SCM form, SCM env)
{
if (!SCM_CONSP (form))
return form;
else
{
SCM c = SCM_CAR (form);
if (SCM_VARIABLEP (c))
{
SCM sym = scm_module_reverse_lookup (scm_env_module (env), c);
if (SCM_FALSEP (sym))
sym = sym_three_question_marks;
SCM_SETCAR (form, sym);
}
else if (SCM_ILOCP (c))
{
unsigned long int ir;
for (ir = SCM_IFRAME (c); ir != 0; --ir)
env = SCM_CDR (env);
env = SCM_CAAR (env);
for (ir = SCM_IDIST (c); ir != 0; --ir)
env = SCM_CDR (env);
SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env));
}
return form;
}
}
SCM SCM
scm_eval_car (SCM pair, SCM env) scm_eval_car (SCM pair, SCM env)
@ -1925,6 +1891,7 @@ static SCM f_apply;
/* An endless list consisting of #<undefined> objects: */ /* An endless list consisting of #<undefined> objects: */
static SCM undefineds; static SCM undefineds;
/* scm_unmemocopy takes a memoized expression together with its /* scm_unmemocopy takes a memoized expression together with its
* environment and rewrites it to its original form. Thus, it is the * environment and rewrites it to its original form. Thus, it is the
* inversion of the rewrite rules above. The procedure is not * inversion of the rewrite rules above. The procedure is not
@ -1941,19 +1908,54 @@ static SCM undefineds;
*/ */
static SCM static SCM
build_binding_list (SCM names, SCM inits) build_binding_list (SCM rnames, SCM rinits)
{ {
SCM bindings = SCM_EOL; SCM bindings = SCM_EOL;
while (!SCM_NULLP (names)) while (!SCM_NULLP (rnames))
{ {
SCM binding = scm_list_2 (SCM_CAR (names), SCM_CAR (inits)); SCM binding = scm_list_2 (SCM_CAR (rnames), SCM_CAR (rinits));
bindings = scm_cons (binding, bindings); bindings = scm_cons (binding, bindings);
names = SCM_CDR (names); rnames = SCM_CDR (rnames);
inits = SCM_CDR (inits); rinits = SCM_CDR (rinits);
} }
return bindings; return bindings;
} }
SCM_SYMBOL (sym_three_question_marks, "???");
#define unmemocar scm_unmemocar
SCM
scm_unmemocar (SCM form, SCM env)
{
if (!SCM_CONSP (form))
return form;
else
{
SCM c = SCM_CAR (form);
if (SCM_VARIABLEP (c))
{
SCM sym = scm_module_reverse_lookup (scm_env_module (env), c);
if (SCM_FALSEP (sym))
sym = sym_three_question_marks;
SCM_SETCAR (form, sym);
}
else if (SCM_ILOCP (c))
{
unsigned long int ir;
for (ir = SCM_IFRAME (c); ir != 0; --ir)
env = SCM_CDR (env);
env = SCM_CAAR (env);
for (ir = SCM_IDIST (c); ir != 0; --ir)
env = SCM_CDR (env);
SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env));
}
return form;
}
}
static SCM static SCM
unmemocopy (SCM x, SCM env) unmemocopy (SCM x, SCM env)
{ {
@ -2032,33 +2034,33 @@ unmemocopy (SCM x, SCM env)
/* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...), /* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...),
* where nx is the name of a local variable, ix is an initializer for * where nx is the name of a local variable, ix is an initializer for
* the local variable and by are the body clauses. */ * the local variable and by are the body clauses. */
SCM names, inits, bindings; SCM rnames, rinits, bindings;
x = SCM_CDR (x); x = SCM_CDR (x);
names = SCM_CAR (x); rnames = SCM_CAR (x);
x = SCM_CDR (x); x = SCM_CDR (x);
inits = scm_reverse (unmemocopy (SCM_CAR (x), env)); rinits = scm_reverse (unmemocopy (SCM_CAR (x), env));
env = SCM_EXTEND_ENV (names, SCM_EOL, env); env = SCM_EXTEND_ENV (rnames, SCM_EOL, env);
bindings = build_binding_list (names, inits); bindings = build_binding_list (rnames, rinits);
z = scm_cons (bindings, SCM_UNSPECIFIED); z = scm_cons (bindings, SCM_UNSPECIFIED);
ls = scm_cons (scm_sym_let, z); ls = scm_cons (scm_sym_let, z);
break; break;
} }
case SCM_BIT7 (SCM_IM_LETREC): case SCM_BIT7 (SCM_IM_LETREC):
{ {
/* format: (#@letrec (nk nk-1 ...) (i1 ... ik) b1 ...), /* format: (#@letrec (vn ... v2 v1) (i1 i2 ... in) b1 ...),
* where nx is the name of a local variable, ix is an initializer for * where vx is the name of a local variable, ix is an initializer for
* the local variable and by are the body clauses. */ * the local variable and by are the body clauses. */
SCM names, inits, bindings; SCM rnames, rinits, bindings;
x = SCM_CDR (x); x = SCM_CDR (x);
names = SCM_CAR (x); rnames = SCM_CAR (x);
env = SCM_EXTEND_ENV (names, SCM_EOL, env); env = SCM_EXTEND_ENV (rnames, SCM_EOL, env);
x = SCM_CDR (x); x = SCM_CDR (x);
inits = scm_reverse (unmemocopy (SCM_CAR (x), env)); rinits = scm_reverse (unmemocopy (SCM_CAR (x), env));
bindings = build_binding_list (names, inits); bindings = build_binding_list (rnames, rinits);
z = scm_cons (bindings, SCM_UNSPECIFIED); z = scm_cons (bindings, SCM_UNSPECIFIED);
ls = scm_cons (scm_sym_letrec, z); ls = scm_cons (scm_sym_letrec, z);
break; break;
@ -5166,7 +5168,7 @@ scm_init_eval ()
scm_permanent_object (f_apply); scm_permanent_object (f_apply);
#include "libguile/eval.x" #include "libguile/eval.x"
scm_add_feature ("delay"); scm_add_feature ("delay");
} }