diff options
| -rw-r--r-- | core.fnl | 46 | ||||
| -rw-r--r-- | macros/core.fnl | 55 |
2 files changed, 54 insertions, 47 deletions
@@ -127,7 +127,7 @@ If `tbl' is sequential table, returns its shallow copy." (tset seq k v)) (if assoc? assoc seq)))) -(macro -safe-seq [tbl] +(macro safe-seq [tbl] "Create sequential table, or empty table if `seq' returned `nil'." `(or (seq ,tbl) [])) @@ -172,7 +172,7 @@ If `tbl' is sequential table, returns its shallow copy." ([tbl x & xs] (apply conj (conj tbl x) xs))) -(fn* -consj +(fn* consj "Like conj but joins at the front. Modifies `tbl'." ([] []) ([tbl] tbl) @@ -180,22 +180,20 @@ If `tbl' is sequential table, returns its shallow copy." (when-some [x x] (doto tbl (insert 1 x)))) ([tbl x & xs] - (if (> (length xs) 0) - (let [[y & xs] xs] (apply -consj (-consj tbl x) y xs)) - (-consj tbl x)))) + (apply consj (consj tbl x) xs))) (fn& core.cons [x tbl] "Insert `x' to `tbl' at the front. Modifies `tbl'." (if-some [x x] - (doto (-safe-seq tbl) + (doto (safe-seq tbl) (insert 1 x)) tbl)) (fn* core.concat "Concatenate tables." ([] nil) - ([x] (-safe-seq x)) - ([x y] (into (-safe-seq x) (-safe-seq y))) + ([x] (safe-seq x)) + ([x y] (into (safe-seq x) (safe-seq y))) ([x y & xs] (apply concat (concat x y) xs))) @@ -215,7 +213,7 @@ of applying f to val and the first item in coll, then applying f to that result and the 2nd item, etc. If coll contains no items, returns val and f is not called." ([f tbl] - (let [tbl (-safe-seq tbl)] + (let [tbl (safe-seq tbl)] (match (length tbl) 0 (f) 1 (. tbl 1) @@ -223,7 +221,7 @@ val and f is not called." _ (let [[a b & rest] tbl] (reduce f (f a b) rest))))) ([f val tbl] - (let [tbl (-safe-seq tbl)] + (let [tbl (safe-seq tbl)] (let [[x & xs] tbl] (if (nil? x) val @@ -241,7 +239,7 @@ contains no entries, returns `val' and `f' is not called. Note that reduce-kv is supported on vectors, where the keys will be the ordinals." [f val tbl] (var res val) - (each [_ [k v] (pairs (-safe-seq tbl))] + (each [_ [k v] (pairs (safe-seq tbl))] (set res (f res k v))) res) @@ -256,14 +254,14 @@ any of the tables is exhausted. All remaining values are ignored. Returns a table of results." ([f tbl] (local res []) - (each [_ v (ipairs (-safe-seq tbl))] + (each [_ v (ipairs (safe-seq tbl))] (when-some [tmp (f v)] (insert res tmp))) res) ([f t1 t2] (let [res [] - t1 (-safe-seq t1) - t2 (-safe-seq t2)] + t1 (safe-seq t1) + t2 (safe-seq t2)] (var (i1 v1) (next t1)) (var (i2 v2) (next t2)) (while (and i1 i2) @@ -274,9 +272,9 @@ ignored. Returns a table of results." res)) ([f t1 t2 t3] (let [res [] - t1 (-safe-seq t1) - t2 (-safe-seq t2) - t3 (-safe-seq t3)] + t1 (safe-seq t1) + t2 (safe-seq t2) + t3 (safe-seq t3)] (var (i1 v1) (next t1)) (var (i2 v2) (next t2)) (var (i3 v3) (next t3)) @@ -292,9 +290,9 @@ ignored. Returns a table of results." (when (->> tbls (mapv #(~= (next $) nil)) (reduce #(and $1 $2))) - (cons (mapv #(first (-safe-seq $)) tbls) (step (mapv rest tbls))))) + (cons (mapv #(first (safe-seq $)) tbls) (step (mapv rest tbls))))) res []] - (each [_ v (ipairs (step (-consj tbls t3 t2 t1)))] + (each [_ v (ipairs (step (concat [t1 t2 t3] tbls)))] (when-some [tmp (apply f v)] (insert res tmp))) res))) @@ -306,7 +304,7 @@ ignored. Returns a table of results." (cons f (filter pred r)) (filter pred r))))) -(fn -kvseq [tbl] +(fn kvseq [tbl] "Transforms any table kind to key-value sequence." (let [res []] (each [k v (pairs tbl)] @@ -318,8 +316,8 @@ ignored. Returns a table of results." ([x] true) ([x y] (if (and (= (type x) :table) (= (type y) :table)) - (and (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. y k) v)) (-kvseq x))) - (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. x k) v)) (-kvseq y)))) + (and (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. y k) v)) (kvseq x))) + (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. x k) v)) (kvseq y)))) (= x y))) ([x y & xs] (reduce #(and $1 $2) (eq? x y) (mapv #(eq? x $) xs)))) @@ -337,7 +335,7 @@ ignored. Returns a table of results." ([x y z] (f (g x y z))) ([x y z & args] (f (g x y z (unpack args)))))) ([f g & fs] - (reduce comp (-consj fs g f)))) + (reduce comp (concat [f g] fs)))) (fn* core.every? [pred tbl] @@ -378,7 +376,7 @@ oppisite truth value." (fn& core.reverse [tbl] (when-some [tbl (seq tbl)] - (reduce -consj [] tbl))) + (reduce consj [] tbl))) (fn* core.inc "Increase number by one" [x] (+ x 1)) (fn* core.dec "Decrease number by one" [x] (- x 1)) diff --git a/macros/core.fnl b/macros/core.fnl index d107ad6..bbff020 100644 --- a/macros/core.fnl +++ b/macros/core.fnl @@ -3,7 +3,7 @@ (local unpack (or table.unpack _G.unpack)) (local insert table.insert) -(fn -check-bindings [bindings] +(fn check-bindings [bindings] (and (assert-compile (sequence? bindings) "expected binding table" []) (assert-compile (= (length bindings) 2) "expected exactly two forms in binding vector." bindings))) @@ -11,7 +11,7 @@ ([bindings then] (if-let bindings then nil)) ([bindings then else] - (-check-bindings bindings) + (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if tmp# @@ -21,7 +21,7 @@ (fn* core.when-let [bindings & body] - (-check-bindings bindings) + (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if tmp# @@ -32,7 +32,7 @@ ([bindings then] (if-some bindings then nil)) ([bindings then else] - (-check-bindings bindings) + (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if (= tmp# nil) @@ -42,7 +42,7 @@ (fn* core.when-some [bindings & body] - (-check-bindings bindings) + (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if (= tmp# nil) @@ -51,12 +51,12 @@ ,(unpack body)))))) -(fn -table-type [tbl] +(fn table-type [tbl] (if (sequence? tbl) :seq (table? tbl) :table :else)) -(fn -table-type-fn [] +(fn table-type-fn [] `(fn [tbl#] (let [t# (type tbl#)] (if (= t# :table) @@ -66,7 +66,7 @@ :table)) :else)))) -(fn -seq-fn [] +(fn seq-fn [] `(fn [tbl#] (var assoc# false) (let [res# [] @@ -79,8 +79,8 @@ (if assoc# res# tbl#)))) (fn& core.into [to from] - (let [to-type (-table-type to) - from-type (-table-type from)] + (let [to-type (table-type to) + from-type (table-type from)] (if (and (= to-type :seq) (= from-type :seq)) `(let [to# ,to insert# table.insert] @@ -89,7 +89,7 @@ to#) (= to-type :seq) `(let [to# ,to - seq# ,(-seq-fn) + seq# ,(seq-fn) insert# table.insert] (each [_# v# (ipairs (seq# ,from))] (insert# to# v#)) @@ -108,7 +108,7 @@ (= to-type :table) `(let [to# ,to from# ,from] - (match (,(-table-type-fn) from#) + (match (,(table-type-fn) from#) :seq (each [_# [k# v#] (ipairs from#)] (tset to# k# v#)) :table (each [k# v# (pairs from#)] @@ -118,8 +118,8 @@ `(let [to# ,to from# ,from insert# table.insert - table-type# ,(-table-type-fn) - seq# ,(-seq-fn)] + table-type# ,(table-type-fn) + seq# ,(seq-fn)] (match (table-type# to#) :seq (each [_# v# (ipairs (seq# from#))] (insert# to# v#)) @@ -154,17 +154,26 @@ dispatch-fn (first opts)] `(local ,name (let [multimethods# {}] - (setmetatable {} {:__call - (fn [_# ...] - ,docstring - ((or (. multimethods# (,dispatch-fn ...)) - (. multimethods# :default)) ...)) - :multimethods multimethods#}))))) + (setmetatable + {} + {:__call + (fn [_# ...] + ,docstring + (let [dispatch-value# (,dispatch-fn ...)] + ((or (. multimethods# dispatch-value#) + (. multimethods# :default) + (error (.. "No method in multimethod '" + ,(tostring name) + "' for dispatch value: " + dispatch-value#) 2)) ...))) + :multimethods multimethods#}))))) (fn* core.defmethod [multifn dispatch-val & fn-tail] - `(tset (. (getmetatable ,multifn) :multimethods) - ,dispatch-val - (fn ,(unpack fn-tail)))) + `(let [multifn# ,multifn] + (tset (. (getmetatable multifn#) :multimethods) + ,dispatch-val + (fn ,(unpack fn-tail))) + multifn#)) core |