allowing required args in opt-lambda, adding define-opt

This commit is contained in:
Alex Shinn 2019-08-24 22:34:20 +08:00
parent 8645b23d42
commit e7b9510656
3 changed files with 55 additions and 3 deletions

View file

@ -0,0 +1,30 @@
(define-library (chibi optional-test)
(import (scheme base) (chibi optional) (chibi test))
(export run-tests)
(begin
(define (run-tests)
(test-begin "optional")
(test '(0 11 12)
(let-optionals '(0) ((a 10) (b 11) (c 12))
(list a b c)))
(test '(0 11 12)
((opt-lambda ((a 10) (b 11) (c 12))
(list a b c))
0))
(test '(0 11 12)
((opt-lambda (a (b 11) (c 12))
(list a b c))
0))
(test-error '(0 11 12)
((opt-lambda (a (b 11) (c 12))
(list a b c))))
(let ()
(define-opt (f a (b 11) (c 12))
(list a b c))
(test-error (f))
(test '(0 11 12) (f 0))
(test '(0 1 12) (f 0 1))
(test '(0 1 2) (f 0 1 2))
(test '(0 1 2) (f 0 1 2 3)))
(test-end))))

View file

@ -64,14 +64,36 @@
;;>
;;> Shorthand for
;;> \schemeblock{
;;> (lambda o
;;> (lambda (required ... . o)
;;> (let-optionals o ((var default) ... [rest])
;;> body ...))}
(define-syntax opt-lambda
(syntax-rules ()
((opt-lambda vars . body)
(lambda args (let-optionals args vars . body)))))
(opt-lambda/aux () vars . body))))
(define-syntax opt-lambda/aux
(syntax-rules ()
((opt-lambda/aux (args ...) ((var . default) . vars) . body)
(lambda (args ... . o)
(let-optionals o ((var . default) . vars) . body)))
((opt-lambda/aux (args ...) (var . vars) . body)
(opt-lambda/aux (args ... var) vars . body))
((opt-lambda/aux (args ...) () . body)
(lambda (args ... . o)
. body))))
;;> \macro{(define-opt (name (var default) ... [rest]) body ...)}
;;>
;;> Shorthand for
;;> \schemeblock{
;;> (define name (opt-lambda (var default) ... [rest]) body ...)}
(define-syntax define-opt
(syntax-rules ()
((define-opt (name . vars) . body)
(define name (opt-lambda vars . body)))))
;;> \procedure{(keyword-ref ls key [default])}
;;>

View file

@ -1,6 +1,6 @@
(define-library (chibi optional)
(export let-optionals let-optionals* opt-lambda
(export let-optionals let-optionals* opt-lambda define-opt
let-keywords let-keywords* keyword-ref keyword-ref*)
(cond-expand
(chibi