add (picrin control option)

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

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

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