mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-23 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Integrate "apply" fix into scheme-advanced.c.

Browse source 
Copied from Perforce
 Change: 180409
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Gareth Rees 2012-11-08 14:01:10 +00:00
parent 7e08dab17c
commit ce1d9fe08f
1 changed files with 16 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

19
mps/example/scheme/scheme-advanced.c
View file

@ -1443,7 +1443,8 @@ static obj_t eval(obj_t env, obj_t op_env, obj_t exp)
if(TYPE(exp) == TYPE_INTEGER ||
(TYPE(exp) == TYPE_SPECIAL && exp != obj_empty) ||
TYPE(exp) == TYPE_STRING ||
TYPE(exp) == TYPE_CHARACTER)
TYPE(exp) == TYPE_CHARACTER ||
TYPE(exp) == TYPE_OPERATOR)
return exp;
/* symbol lookup */
@ -2409,11 +2410,23 @@ static obj_t entry_procedurep(obj_t env, obj_t op_env, obj_t operator, obj_t ope
*/
static obj_t entry_apply(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
{
obj_t proc, args;
obj_t proc, args, qargs = obj_empty, end = NULL, quote;
eval_args(operator->operator.name, env, op_env, operands, 2, &proc, &args);
unless(TYPE(proc) == TYPE_OPERATOR)
error("%s: first argument must be a procedure", operator->operator.name);
return (*proc->operator.entry)(env, op_env, operator, args);
quote = make_operator("quote", entry_quote, obj_empty, obj_empty, obj_empty, obj_empty);
while(args != obj_empty) {
obj_t a;
assert(TYPE(args) == TYPE_PAIR);
a = make_pair(make_pair(quote, make_pair(CAR(args), obj_empty)), obj_empty);
if(end != NULL)
CDR(end) = a;
else
qargs = a;
end = a;
args = CDR(args);
}
return (*proc->operator.entry)(env, op_env, proc, qargs);
}