Add (hnh util values).

1 files changed, 27 insertions, 0 deletions

diff --git a/module/hnh/util/values.scm b/module/hnh/util/values.scm
new file mode 100644
index 00000000..79f06cff
--- /dev/null
+++ b/module/hnh/util/values.scm
@@ -0,0 +1,27 @@
+(define-module (hnh util values)
+  :use-module (ice-9 control)
+  :export (abort* on-fst on-snd apply/values)
+  )
+
+
+(define-syntax-rule (abort* form)
+  (call-with-values (lambda () form) abort))
+
+
+;; (on-fst (+ 2 (abort* (values 3 4))))
+;; ⇒ 5 ⇒ 4
+
+(define-syntax-rule (on-fst form)
+  (% form
+     (lambda (prompt fst . rest)
+       (apply values (prompt fst) rest))))
+
+(define-syntax-rule (on-snd form)
+  (% form
+     (lambda (prompt fst snd . rest)
+       (apply values fst (prompt snd) rest))))
+
+
+(define-syntax-rule (apply/values proc form)
+  (call-with-values (lambda () form)
+    proc))