From eeb95054dede8630b7b43ba14df627af11a82534 Mon Sep 17 00:00:00 2001
From: Jason Jackson <jasonjckn@gmail.com>
Date: Sun, 13 May 2012 12:05:16 -0400
Subject: [PATCH][BUILD] added logic threading macro ==>>


Signed-off-by: Jason Jackson <jasonjckn@gmail.com>
---
 project.clj                                   |    1 +
 src/main/clojure/clojure/core/logic.clj       |   36 +++++++++++++++++++++++++
 src/test/clojure/clojure/core/logic/tests.clj |   29 +++++++++++++++++++-
 3 files changed, 65 insertions(+), 1 deletions(-)

diff --git a/project.clj b/project.clj
index c60fb5a..e407a13 100644
--- a/project.clj
+++ b/project.clj
@@ -2,6 +2,7 @@
   :description "A logic/relational programming library for Clojure"
   :parent [org.clojure/pom.contrib "0.0.25"]
   :source-path "src/main/clojure"
+  :test-path "src/test/clojure"
   :dependencies [[org.clojure/clojure "1.4.0-beta3"]
                  [org.clojure/tools.macro "0.1.1"]]
   :dev-dependencies [[lein-swank "1.4.3"]
diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj
index ce22991..88899df 100644
--- a/src/main/clojure/clojure/core/logic.clj
+++ b/src/main/clojure/clojure/core/logic.clj
@@ -2089,3 +2089,39 @@
   [u v]
   `(fn [a#]
      (!=-verify a# (unify a# ~u ~v))))
+
+(defmacro ==>> [expr-in & rel-forms]
+  "Thread the expr-in through rel-forms then unify with last rel-forms
+   (the 'out expression').
+
+   Example:
+     (==>> [[1]] (firsto) (firsto) x))
+     ;; 'x' will become bound to value 1
+
+   This macro expands to:
+   (fresh [_A _B]
+     (firsto [[1]]  _A)
+     (firsto _A     _B)
+     (==     _B     q))
+
+   If you imagine that the 'return value' of firsto is its last parameter,
+   then it works just like clojure.core/-> as return value of each form is
+   first argument of the following form."
+  {:pre [(every? seq? (butlast rel-forms))]}
+  (letfn [(helper
+            ([rel-forms prev-out] (helper rel-forms prev-out [] []))
+            ([rel-forms prev-out fresh-acc goals-acc]
+               (if-let [[rel & rel-args] (first rel-forms)]
+                 (let [the-out (gensym)]
+                   (recur (rest rel-forms)
+                          the-out
+                          (conj fresh-acc the-out)
+                          (conj goals-acc `(~rel ~prev-out ~@rel-args ~the-out))))
+                 [goals-acc fresh-acc (last fresh-acc)])))]
+
+    (let [[goals new-fresh final-out]
+          (helper (butlast rel-forms) expr-in)]
+      `(fresh [~@new-fresh]
+         ~@goals
+         (== ~(last rel-forms) ~final-out)))))
+
diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj
index b288cf7..a7a44f0 100644
--- a/src/test/clojure/clojure/core/logic/tests.clj
+++ b/src/test/clojure/clojure/core/logic/tests.clj
@@ -1286,4 +1286,31 @@
 (deftest test-34-unify-with-metadata
   (is (run* [q]
             (== q (quote ^:haz-meta-daytuhs (form form form))))
-      '((^:haz-meta-daytuhs (form form form)))))
\ No newline at end of file
+      '((^:haz-meta-daytuhs (form form form)))))
+
+
+;; -----------------------------------------------------------------------------
+;; Utility Macros
+
+(deftest test-macro==>>
+  (let [lst [[1 2] [3 4] [5 6]]]
+    (is (= (run* [q]          
+             (==>> lst (firsto) q))
+           '([1 2])))
+    
+    (is (= (run* [q]          
+             (==>> lst (firsto) (firsto) q))
+           '(1)))
+    
+    (is (= (run* [q]
+             (fresh [e]
+               (==>> e (firsto) (firsto) [1 2])
+               (==>> e (firsto) (firsto) q)))
+           '([1 2])))
+    
+    (is (= (run* [q]
+             (fresh [e]
+               (== e lst)
+               (==>> e (firsto) q)))
+           '([1 2])))))
+
-- 
1.7.4.4