implement into as a macro

1 files changed, 49 insertions, 1 deletions

diff --git a/macros/core.fnl b/macros/core.fnl
index e88d575..7c8af40 100644
--- a/macros/core.fnl
+++ b/macros/core.fnl
@@ -1,5 +1,6 @@
 (import-macros {: fn*} :macros.fn)
 (local _unpack (or table.unpack unpack))
+(local insert table.insert)
 
 (fn check-bindings [bindings]
   (assert-compile (sequence? bindings) "expected binding table
@@ -50,7 +51,54 @@
            (let [,form tmp#]
              ,(_unpack body))))))
 
+
+;; based on `seq' from `core.fnl'
+(fn into [to from]
+  (if (sequence? to)
+      `(let [to# ,to
+             from# ,from
+             insert# table.insert
+             unpack# (or table.unpack unpack)
+             res# []]
+         (var assoc# false)
+         (each [k# v# (pairs from#)]
+           (if (and (not assoc#)
+                    (not (= (type k#) "number")))
+               (set assoc# true))
+           (insert# res# [k# v#]))
+         (let [res# (if assoc# res# from#)]
+           (if (~= (next to#) nil)
+               (do (when (~= (next res#) nil)
+                     (each [_# v# (ipairs res#)]
+                       (insert# to# v#)))
+                   to#)
+               res#)))
+      ;; to support (into {} {}) we first need transform `from' into a
+      ;; sequential table.  Unfortunately it seems impossible to do
+      ;; this with `(into [] ,from)' call, as it results in infinity
+      ;; compilation loop.  Because of that the body of previous
+      ;; branch is repeated here almost entirely, although without
+      ;; some extra checks, as these aren't necessary in this case.
+      (table? to)
+      `(let [to# ,to
+             from# (let [from# ,from
+                         insert# table.insert
+                         unpack# (or table.unpack unpack)
+                         res# []]
+                     (var assoc# false)
+                     (each [k# v# (pairs from#)]
+                       (if (and (not assoc#)
+                                (not (= (type k#) "number")))
+                           (set assoc# true))
+                       (insert# res# [k# v#]))
+                     (if assoc# res# from#))]
+         (each [_# [k# v#] (ipairs from#)]
+           (tset to# k# v#))
+         to#)
+      `(error "expected table as the first argument" 2)))
+
 {: if-let
  : when-let
  : if-some
- : when-some}
+ : when-some
+ : into}