This page is part of the web mail archives of SRFI 51 from before July 7th, 2015. The new archives for SRFI 51 contain all messages, not just those from before July 7th, 2015.
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