From 43aac4dd2907c968f140a6830a5a429439d9dc9a Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 19 Jul 2015 15:12:49 +0900
Subject: [PATCH] add (picrin control option)

---
 contrib/50.option/nitro.mk   |  7 +++++++
 contrib/50.option/option.scm | 22 ++++++++++++++++++++++
 contrib/50.option/t/test.scm | 27 +++++++++++++++++++++++++++
 3 files changed, 56 insertions(+)
 create mode 100644 contrib/50.option/nitro.mk
 create mode 100644 contrib/50.option/option.scm
 create mode 100644 contrib/50.option/t/test.scm

diff --git a/contrib/50.option/nitro.mk b/contrib/50.option/nitro.mk
new file mode 100644
index 00000000..dfd71326
--- /dev/null
+++ b/contrib/50.option/nitro.mk
@@ -0,0 +1,7 @@
+CONTRIB_LIBS += $(wildcard contrib/50.option/*.scm)
+CONTRIB_TESTS += test-option
+
+test-option: bin/picrin
+	for test in `ls contrib/50.option/t/*.scm`; do \
+	  $(TEST_RUNNER) "$$test"; \
+	done
diff --git a/contrib/50.option/option.scm b/contrib/50.option/option.scm
new file mode 100644
index 00000000..5bd84a2d
--- /dev/null
+++ b/contrib/50.option/option.scm
@@ -0,0 +1,22 @@
+(define-library (picrin control option)
+  (import (scheme base)
+          (picrin control)
+          (picrin procedure))
+
+  (define unit identity)
+
+  (define (bind m f)
+    (and m (f m)))
+
+  (define-syntax reify
+    (syntax-rules ()
+      ((_ expr)
+       (reset (unit expr)))))
+
+  (define (reflect m)
+    (shift k (bind m k)))
+
+  (export unit
+          bind
+          reify
+          reflect))
diff --git a/contrib/50.option/t/test.scm b/contrib/50.option/t/test.scm
new file mode 100644
index 00000000..af378bab
--- /dev/null
+++ b/contrib/50.option/t/test.scm
@@ -0,0 +1,27 @@
+(import (picrin base)
+        (picrin test)
+        (picrin control option))
+
+(define phonebook
+  '(("Bob" . "01788 665242")
+    ("Fred" . "01624 556442")
+    ("Alice" . "01889 985333")
+    ("Jane" . "01732 187565")))
+
+(define nums
+  '((one . 1) (two . 2) (three . 3) (four . 19)))
+
+(define num-dict
+  (alist->dictionary nums))
+
+(test '("01889 985333" . 3)
+ (reify
+  (let* ((a (reflect (assoc "Alice" phonebook)))
+         (b (reflect (dictionary-ref num-dict 'three))))
+    (cons (cdr a) (cdr b)))))
+
+(test '#f
+ (reify
+  (let* ((a (reflect (assoc "Alice" phonebook)))
+         (b (reflect (dictionary-ref num-dict 'five))))
+    (cons (cdr a) (cdr b)))))