qf/quakeforge
0
0
Fork 0
mirror of https://git.code.sf.net/p/quake/quakeforge synced 2025-01-31 05:00:35 +00:00
Code Issues Projects Releases Packages Wiki Activity

Scheme: Make apply follow the R5RS standard.

Browse source
This commit is contained in:
Brian Koropoff 2005-05-10 08:19:15 +00:00
parent 5480c38da5
commit fd54b1a245
1 changed files with 12 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
ruamoko/scheme/builtins.r
View file

@ -213,6 +213,7 @@ SchemeObject bi_cdr (SchemeObject args, Machine m)
SchemeObject bi_apply (SchemeObject args, Machine m) SchemeObject bi_apply (SchemeObject args, Machine m)
{ {
local SchemeObject cur, prev;
if (args == [Nil nil]) { if (args == [Nil nil]) {
return [Error type: "apply" return [Error type: "apply"
message: "expected at least 1 argument" message: "expected at least 1 argument"
@ -225,7 +226,17 @@ SchemeObject bi_apply (SchemeObject args, Machine m)
by: m]; by: m];
} }
[m stack: [[args cdr] car]]; prev = NIL;
for (cur = args; [cur cdr] != [Nil nil]; cur = [cur cdr]) {
prev = cur;
}
if (prev) {
[prev cdr: [cur car]];
}
[m stack: [args cdr]];
[[args car] invokeOnMachine: m]; [[args car] invokeOnMachine: m];
return NIL; return NIL;
} }