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:
OGINO Masanori 2014-09-22 20:24:31 +09:00
parent ff843f0e8f
commit ed86a8e28d
3 changed files with 48 additions and 0 deletions

View File

@ -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)

View File

@ -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*))

View File

@ -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)))