The <caller> of the current spec of rest-values is only a procedure. If the
<caller> can be any scheme expression like arg-and(s) macros, the rest-values
will be more useful.
Modifying the spec of rest-values makes it possible:
from
(REST-VALUES [<caller>] <rest-list> [<args-number-limit>] <default> ...)
to
(REST-VALUES [<caller>] <rest-list> [<args-number-limit> <default> ...])
The following is the modified version of rest-values. How about this?
(define (rest-values rest-list . default-list)
(let* ((caller (if (or (null? default-list)
(boolean? (car default-list))
(number? (car default-list)))
'()
(if (string? rest-list) rest-list (list rest-list))))
(rest (if (null? caller) rest-list (car default-list)))
(rest-length (if (list? rest)
(length rest)
(error "bad rest list" rest
`(rest-values ,rest-list ,@default-list))))
(default (if (null? caller) default-list (cdr default-list)))
(number
(and (not (null? default))
(let ((d (car default)))
(or (and (number? d)
(or (and (> rest-length (abs d))
(if (string? caller)
(error caller rest
`(<= (length ,rest) ,(abs d)))
(apply error "too many arguments" rest
`(<= (length ,rest) ,(abs d))
caller)))
(and (> (length (cdr default)) (abs d))
(error "too many defaults" (cdr default)
`(rest-values ,rest-list
,@default-list)))
d))
(and (eq? d #f) 'false)
(eq? d #t)
(error "neither number nor boolean" d
`(rest-values ,rest-list ,@default-list))))))
(default (if number (cdr default) default))
(default-length (length default)))
(if (or (and (number? number) (> number 0))
(eq? number #t))
(let ((number (min rest-length default-length)))
(for-each (lambda (r d)
(cond
((list? d)
(if (not (member r d))
(if (string? caller)
(error caller r `(member ,r ,d))
(apply error "unmatched argument"
r `(member ,r ,d) caller))))
((pair? d)
(let ((p (cdr d)))
(if (procedure? p)
(if (not (p r))
(if (string? caller)
(error caller r `(,p ,r))
(apply error "incorrect argument"
r `(,p ,r) caller)))
(error "bad predicate" p
`(rest-values ,rest-list
,@default-list)))))
(else
(error "bad default" d
`(rest-values ,rest-list ,@default-list)))))
(take rest number) (take default number))
(apply values
(if (> default-length rest-length)
(append rest
(map (lambda (x)
(if (pair? x)
(car x)
(error "bad default" x
`(rest-values ,rest-list
,@default-list))))
(list-tail default rest-length)))
rest)))
(apply values (if (> default-length rest-length)
(append rest (list-tail default rest-length))
rest)))))
--
INITTERM