Merge pull request #222 from omasanori/optional

Add (picrin optional).

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)

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

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