From 495b2ac5abfdb1a75ad97277742fa44880834a12 Mon Sep 17 00:00:00 2001
From: s-ol <s+removethis@s-ol.nu>
Date: Sat, 1 May 2021 22:46:09 +0200
Subject: add thread-first/thread-last macro + spec

---
 alv/builtins.moon          | 47 ++++++++++++++++++++++++++++++++++++++++++++++
 spec/lang/thread_spec.moon | 25 ++++++++++++++++++++++++
 2 files changed, 72 insertions(+)
 create mode 100644 spec/lang/thread_spec.moon

diff --git a/alv/builtins.moon b/alv/builtins.moon
index 47dbab8..6d69735 100644
--- a/alv/builtins.moon
+++ b/alv/builtins.moon
@@ -620,6 +620,50 @@ bound to `nv2`…
       table.insert children, node
       super RTNode :children, result: node.result
 
+mk_thread = (name, thread_first) ->
+  class extends Builtin
+    eval: (scope, tail) =>
+      L\trace "evaling #{@}"
+      assert #tail > 1, "'#{name}' requires at least 2 arguments"
+
+      last_result = tail[1]
+
+      for cell in *tail[2,]
+        assert cell.__class == Cell, "'#{name}'s arguments have to be expressions"
+
+        children = [c for c in *cell.children]
+        if thread_first
+          table.insert children, 2, last_result
+        else
+          table.insert children, last_result
+
+        last_result = Cell cell.tag, children
+
+      super last_result\eval scope, tail
+
+thread_first = Constant.meta
+  meta:
+    name: '->'
+    summary: "Thread first macro."
+    examples: { '(-> initial [expr1 expr2…])' }
+    description: "
+Evaluate expressions `expr1`, `expr2`, … while passing the result of the
+previous expression to the following one, starting with `initial`. The value
+is always inserted as the first argument."
+
+  value: mk_thread '->', true
+
+thread_last = Constant.meta
+  meta:
+    name: '->>'
+    summary: "Thread last macro."
+    examples: { '(->> initial [expr1 expr2…])' }
+    description: "
+Evaluate expressions `expr1`, `expr2`, … while passing the result of the
+previous expression to the following one, starting with `initial`. The value
+is always inserted as the last argument."
+
+  value: mk_thread '->>', false
 
 Constant.meta
   meta:
@@ -646,6 +690,9 @@ Constant.meta
     '~': to_sig
     '!': to_evt
 
+    '->': thread_first
+    '->>': thread_last
+
     :array, :struct
 
     :loop, :recur
diff --git a/spec/lang/thread_spec.moon b/spec/lang/thread_spec.moon
new file mode 100644
index 0000000..aa30a1b
--- /dev/null
+++ b/spec/lang/thread_spec.moon
@@ -0,0 +1,25 @@
+import TestPilot from require 'spec.test_setup'
+import T, Struct, Array, Constant from require 'alv'
+
+describe "thread macros", ->
+  COPILOT = TestPilot ''
+
+  it "thread forward (->)", ->
+    rt = COPILOT\eval_once '
+    (import* math)
+    #((/ (+ 10 2) 2) = 6)
+    (-> 10
+      (+ 2)
+      (/ 2))'
+    assert.is.true rt\is_const!
+    assert.is.equal (Constant.num 6), rt.result
+
+  it "thread last forward (->>)", ->
+    rt = COPILOT\eval_once '
+    (import* math)
+    #((/ 10 (+ 2 3)) = 2)
+    (->> 3
+      (+ 2)
+      (/ 10))'
+    assert.is.true rt\is_const!
+    assert.is.equal (Constant.num 2), rt.result
-- 
cgit v1.2.3