~technomancy/fennel

v2 antifennel: Flatten associative operations v1 PROPOSED

Ambrose Bonnaire-Sergeant: 1
 Flatten associative operations

 3 files changed, 92 insertions(+), 7 deletions(-)
Ah! I noticed the same useful behavior with Lua's `assert`‚Äč.
Next
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/39721/mbox | git am -3
Learn more about email & git

[PATCH v2 antifennel] Flatten associative operations Export this patch

This nicely cleaned up a conversion I'm working with
that has bor's nested 6-deep.
Fixes v1 of this patch by only flattening operations
with 2 or more arguments.
---
 anticompiler.fnl  | 37 ++++++++++++++++++++++++++++++++-----
 test.lua          | 19 +++++++++++++++++++
 test_expected.fnl | 43 +++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 92 insertions(+), 7 deletions(-)

diff --git a/anticompiler.fnl b/anticompiler.fnl
index d7297b1..495851d 100644
--- a/anticompiler.fnl
+++ b/anticompiler.fnl
@@ -1,7 +1,7 @@
;; The name of this module is intended as a joke; this is in fact a compiler,
;; not an "anticompiler" even tho it goes in reverse from the fennel compiler
;; see http://nonadventures.com/2013/07/27/you-say-you-want-a-devolution/
(local {: list : mangle : sym : sym? : view : sequence : multi-sym? : sym-char?}
(local {: list : mangle : sym : sym? : view : sequence : multi-sym? : sym-char? : list?}
       (require :fennel))
(local unpack (or table.unpack _G.unpack))

@@ -12,6 +12,13 @@
      (table.insert out (f v (and with-last? (= i len)))))
    out))

(fn mapcat [tbl f]
  (let [out []]
    (each [_ v (ipairs tbl)]
      (each [_ v (ipairs (f v))]
        (table.insert out v)))
    out))

(fn distinct [tbl]
  (let [seen {}]
    (icollect [_ x (ipairs tbl)]
@@ -114,12 +121,32 @@
        (list (sym :lua)
              (.. "return " (table.concat (map args view) ", "))))))

(fn flatten-associative [associative-op-sym frm]
  (if (and (list? frm)
           (<= 3 (length frm))
           (= (. frm 1) associative-op-sym))
    (icollect [i frm (ipairs frm)]
      (when (not= 1 i)
        frm))
    [frm]))

(local associative-operators
  (collect [_ op (pairs [:band :bor :bxor :+ :*])]
    op op))
(fn binary [compile scope {: left : right : operator} ast]
  (let [operators {:== := "~=" :not= "#" :length "~" :bxor
                   :<< :lshift :>> :rshift :& :band :| :bor}]
    (list (sym (or (. operators operator) operator))
          (compile scope left)
          (compile scope right))))
                   :<< :lshift :>> :rshift :& :band :| :bor}
        op-str (or (. operators operator) operator)
        op-sym (sym op-str)
        compile (partial compile scope)]
    (if (. associative-operators op-str)
      (list op-sym
            (unpack
              (mapcat [left right]
                      #(flatten-associative op-sym (compile $)))))
      (list op-sym
            (compile left)
            (compile right)))))

(fn unary [compile scope {: argument : operator} ast]
  (let [operators {"~" :bnot}]
diff --git a/test.lua b/test.lua
index 718c456..b67a59b 100644
--- a/test.lua
+++ b/test.lua
@@ -120,7 +120,26 @@ assert ((50 >> 2) >> 1 == 6)
assert (50 >> (2 >> 1) == 25)
assert ((59 >> 2) << 127 == 0)
assert (59 >> (2 << 127) == 59)
assert (50 << 2 << 1 == 400)
assert ((50 << 2) << 1 == 400)
assert (50 << (2 << 1) == 800)
assert ((~ 1) == -2)
assert ((1 + (~ 1)) == -1)
assert (1 | 2 | 3 == 3)
assert (1 | (2 | 3) == 3)
assert (1 | 2 | 3 | 4 == 7)
assert (1 | (2 | 3 | 4) == 7)
assert (1 + 2 + 3 == 6)
assert (1 + 2 + 3 + 4 == 10)
assert (1 + (2 + 3) + 4 == 10)
assert (1 * 2 * 3 == 6)
assert (1 * 2 * 3 * 4 == 24)
assert (1 * (2 * 3) * 4 == 24)
assert (1 ~ 2 ~ 3 == 0)
assert (1 ~ 2 ~ 3 ~ 4 == 4)
assert (1 ~ (2 ~ 3) ~ 4 == 4)
assert ((1 ~ 2) & (3 ~ 4) == (1 & 3) ~ (1 & 4) ~ (2 & 3) ~ (2 & 4))
assert (16 / 4 / 4 == 1)
assert (16 / (4 / 4) == 16)

return (f123("path") or {"a", "b", "c"}).mode
diff --git a/test_expected.fnl b/test_expected.fnl
index b707e53..6383d40 100644
--- a/test_expected.fnl
+++ b/test_expected.fnl
@@ -35,8 +35,7 @@

(fn letter []
  (let [x 19
        y 20]
    (+ x y)))
        y 20] (+ x y)))

(noprint ((fn [] (let [x 1] x))))

@@ -123,8 +122,48 @@

(assert (= (rshift 59 (lshift 2 127)) 59))

(assert (= (lshift (lshift 50 2) 1) 400))

(assert (= (lshift (lshift 50 2) 1) 400))

(assert (= (lshift 50 (lshift 2 1)) 800))

(assert (= (bnot 1) (- 2)))

(assert (= (+ 1 (bnot 1)) (- 1)))

(assert (= (bor 1 2 3) 3))

(assert (= (bor 1 2 3) 3))

(assert (= (bor 1 2 3 4) 7))

(assert (= (bor 1 2 3 4) 7))

(assert (= (+ 1 2 3) 6))

(assert (= (+ 1 2 3 4) 10))

(assert (= (+ 1 2 3 4) 10))

(assert (= (* 1 2 3) 6))

(assert (= (* 1 2 3 4) 24))

(assert (= (* 1 2 3 4) 24))

(assert (= (bxor 1 2 3) 0))

(assert (= (bxor 1 2 3 4) 4))

(assert (= (bxor 1 2 3 4) 4))

(assert (= (band (bxor 1 2) (bxor 3 4))
           (bxor (band 1 3) (band 1 4) (band 2 3) (band 2 4))))

(assert (= (/ (/ 16 4) 4) 1))

(assert (= (/ 16 (/ 4 4)) 16))

(. (or (f123 :path) [:a :b :c]) :mode)

-- 
2.37.1 (Apple Git-137.1)
Ambrose Bonnaire-Sergeant <abonnairesergeant@gmail.com> writes: