~technomancy/fennel

fennel: Fix https://todo.sr.ht/~technomancy/fennel/171 v1 PROPOSED

Andrey Listopadov: 1
 Fix https://todo.sr.ht/~technomancy/fennel/171

 3 files changed, 29 insertions(+), 6 deletions(-)
#992119 .build.yml success
Andrey Listopadov <andreyorst@gmail.com> writes:
Next
Andrey Listopadov <andreyorst@gmail.com> writes:
Next
What is your opinion on adding a second &-type operator that will do the 
current logic, thus reverting & to old behavior? Then, & will be fast and 
straightforward and &* or && will be looking up the __fennelrest falling 
back to the behavior of plain & if none present.

(let [[x & xs] (vec ...)] ...) ; no __fennelrest
(let [[x && xs] (seq ...)] ...) ; try __fennelres
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~technomancy/fennel/patches/41255/mbox | git am -3
Learn more about email & git

[PATCH fennel] Fix https://todo.sr.ht/~technomancy/fennel/171 Export this patch

Fennelrest is now supported by case and match in a similar way how the
default compiler supports it, but a bit more robust, as we don't have
to have the general case in for both sequential and associative
tables.
For some reason, a lot of tests are failing on my machine even without
the patch, so I'll leave this to CI.
---
 changelog.md         |  1 +
 src/fennel/match.fnl | 30 ++++++++++++++++++++++++------
 test/core.fnl        |  4 ++++
 3 files changed, 29 insertions(+), 6 deletions(-)

diff --git a/changelog.md b/changelog.md
index 7419cc1..34d1704 100644
--- a/changelog.md
+++ b/changelog.md
@@ -19,6 +19,7 @@ deprecated forms.
* Fix a bug where metadata tables with different arglists break lambdas
* Fix a bug with detecting cycles for tables that have custom
  `__pairs` metamethod in fennel.view
* Fix a bug where the case and match didn't use `__fennelrest` in table patterns

### New Features

diff --git a/src/fennel/match.fnl b/src/fennel/match.fnl
index 7179986..9c729ab 100644
--- a/src/fennel/match.fnl
+++ b/src/fennel/match.fnl
@@ -20,22 +20,40 @@
        (icollect [_ b (ipairs subbindings) &into bindings] b)))
    (values condition bindings)))

(fn fennelrest [t k e]
  `(let [t# ,t k# ,k e# ,e
         mt# (getmetatable t#)]
     (if (and (= :table (type mt#)) mt#.__fennelrest)
         (mt#.__fennelrest t# k#)
         [((or table.unpack _G.unpack) t# k#)])))

(fn kv-fennelrest [tbl exclude]
  `(let [exclude# ,(collect [k v (pairs exclude)]
                     (when (not= k `&)
                       (values k 'true)))]
     (collect [k# v# (pairs ,tbl)]
       (when (not (. exclude# k#))
         (values k# v#)))))

(fn case-table [val pattern unifications case-pattern opts]
  (let [condition `(and (= (_G.type ,val) :table))
        bindings []]
    (each [k pat (pairs pattern)]
      (if (= pat `&)
          (let [rest-pat (. pattern (+ k 1))
                rest-val `(select ,k ((or table.unpack _G.unpack) ,val))
                rest-val (fennelrest val k)
                subcondition (case-table `(pick-values 1 ,rest-val)
                                          rest-pat unifications case-pattern
                                          (without opts :multival?))]
                                         rest-pat unifications case-pattern
                                         (without opts :multival?))]
            (if (not (sym? rest-pat))
                (table.insert condition subcondition))
            (assert (= nil (. pattern (+ k 2)))
                    "expected & rest argument before last parameter")
            (table.insert bindings rest-pat)
            (table.insert bindings [rest-val]))
            (table.insert bindings rest-val))
          (= k `&)
          (do (table.insert bindings pat)
              (table.insert bindings (kv-fennelrest val pattern)))
          (= k `&as)
          (do
            (table.insert bindings pat)
@@ -51,8 +69,8 @@
                                           (not= `& (. pattern (- k 1)))))
          (let [subval `(. ,val ,k)
                (subcondition subbindings) (case-pattern [subval] pat
                                                          unifications
                                                          (without opts :multival?))]
                                                         unifications
                                                         (without opts :multival?))]
            (table.insert condition subcondition)
            (icollect [_ b (ipairs subbindings) &into bindings] b))))
    (values condition bindings)))
diff --git a/test/core.fnl b/test/core.fnl
index 2ceb6bd..ba3556c 100644
--- a/test/core.fnl
+++ b/test/core.fnl
@@ -243,6 +243,8 @@
  (== (let [(a b) ((fn [] (values 4 2)))] (+ a b)) 6)
  (== (let [({: x} y) (values {:x 10} 20)] (+ x y)) 30)
  (== (let [[a & b] (setmetatable {} {:__fennelrest #42})] b) 42)
  (== (case (setmetatable [1] {:__fennelrest #47}) [a & b] b) 47)
  (== (match (setmetatable [2] {:__fennelrest #27}) [a & b] b) 27)
  (== (let [[a & b] (setmetatable {} {:__fennelrest #false})] b) false)
  (== (let [[a [b c] d] [4 [2 43] 7]] (+ (* a b) (- c d))) 44)
  (== (let [[a b & c] [1 2 3 4 5]] (+ a (. c 2) (. c 3))) 10)
@@ -253,6 +255,8 @@
  (== (let [{: a & r} {:a 1 :b 2}] a) 1)
  (== (let [{: a & r} {:a 1 :b 2}] r) {:b 2})
  (== (let [{: a : b} {:a 3 :b 5}] (+ a b)) 8)
  (== (case {:a 4 :b 6} {: a & r} r) {:b 6})
  (== (match {:a 7 :b 8} {: a & r} r) {:b 8})
  (== (let [{:a [x y z]} {:a [1 2 4]}] (+ x y z)) 7)
  (== (let [{:a x :b y} {:a 2 :b 4}] (+ x y)) 6)
  (== (let [[a & b] (setmetatable [1 2 3 4 5]
-- 
2.40.1
fennel/patches/.build.yml: SUCCESS in 55s

[Fix https://todo.sr.ht/~technomancy/fennel/171][0] from [Andrey Listopadov][1]

[0]: https://lists.sr.ht/~technomancy/fennel/patches/41255
[1]: mailto:andreyorst@gmail.com

✓ #992119 SUCCESS fennel/patches/.build.yml https://builds.sr.ht/~technomancy/job/992119
Andrey Listopadov <andreyorst@gmail.com> writes: