Threading macros (#284)

* Threading macros

* Conditional thread macros

* Thread macro tests

* Simplify macro logic

Author: chrisrink10

src/basilisp/core/__init__.lpy

@@ -125,6 +125,12 @@
   (fn vector? [o]
     (instance? basilisp.lang.vector/Vector o)))
 
+(def
+  ^{:doc "Return true if o implements Seq."}
+  seq?
+  (fn seq? [o]
+    (instance? basilisp.lang.seq/Seq o)))
+
 (def seq
   (fn seq [o]
     (basilisp.lang.runtime/to-seq o)))
@@ -826,10 +832,15 @@
 
 (defn map
   "Return a lazy sequence of (f elem) for elements in coll."
-  [f coll]
-  (lazy-seq
-   (when (seq coll)
-     (cons (f (first coll)) (map f (rest coll))))))
+  ([f coll]
+   (lazy-seq
+    (when (seq coll)
+      (cons (f (first coll)) (map f (rest coll))))))
+  ([f coll & colls]
+   (lazy-seq
+    (when (and (seq coll) (every? seq colls))
+      (cons (apply f (first coll) (map first colls))
+            (apply map f (rest coll) (map rest colls)))))))
 
 (defn filter
   "Return elements from coll where (pred elem) returns true."
@@ -883,6 +894,13 @@
        (drop-while pred (rest coll))
        (seq coll)))))
 
+(defn drop-last
+  "Drop all but the last n items of coll."
+  ([coll]
+   (drop-last 1 coll))
+  ([n coll]
+   (map (comp first vector) coll (drop n coll))))
+
 (defn split-at
   "Split a collection at the nth item. Returns a vector of
   [(take n coll) (drop n coll)]."
@@ -1011,6 +1029,98 @@
        (finally
          (. (var ~vvar) ~'pop-bindings)))))
 
+;;;;;;;;;;;;;;;;;;;;;;
+;; Threading Macros ;;
+;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro ->
+  "Thread x through the forms. Places x in the second position of
+  the first form, and then the resulting expression into the second
+  position of the second form, etc. Forms which are not lists will
+  be made into lists."
+  [x & forms]
+  (if (seq forms)
+    (let [joining (first forms)]
+      `(->
+        ~(if (seq? joining)
+           (apply list (first joining) x (rest joining))
+           (list joining x))
+        ~@(rest forms)))
+    x))
+
+(defmacro ->>
+  "Thread x through the forms. Places x in the last position of
+  the first form, and then the resulting expression into the last
+  position of the second form, etc. Forms which are not lists will
+  be made into lists."
+  [x & forms]
+  (if (seq forms)
+    (let [joining (first forms)]
+      `(->>
+        ~(if (seq? joining)
+           (concat joining (list x))
+           (list joining x))
+        ~@(rest forms)))
+    x))
+
+(defmacro some->
+  "Thread x through the forms (as by ->) until the resulting expression
+  is nil or there are no more forms."
+  [x & forms]
+  (if (seq forms)
+    `(let [result# (-> ~x ~(first forms))]
+       (when-not (nil? result#)
+         (some-> result# ~@(next forms))))
+    x))
+
+(defmacro some->>
+  "Thread x through the forms (as by ->>) until the resulting expression
+  is nil or there are no more forms."
+  [x & forms]
+  (if (seq forms)
+    `(let [result# (->> ~x ~(first forms))]
+       (when-not (nil? result#)
+         (some->> result# ~@(next forms))))
+    x))
+
+(defmacro cond->
+  "Takes a test and form pair, threading x (as by ->) through each form for
+  which the corresponding test evaluates as true. cond-> does not short
+  circuit evaluation in any case."
+  [x & clauses]
+  (if (seq clauses)
+    `(let [e# (if ~(first clauses)
+                (-> ~x ~(second clauses))
+                ~x)]
+       (cond-> e#
+           ~@(nthnext clauses 2)))
+    x))
+
+(defmacro cond->>
+  "Takes a test and form pair, threading x (as by ->>) through each form for
+  which the corresponding test evaluates as true. cond->> does not short
+  circuit evaluation in any case."
+  [x & clauses]
+  (if (seq clauses)
+    `(let [e# (if ~(first clauses)
+                (->> ~x ~(second clauses))
+                ~x)]
+       (cond->> e#
+         ~@(nthnext clauses 2)))
+    x))
+
+(defmacro as->
+  "Bind x to name and thread it through the forms, replacing instances of name
+  in forms with the threaded expression."
+  [x name & forms]
+  (if (seq forms)
+    `(as->
+         (let [~name ~x]
+           ~(first forms))
+         ~name
+       ~@(next forms))
+    x))
+
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; Output Utilities ;;
 ;;;;;;;;;;;;;;;;;;;;;;

tests/basilisp/core_macros_test.lpy

@@ -0,0 +1,65 @@
+(ns basilisp.core-macros-test
+  (:require
+   [basilisp.test :refer [deftest is]]))
+
+(deftest ->-test
+  (is (= :a (-> :a)))
+  (is (= 2 (-> 1 inc)))
+  (is (= 1 (-> 1 inc dec)))
+  (is (= 4 (-> 10 inc (- 7)))))
+
+(deftest ->>-test
+  (is (= :a (->> :a)))
+  (is (= 2 (->> 1 inc)))
+  (is (= 1 (->> 1 inc dec)))
+  (is (= 14 (->> [1 2 3 4]
+                 (map inc)
+                 (reduce +)))))
+
+(deftest some->-test
+  (is (= :a (some-> :a)))
+  (is (= 2 (some-> 1 inc)))
+  (is (= 1 (some-> 1 inc dec)))
+  (is (= 4 (some-> 10 inc (- 7))))
+
+  (is (= nil (some-> {:a 3} :b inc)))
+  (is (= 4 (some-> {:a 3} :a inc))))
+
+(deftest some->>-test
+  (is (= :a (some->> :a)))
+  (is (= 2 (some->> 1 inc)))
+  (is (= 1 (some->> 1 inc dec)))
+  (is (= -4 (some->> 10 inc (- 7))))
+
+  (is (= nil (some->> {:a 3} :b (- 7))))
+  (is (= 5 (some->> {:a 3} :a (- 8)))))
+
+(deftest cond->-test
+  (is (= 1 (cond-> 1)))
+  (is (= 1 (cond-> 1 false inc)))
+  (is (= 0 (cond-> 1
+             false inc
+             true dec)))
+  (is (= 4 (cond-> 10
+             (= :a :a) inc
+             (seq [])  (* 3)
+             true      (- 7)))))
+
+(deftest cond->>-test
+  (is (= 1 (cond->> 1)))
+  (is (= 1 (cond->> 1 false inc)))
+  (is (= 0 (cond->> 1
+             false inc
+             true dec)))
+  (is (= 9 (cond->> 10
+             (= :a :a) inc
+             (seq [])  (* 3)
+             true      (- 20)))))
+
+(deftest as->-test
+  (is (= 10 (as-> 10 a)))
+  (is (= 7 (as-> 18 x (- x 11))))
+  (is (= 9 (as-> 8 x
+             {:a x :c 0}
+             (:a x)
+             (inc x)))))

tests/basilisp/core_test.py

@@ -618,6 +618,9 @@ def test_map():
     assert llist.l(1, 2, 3) == core.map_(core.identity, vec.v(1, 2, 3))
     assert llist.l(2, 3, 4) == core.map_(core.inc, vec.v(1, 2, 3))
 
+    assert llist.l(5, 7, 9) == core.map_(core.__PLUS__, vec.v(1, 2, 3), vec.v(4, 5, 6))
+    assert llist.l(5, 7, 9) == core.map_(core.__PLUS__, vec.v(1, 2, 3), core.range_(4))
+
 
 def test_filter():
     assert llist.List.empty() == core.filter_(core.identity, vec.Vector.empty())
@@ -665,6 +668,17 @@ def test_drop_while():
     assert llist.l(2, 4, 6, 8) == core.drop_while(core.odd__Q__, vec.v(2, 4, 6, 8))
 
 
+def test_drop_last():
+    assert llist.l(1, 2, 3, 4) == core.drop_last(vec.v(1, 2, 3, 4, 5))
+    assert llist.l(1, 2, 3) == core.drop_last(2, vec.v(1, 2, 3, 4, 5))
+    assert llist.l(1, 2) == core.drop_last(3, vec.v(1, 2, 3, 4, 5))
+    assert llist.l(1) == core.drop_last(4, vec.v(1, 2, 3, 4, 5))
+    assert llist.List.empty() == core.drop_last(5, vec.v(1, 2, 3, 4, 5))
+    assert llist.List.empty() == core.drop_last(6, vec.v(1, 2, 3, 4, 5))
+    assert llist.l(1, 2, 3, 4, 5) == core.drop_last(0, vec.v(1, 2, 3, 4, 5))
+    assert llist.l(1, 2, 3, 4, 5) == core.drop_last(-1, vec.v(1, 2, 3, 4, 5))
+
+
 def test_split_at():
     assert vec.v(llist.List.empty(), llist.List.empty()) == core.split_at(3, vec.Vector.empty())
     assert vec.v(llist.List.empty(), llist.l(1, 2, 3)) == core.split_at(0, vec.v(1, 2, 3))