From c80e3c75a04d07c42987d0881a20d42f62af4075 Mon Sep 17 00:00:00 2001 From: Bob Tolbert Date: Sun, 15 Dec 2013 18:47:46 -0700 Subject: [PATCH] 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 | 17 +++++++++-- hy/core/macros.hy | 10 +++++++ tests/native_tests/core.hy | 20 +++++++++++++ tests/native_tests/native_macros.hy | 45 +++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 2 deletions(-) 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))))