[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.
Thanks! Trying the tests here has made me realize that bnot doesn't work
with the --use-bit-lib flag, so I'm tracking that here:
https://todo.sr.ht/~technomancy/fennel/156
But that's unrelated to the issue at hand, so I'll just go ahead and
apply both your patches. (this one and the line number one).
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]))
This function can actually be written more succinctly as a pattern match:
(fn flatten-associative [op-sym form]
(match (list? form)
[op-sym a b &as op-call] (doto op-call (table.remove 1))
_ [form]))
This works because an idiosyncrasy in Fennel where the type predicates
return their argument rather than true, and by adding a and b to the
pattern, we ensure that the length is at least 3, because they're
guaranteed to not be nil.
I wonder if we can use this same logic to make it so that t[k][k2]
compiles to a single . call instead of (. (. t k) k2).
It's not exactly the same thing since they're not operators, but it's
pretty similar. Maybe I'll take a look at this later if no one beats me
to it.
Never mind; figured it out. =)
Nice!
Ambrose
https://git.sr.ht/~technomancy/antifennel/commit/31d79f28502b34fd7bbce957d391cfed15e0e395
-Phil
-Phil
+ + (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)
+
Ambrose Bonnaire-Sergeant <abonnairesergeant@gmail.com> writes: