mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-18 18:37:32 +02:00
allowing required args in opt-lambda, adding define-opt
This commit is contained in:
parent
8645b23d42
commit
e7b9510656
3 changed files with 55 additions and 3 deletions
30
lib/chibi/optional-test.sld
Normal file
30
lib/chibi/optional-test.sld
Normal 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))))
|
|
@ -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])}
|
||||
;;>
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue