simplify opt-lambda def; copy list tail for rest arguments

This commit is contained in:
Alex Shinn 2021-11-25 22:01:59 +09:00
parent f29af14e2e
commit 6e636594a5
4 changed files with 9 additions and 15 deletions

View file

@ -73,6 +73,11 @@
(let-optionals* ls ((a (begin (set! ls '(a b)) 'default-a)) (let-optionals* ls ((a (begin (set! ls '(a b)) 'default-a))
(b 'default-b)) (b 'default-b))
(test '(default-a default-b) (list a b)))) (test '(default-a default-b) (list a b))))
(let ((ls (list 0 1 2)))
(let-optionals ls (a . b)
(set-car! (cdr ls) 3)
(test '(0 3 2) ls)
(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))
(cond-expand (cond-expand

View file

@ -76,7 +76,7 @@
(define-syntax opt-lambda (define-syntax opt-lambda
(syntax-rules () (syntax-rules ()
((opt-lambda vars . body) ((opt-lambda vars . body)
(opt-lambda/aux let-optionals () vars . body)))) (lambda args (let-optionals args vars . body)))))
;;> \macro{(opt-lambda* ((var default) ... [rest]) body ...)} ;;> \macro{(opt-lambda* ((var default) ... [rest]) body ...)}
;;> ;;>
@ -86,18 +86,7 @@
(define-syntax opt-lambda* (define-syntax opt-lambda*
(syntax-rules () (syntax-rules ()
((opt-lambda* vars . body) ((opt-lambda* vars . body)
(opt-lambda/aux let-optionals* () vars . body)))) (lambda args (let-optionals* args vars . body)))))
(define-syntax opt-lambda/aux
(syntax-rules ()
((opt-lambda/aux let-opt (args ...) ((var . default) . vars) . body)
(lambda (args ... . o)
(let-opt o ((var . default) . vars) . body)))
((opt-lambda/aux let-opt (args ...) (var . vars) . body)
(opt-lambda/aux let-opt (args ... var) vars . body))
((opt-lambda/aux let-op (args ...) () . body)
(lambda (args ... . o)
. body))))
;;> \macro{(define-opt (name (var default) ... [rest]) body ...)} ;;> \macro{(define-opt (name (var default) ... [rest]) body ...)}
;;> ;;>

View file

@ -36,7 +36,7 @@
(var (if (pair? tmp) (car tmp) default))) (var (if (pair? tmp) (car tmp) default)))
(let-optionals* tmp2 rest . body))) (let-optionals* tmp2 rest . body)))
((let-optionals* tmp tail . body) ((let-optionals* tmp tail . body)
(let ((tail tmp)) . body)))) (let ((tail (list-copy tmp))) . body))))
(define-syntax symbol->keyword* (define-syntax symbol->keyword*
(syntax-rules () (syntax-rules ()
((symbol->keyword* sym) ((symbol->keyword* sym)

View file

@ -1146,7 +1146,7 @@
(let ((var (car tmp))) (let ((var (car tmp)))
(let-optionals* (cdr tmp) rest . body))) (let-optionals* (cdr tmp) rest . body)))
((let-optionals* tmp tail . body) ((let-optionals* tmp tail . body)
(let ((tail tmp)) . body)))) (let ((tail (list-copy tmp))) . body))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; exceptions ;; exceptions