diff --git a/hy/core/language.hy b/hy/core/language.hy index e1b8083..d112853 100644 --- a/hy/core/language.hy +++ b/hy/core/language.hy @@ -88,6 +88,19 @@ (if (pred val) (yield val))))) +(defn flatten [coll] + "Return a single flat list expanding all members of coll" + (if (and (iterable? coll) (not (string? coll))) + (_flatten coll []) + (raise (TypeError (.format "{0!r} is not a collection" coll))))) + +(defn _flatten [coll result] + (if (and (iterable? coll) (not (string? coll))) + (do (foreach [b coll] + (_flatten b result))) + (.append result coll)) + result) + (defn float? [x] "Return True if x is float" (isinstance x float)) @@ -237,8 +250,8 @@ (_numeric_check n) (= n 0)) -(def *exports* '[cycle dec distinct drop drop-while empty? even? filter float? - gensym +(def *exports* '[cycle dec distinct drop drop-while empty? even? filter flatten + float? gensym inc instance? integer integer? iterable? iterate iterator? neg? none? nth numeric? odd? pos? remove repeat repeatedly second string string? take take-nth take-while zero?]) diff --git a/hy/core/macros.hy b/hy/core/macros.hy index 79c7983..a82bceb 100644 --- a/hy/core/macros.hy +++ b/hy/core/macros.hy @@ -116,3 +116,13 @@ (let [[x (gensym)]] `(foreach [~x ~iterable] (yield ~x)))) + +(defmacro with-gensyms [args &rest body] + `(let ~(HyList (map (fn [x] `[~x (gensym '~x)]) args)) + ~@body)) + +(defmacro defmacro/g! [name args &rest body] + (let [[syms (list (distinct (filter (fn [x] (.startswith x "g!")) (flatten body))))]] + `(defmacro ~name [~@args] + (let ~(HyList (map (fn [x] `[~x (gensym (slice '~x 2))]) syms)) + ~@body)))) diff --git a/tests/native_tests/core.hy b/tests/native_tests/core.hy index 39dee93..aedf99c 100644 --- a/tests/native_tests/core.hy +++ b/tests/native_tests/core.hy @@ -133,6 +133,26 @@ (setv res (list (filter none? [1 2 None 3 4 None 4 6]))) (assert-equal res [None None])) +(defn test-flatten [] + "NATIVE: testing the flatten function" + (setv res (flatten [1 2 [3 4] 5])) + (assert-equal res [1 2 3 4 5]) + (setv res (flatten ["foo" (, 1 2) [1 [2 3] 4] "bar"])) + (assert-equal res ["foo" 1 2 1 2 3 4 "bar"]) + (setv res (flatten [1])) + (assert-equal res [1]) + (setv res (flatten [])) + (assert-equal res []) + (setv res (flatten (, 1))) + (assert-equal res [1]) + ;; test with None + (setv res (flatten (, 1 (, None 3)))) + (assert-equal res [1 None 3]) + (try (flatten "foo") + (catch [e [TypeError]] (assert (in "not a collection" (str e))))) + (try (flatten 12.34) + (catch [e [TypeError]] (assert (in "not a collection" (str e)))))) + (defn test-float? [] "NATIVE: testing the float? function" (assert-true (float? 4.2)) diff --git a/tests/native_tests/native_macros.hy b/tests/native_tests/native_macros.hy index ea252e5..911a9c9 100644 --- a/tests/native_tests/native_macros.hy +++ b/tests/native_tests/native_macros.hy @@ -131,3 +131,48 @@ (assert (in ":G_" s2)) ;; but make sure the two don't match each other (assert (not (= s1 s2)))) + +(defn test-with-gensym [] + (import ast) + (import [astor.codegen [to_source]]) + (import [hy.importer [import_buffer_to_ast]]) + (setv macro1 "(defmacro nif [expr pos zero neg] + (with-gensyms [a] + `(let [[~a ~expr]] + (cond [(pos? ~a) ~pos] + [(zero? ~a) ~zero] + [(neg? ~a) ~neg])))) + + (print (nif (inc -1) 1 0 -1)) + ") + ;; expand the macro twice, should use a different + ;; gensym each time + (setv _ast1 (import_buffer_to_ast macro1 "foo")) + (setv _ast2 (import_buffer_to_ast macro1 "foo")) + (setv s1 (to_source _ast1)) + (setv s2 (to_source _ast2)) + (assert (in ":a_" s1)) + (assert (in ":a_" s2)) + (assert (not (= s1 s2)))) + +(defn test-defmacro-g! [] + (import ast) + (import [astor.codegen [to_source]]) + (import [hy.importer [import_buffer_to_ast]]) + (setv macro1 "(defmacro/g! nif [expr pos zero neg] + `(let [[~g!res ~expr]] + (cond [(pos? ~g!res) ~pos] + [(zero? ~g!res) ~zero] + [(neg? ~g!res) ~neg]))) + + (print (nif (inc -1) 1 0 -1)) + ") + ;; expand the macro twice, should use a different + ;; gensym each time + (setv _ast1 (import_buffer_to_ast macro1 "foo")) + (setv _ast2 (import_buffer_to_ast macro1 "foo")) + (setv s1 (to_source _ast1)) + (setv s2 (to_source _ast2)) + (assert (in ":res_" s1)) + (assert (in ":res_" s2)) + (assert (not (= s1 s2))))