Adding automatic gensym macro

Adding to the manual gensym for macros are 2 new
macros, but very literal from the CL in
letoverlambda.

The first is the (with-gensyms ...) macro that
can generate a small set of syms for a macro. Works
something like:

(defmacro adder2 [A B]
  (with-gensyms [a b]
    `(let [[~a ~A] [~b ~B]]
       (+ ~a ~b))))

and ~a and ~b will be replaced with (gensym "a") and
(gensym "b") respectively.

Then the final macro is a new defmacro that will automatically
replace symbols prefaced with "g!" with a new gensym based on the
rest of the symbol. So in this final version of 'nif':

(defmacro/g! nif4 (expr pos zero neg)
  `(let [[~g!result ~expr]]
     (cond [(pos? ~g!result) ~pos]
           [(zero? ~g!result) ~zero]
           [(neg? ~g!result) ~neg])))

all uses of ~g!result will be replaced with (gensym "result").

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?])

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))))

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))

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))))