Improve let-keywords docs and add unit tests (issue #866).

This commit is contained in:
Alex Shinn 2022-10-11 22:32:32 +09:00
parent 49f95dc107
commit 0a050a524a
2 changed files with 45 additions and 4 deletions

View file

@ -80,6 +80,22 @@
(test '(0 1 2) (cons a b)))) (test '(0 1 2) (cons a b))))
(test 5 (keyword-ref '(a: b: b: 5) 'b: #f)) (test 5 (keyword-ref '(a: b: b: 5) 'b: #f))
(test 5 (keyword-ref* '(a: b: b: 5) 'b: #f)) (test 5 (keyword-ref* '(a: b: b: 5) 'b: #f))
(test '(1 2 0 (other: 9))
(let-keywords '(b: 2 a: 1 other: 9)
((a 0) (b 0) (c 0) rest)
(list a b c rest)))
;; a: is not in a keyword position, and the 3 is dropped
(test '(1 (2 a:))
(let-keywords '(2 a: 3) ((a a: 1) rest) (list a rest)))
;; a: is in a keyword position, and the 3 is dropped
(test '(2 ())
(let-keywords '(a: 2 3) ((a a: 1) rest) (list a rest)))
;; a: is in a keyword position, 3->5 is a kv, 4 is dropped
(test '(2 (3 5))
(let-keywords '(3 5 a: 2 4) ((a a: 1) rest) (list a rest)))
;; a: is in a keyword position, 3->5 and 4->6 are kvs
(test '(2 (3 5 4 6))
(let-keywords '(3 5 a: 2 4 6) ((a a: 1) rest) (list a rest)))
(cond-expand (cond-expand
(gauche) ; gauche detects this at compile-time, can't catch (gauche) ; gauche detects this at compile-time, can't catch
(else (test-error '(0 11 12) (else (test-error '(0 11 12)

View file

@ -162,13 +162,21 @@
;;> is not found, \var{var} is bound to \var{default}, even if unused ;;> is not found, \var{var} is bound to \var{default}, even if unused
;;> names remain in \var{ls}. ;;> names remain in \var{ls}.
;;> ;;>
;;> Keyword arguments have precedence in CommonLisp, DSSSL, and SRFI
;;> 89. However, unlike these systems you cannot mix optional and
;;> keyword arguments.
;;>
;;> If an optional trailing identifier \var{rest} is provided, it is ;;> If an optional trailing identifier \var{rest} is provided, it is
;;> bound to the list of unused arguments not bound to any \var{var}. ;;> bound to the list of unused arguments not bound to any \var{var}.
;;> This is useful for chaining together keyword argument procedures -
;;> you can extract just the arguments you need and pass on the rest
;;> to another procedure. The \var{rest} usage is similar to Python's
;;> \code{**args} (again predated by CommonLisp and DSSSL).
;;> ;;>
;;> Note R7RS does not have a disjoint keyword type or auto-quoting ;;> Note R7RS does not have a disjoint keyword type or auto-quoting
;;> syntax for keywords - they are simply identifiers. Thus when ;;> syntax for keywords - they are simply identifiers (though no type
;;> passing keyword arguments they must be quoted (or otherwise ;;> checking is performed). Thus when passing keyword arguments they
;;> dynamically evaluated). ;;> must be quoted (or otherwise dynamically evaluated).
;;> ;;>
;;> \emph{Example:} ;;> \emph{Example:}
;;> \example{ ;;> \example{
@ -189,12 +197,27 @@
;;> ((a 0) (b 0) (c 0) rest) ;;> ((a 0) (b 0) (c 0) rest)
;;> (list a b c rest)) ;;> (list a b c rest))
;;> } ;;> }
;;>
;;> \emph{Example:}
;;> \example{
;;> (define (auth-wrapper proc)
;;> (lambda o
;;> (let-keywords o ((user #f)
;;> (password #f)
;;> rest)
;;> (if (authenticate? user password)
;;> (apply proc rest)
;;> (error "access denied")))))
;;>
;;> ((auth-wrapper make-payment) 'user: "bob" 'password: "5ecret" 'amount: 50)
;;> }
(define-syntax let-keywords (define-syntax let-keywords
(syntax-rules () (syntax-rules ()
((let-keywords ls vars . body) ((let-keywords ls vars . body)
(let-key*-to-let ls () vars . body)))) (let-key*-to-let ls () vars . body))))
;; Returns the plist ls filtering out key-values found in keywords.
(define (remove-keywords ls keywords) (define (remove-keywords ls keywords)
(let lp ((ls ls) (res '())) (let lp ((ls ls) (res '()))
(if (and (pair? ls) (pair? (cdr ls))) (if (and (pair? ls) (pair? (cdr ls)))
@ -203,6 +226,8 @@
(lp (cddr ls) (cons (cadr ls) (cons (car ls) res)))) (lp (cddr ls) (cons (cadr ls) (cons (car ls) res))))
(reverse res)))) (reverse res))))
;; Extracts the known keywords from a let-keyword spec and removes
;; them from the opt-ls.
(define-syntax remove-keywords* (define-syntax remove-keywords*
(syntax-rules () (syntax-rules ()
((remove-keywords* opt-ls (keys ...) ((var key default) . rest)) ((remove-keywords* opt-ls (keys ...) ((var key default) . rest))
@ -214,7 +239,7 @@
;;> \macro{(let-keywords* ls ((var [keyword] default) ... [rest]) body ...)} ;;> \macro{(let-keywords* ls ((var [keyword] default) ... [rest]) body ...)}
;;> ;;>
;;> \scheme{let*} equivalent to \scheme{let-keywords*}. Any required ;;> \scheme{let*} equivalent to \scheme{let-keywords}. Any required
;;> \var{default} values are evaluated in left-to-right order, with ;;> \var{default} values are evaluated in left-to-right order, with
;;> all preceding \var{var}s in scope. ;;> all preceding \var{var}s in scope.
;;> ;;>