From fe916085784ca5615c879f80261f01954a2a1dd5 Mon Sep 17 00:00:00 2001 From: Andrey Listopadov Date: Thu, 11 Mar 2021 19:09:28 +0300 Subject: fix: update macros comparison function builder No need to modify the metatable in macros. --- .dir-locals.el | 2 +- init.fnl | 1 + macros.fnl | 53 ++++++++++++++++++++++++++--------------------------- tests/core.fnl | 22 +++++++++++----------- 4 files changed, 39 insertions(+), 39 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index 32da19e..84d8c5a 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -31,7 +31,7 @@ word-end) 1 'font-lock-keyword-face)))) (eval . (put 'when-meta 'fennel-indent-function 'defun)) - (eval . (put 'defmethod 'fennel-indent-function 'defun)) + (eval . (put 'defmethod 'fennel-indent-function 3)) (eval . (put 'defmulti 'bfennel-indent-function 'defun)) (eval . (put 'deftest 'fennel-indent-function 'defun)) (eval . (put 'testing 'fennel-indent-function 'defun)) diff --git a/init.fnl b/init.fnl index 5621127..a56da51 100644 --- a/init.fnl +++ b/init.fnl @@ -957,6 +957,7 @@ functions also reuse this indexing method, such as sets." (set count-b (+ count-b 1))) (set res (= count-a count-b))) res) + :else false)) ([x y & xs] (reduce #(and $1 $2) (eq x y) (mapv #(eq x $) xs))))) diff --git a/macros.fnl b/macros.fnl index 4503242..1fe6f6d 100644 --- a/macros.fnl +++ b/macros.fnl @@ -65,30 +65,29 @@ ;; This function is able to compare tables of any depth, even if one of ;; the tables uses tables as keys. `(fn eq# [left# right#] - (if (and (= (type left#) :table) (= (type right#) :table)) - (let [oldmeta# (getmetatable right#)] - ;; In case if we'll get something like - ;; `(eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}})` - ;; we have to do even deeper search - (setmetatable right# {:__index (fn [tbl# key#] - (var res# nil) - (each [k# v# (pairs tbl#)] - (when (eq# k# key#) - (set res# v#) - (lua :break))) - res#)}) - (var [res# count-a# count-b#] [true 0 0]) - (each [k# v# (pairs left#)] - (set res# (eq# v# (. right# k#))) - (set count-a# (+ count-a# 1)) - (when (not res#) (lua :break))) - (when res# - (each [_# _# (pairs right#)] - (set count-b# (+ count-b# 1))) - (set res# (= count-a# count-b#))) - (setmetatable right# oldmeta#) - res#) - (= left# right#)))) + (if (= left# right#) + true + (and (= (type left#) :table) (= (type right#) :table)) + (do (var [res# count-a# count-b#] [true 0 0]) + (each [k# v# (pairs left#)] + (set res# (eq# v# ((fn deep-index# [tbl# key#] + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#) + right# k#))) + (set count-a# (+ count-a# 1)) + (when (not res#) + (lua :break))) + (when res# + (each [_# _# (pairs right#)] + (set count-b# (+ count-b# 1))) + (set res# (= count-a# count-b#))) + res#) + :else + false))) (fn seq-fn [] ;; Returns function that transforms tables and strings into sequences. @@ -865,14 +864,13 @@ See `into' for more info on how conversion is done." (fn [t# ...] ,docstring (let [dispatch-value# (,dispatch-fn ...) - (res# view#) (pcall require :fennelview) - tostr# (if res# #(view# $ {:one-line true}) tostring)] + view# #((. (require :fennel) :view) $ {:one-line true})] ((or (. t# dispatch-value#) (. t# (or (. ,options :default) :default)) (error (.. "No method in multimethod '" ,(tostring name) "' for dispatch value: " - (tostr# dispatch-value#)) + (view# dispatch-value#)) 2)) ...))) :__name (.. "multifn " ,(tostring name)) :__fennelview tostring @@ -1199,6 +1197,7 @@ Always run some side effect action: (setmetatable {: fn* + : eq-fn : try : if-let : when-let diff --git a/tests/core.fnl b/tests/core.fnl index 429df46..69a6678 100644 --- a/tests/core.fnl +++ b/tests/core.fnl @@ -27,13 +27,13 @@ (assert-eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]]) (assert-is (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) (assert-is (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) (assert-not (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[6] {:a [1 [1 [1 [1]]]]}}]])) + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[6] {:a [1 [1 [1 [1]]]]}}]])) (assert-ne [1] [1 2]) (assert-ne [1 2] [1]) (assert-is (eq [1 [2]] [1 [2]] [1 [2]])) @@ -227,18 +227,18 @@ (into {} [[:a 1] [:b 4] [:c 9]])) (assert-eq (into {} (mapv (fn [[k1 v1] [k2 v2]] [k1 (* v1 v2)]) - {:a 1 :b 2 :c 3} - {:a -1 :b 0 :c 2})) + {:a 1 :b 2 :c 3} + {:a -1 :b 0 :c 2})) {:a -1 :b 0 :c 6}) (assert-eq (mapv #(* $1 $2 $3) [1] [2] [-1]) [-2]) (assert-eq (mapv string.upper ["a" "b" "c"]) ["A" "B" "C"]) (assert-eq (mapv #(+ $1 $2 $3 $4) [1 -1] [2 -2] [3 -3] [4 -4]) [(+ 1 2 3 4) (+ -1 -2 -3 -4)]) (assert-eq (mapv (fn [f-name s-name company position] (.. f-name " " s-name " works as " position " at " company)) - ["Bob" "Alice"] - ["Smith" "Watson"] - ["Happy Days co." "Coffee With You"] - ["secretary" "chief officer"]) + ["Bob" "Alice"] + ["Smith" "Watson"] + ["Happy Days co." "Coffee With You"] + ["secretary" "chief officer"]) ["Bob Smith works as secretary at Happy Days co." "Alice Watson works as chief officer at Coffee With You"]) (assert-eq (table.concat (mapv string.upper "vaiv")) "VAIV")) -- cgit v1.2.3