From 34028172f228fc1de4a93f454dd1c8f632d51f0f Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 18 Jul 2015 18:04:33 +0900
Subject: [PATCH] add (picrin procedure)

---
 contrib/50.procedure/nitro.mk      |  1 +
 contrib/50.procedure/procedure.scm | 25 +++++++++++++++++++++++++
 2 files changed, 26 insertions(+)
 create mode 100644 contrib/50.procedure/nitro.mk
 create mode 100644 contrib/50.procedure/procedure.scm

diff --git a/contrib/50.procedure/nitro.mk b/contrib/50.procedure/nitro.mk
new file mode 100644
index 00000000..87f2e8f5
--- /dev/null
+++ b/contrib/50.procedure/nitro.mk
@@ -0,0 +1 @@
+CONTRIB_LIBS += $(wildcard contrib/50.procedure/*.scm)
diff --git a/contrib/50.procedure/procedure.scm b/contrib/50.procedure/procedure.scm
new file mode 100644
index 00000000..5be822c3
--- /dev/null
+++ b/contrib/50.procedure/procedure.scm
@@ -0,0 +1,25 @@
+(define-library (picrin procedure)
+  (import (scheme base))
+  (export >>
+          <<
+          constant
+          identity)
+
+  (define identity values)
+
+  (define (constant . args)
+    (lambda _
+      (apply values args)))
+
+  (define (>> . fs)
+    (if (null? fs)
+        identity
+        (let ((f (car fs))
+              (g (apply >> (cdr fs))))
+          (lambda args
+            (call-with-values (lambda () (apply f args))
+              (lambda args
+                (apply g args)))))))
+
+  (define (<< . fs)
+    (apply >> (reverse fs))))