Add (picrin optional).
The library provides some macros to handle optional arguments. The macros are compatible with those in Chicken, Gauche, etc. Signed-off-by: OGINO Masanori <masanori.ogino@gmail.com>
This commit is contained in:
parent
ff843f0e8f
commit
ed86a8e28d
|
@ -0,0 +1,9 @@
|
||||||
|
file(GLOB OPTIONAL_FILES ${PROJECT_SOURCE_DIR}/contrib/10.optional/piclib/*.scm)
|
||||||
|
list(APPEND PICLIB_CONTRIB_LIBS ${OPTIONAL_FILES})
|
||||||
|
add_custom_target(test-optional
|
||||||
|
for test in ${PROJECT_SOURCE_DIR}/contrib/10.optional/t/*.scm \;
|
||||||
|
do
|
||||||
|
bin/picrin "$$test" \;
|
||||||
|
done
|
||||||
|
DEPENDS repl)
|
||||||
|
set(CONTRIB_TESTS ${CONTRIB_TESTS} test-optional)
|
|
@ -0,0 +1,24 @@
|
||||||
|
(define-library (picrin optional)
|
||||||
|
(import (scheme base))
|
||||||
|
|
||||||
|
(define-syntax optional
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ args default)
|
||||||
|
(let ((t args))
|
||||||
|
(if (null? t) default (car t))))))
|
||||||
|
|
||||||
|
(define-syntax let-optionals*
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ args () body ...)
|
||||||
|
(begin body ...))
|
||||||
|
((_ args ((var default) . tail) body ...)
|
||||||
|
(let* ((t args)
|
||||||
|
(var (if (null? t) default (car t)))
|
||||||
|
(remain (if (null? t) '() (cdr t))))
|
||||||
|
(let-optionals* remain tail body ...)))
|
||||||
|
((_ args rest body ...)
|
||||||
|
(let ((rest args))
|
||||||
|
body ...))))
|
||||||
|
|
||||||
|
(export optional
|
||||||
|
let-optionals*))
|
|
@ -0,0 +1,15 @@
|
||||||
|
(import (scheme base)
|
||||||
|
(picrin optional)
|
||||||
|
(picrin test))
|
||||||
|
|
||||||
|
(test 0 (optional '() 0))
|
||||||
|
(test 1 (optional '(1) 0))
|
||||||
|
|
||||||
|
(test '(0 0) (let-optionals* '() ((a 0) (b 0)) (list a b)))
|
||||||
|
(test '(1 0) (let-optionals* '(1) ((a 0) (b 0)) (list a b)))
|
||||||
|
(test '(1 2) (let-optionals* '(1 2) ((a 0) (b 0)) (list a b)))
|
||||||
|
(test '(1 1) (let-optionals* '(1) ((a 0) (b a)) (list a b)))
|
||||||
|
|
||||||
|
(test '(0 ()) (let-optionals* '() ((a 0) . r) (list a r)))
|
||||||
|
(test '(1 ()) (let-optionals* '(1) ((a 0) . r) (list a r)))
|
||||||
|
(test '(1 (2)) (let-optionals* '(1 2) ((a 0) . r) (list a r)))
|
Loading…
Reference in New Issue