diff --git a/contrib/10.optional/CMakeLists.txt b/contrib/10.optional/CMakeLists.txt new file mode 100644 index 00000000..c6a60a8a --- /dev/null +++ b/contrib/10.optional/CMakeLists.txt @@ -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) diff --git a/contrib/10.optional/piclib/optional.scm b/contrib/10.optional/piclib/optional.scm new file mode 100644 index 00000000..362f7fe0 --- /dev/null +++ b/contrib/10.optional/piclib/optional.scm @@ -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*)) diff --git a/contrib/10.optional/t/test.scm b/contrib/10.optional/t/test.scm new file mode 100644 index 00000000..5ac0b45c --- /dev/null +++ b/contrib/10.optional/t/test.scm @@ -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)))