Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Raise error if apply is called with invalid args.

Browse source 
* If called with only the procedure, but no args list.
* If called with a final arg that is not a proper list.
This commit is contained in:
John Croisant 2018-04-14 20:49:03 -05:00
parent 10759e8bdb
commit 42dd447a06
3 changed files with 21 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lib/init-7.scm
View file

@ -43,12 +43,12 @@
(append-helper (cdr lol) (car lol)))
(reverse o))))
(define (apply proc . args)
(define (apply proc arg1 . args)
(if (null? args)
(proc)
(apply1 proc arg1)
((lambda (lol)
(apply1 proc (append2 (reverse (cdr lol)) (car lol))))
(reverse args))))
(reverse (cons arg1 args)))))
;; map with a fast-path for single lists

6
tests/r7rs-tests.scm
View file

@ -1591,6 +1591,12 @@
(test #t (call-with-current-continuation procedure?))
(test 7 (apply + (list 3 4)))
(test 7 (apply + 3 4 (list)))
(test-error (apply +)) ;; not enough args
(test-error (apply + 3)) ;; final arg not a list
(test-error (apply + 3 4)) ;; final arg not a list
(test-error (apply + '(2 3 . 4))) ;; final arg is improper
(define compose
(lambda (f g)

16
vm.c
View file

@ -1174,10 +1174,18 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
bc = sexp_procedure_code(self);
cp = sexp_procedure_vars(self);
ip = (sexp_bytecode_data(bc)+sexp_unbox_fixnum(stack[fp+1])) - sizeof(sexp);
for (top=fp-j+i-1; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
stack[top] = sexp_car(tmp2);
top = fp+i-j+1;
fp = k;
{
int prev_top = top;
for (top=fp-j+i-1; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
stack[top] = sexp_car(tmp2);
top = fp+i-j+1;
fp = k;
/* if final cdr of tmp2 isn't null, then args list was improper */
if (! sexp_nullp(tmp2)) {
top = prev_top;
sexp_raise("apply: improper args list", sexp_list1(ctx, stack[prev_top-2]));
}
}
goto make_call;
case SEXP_OP_TAIL_CALL:
_ALIGN_IP();