hy/tests/native_tests/native_macros.hy

(defmacro rev [&rest body]
  "Execute the `body` statements in reverse"
  (quasiquote (do (unquote-splice (list (reversed body))))))


(defn test-rev-macro []
  "NATIVE: test stararged native macros"
  (setv x [])
  (rev (.append x 1) (.append x 2) (.append x 3))
  (assert (= x [3 2 1])))

; Macros returning constants

(defmacro an-int [] 42)
(assert (= (an-int) 42))

(defmacro a-true [] True)
(assert (= (a-true) True))
(defmacro a-false [] False)
(assert (= (a-false) False))

(defmacro a-float [] 42.)
(assert (= (a-float) 42.))

(defmacro a-complex [] 42j)
(assert (= (a-complex) 42j))

(defmacro a-string [] "foo")
(assert (= (a-string) "foo"))

(defmacro a-list [] [1 2])
(assert (= (a-list) [1 2]))

(defmacro a-tuple [&rest b] b)
(assert (= (a-tuple 1 2) [1 2]))

(defmacro a-dict [] {1 2})
(assert (= (a-dict) {1 2}))

(defmacro a-none [])
(assert (= (a-none) None))

; A macro calling a previously defined function
(eval-when-compile
 (defn foo [x y]
   (quasiquote (+ (unquote x) (unquote y)))))

(defmacro bar [x y]
  (foo x y))

(defn test-fn-calling-macro []
  "NATIVE: test macro calling a plain function"
  (assert (= 3 (bar 1 2))))

(defn test-midtree-yield []
  "NATIVE: test yielding with a returnable"
  (defn kruft [] (yield) (+ 1 1)))

(defn test-midtree-yield-in-for []
  "NATIVE: test yielding in a for with a return"
  (defn kruft-in-for []
    (for* [i (range 5)]
      (yield i))
    (+ 1 2)))

(defn test-midtree-yield-in-while []
  "NATIVE: test yielding in a while with a return"
  (defn kruft-in-while []
    (setv i 0)
    (while (< i 5)
      (yield i)
      (setv i (+ i 1)))
    (+ 2 3)))

(defn test-multi-yield []
  "NATIVE: testing multiple yields"
  (defn multi-yield []
    (for* [i (range 3)]
      (yield i))
    (yield "a")
    (yield "end"))
  (assert (= (list (multi-yield)) [0 1 2 "a" "end"])))


; Macro that checks a variable defined at compile or load time
(setv phase "load")
(eval-when-compile
 (setv phase "compile"))
(defmacro phase-when-compiling [] phase)
(assert (= phase "load"))
(assert (= (phase-when-compiling) "compile"))

(setv initialized False)
(eval-and-compile
 (setv initialized True))
(defmacro test-initialized [] initialized)
(assert initialized)
(assert (test-initialized))

(defn test-if-python2 []
  (import sys)
  (assert (= (get sys.version_info 0)
             (if-python2 2 3))))

(defn test-gensym-in-macros []
  (import ast)
  (import [astor.codegen [to_source]])
  (import [hy.importer [import_buffer_to_ast]])
  (setv macro1 "(defmacro nif [expr pos zero neg]
      (let [[g (gensym)]]
        `(let [[~g ~expr]]
           (cond [(pos? ~g) ~pos]
                 [(zero? ~g) ~zero]
                 [(neg? ~g) ~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))
  ;; and make sure there is something new that starts with :G_
  (assert (in ":G_" s1))
  (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))))


(defn test-if-not []
  (assert (= (if-not True :yes :no)
             :no))
  (assert (= (if-not False :yes :no)
             :yes))
  (assert (nil? (if-not True :yes)))
  (assert (= (if-not False :yes)
             :yes)))


(defn test-lisp-if []
  "test that lisp-if works as expected"
  ; nil is false
  (assert (= (lisp-if None "true" "false") "false"))
  (assert (= (lisp-if nil "true" "false") "false"))

  ; But everything else is True!  Even falsey things.
  (assert (= (lisp-if True "true" "false") "true"))
  (assert (= (lisp-if False "true" "false") "true"))
  (assert (= (lisp-if 0 "true" "false") "true"))
  (assert (= (lisp-if "some-string" "true" "false") "true"))
  (assert (= (lisp-if "" "true" "false") "true"))
  (assert (= (lisp-if (+ 1 2 3) "true" "false") "true"))

  ; Just to be sure, test the alias lif
  (assert (= (lif nil "true" "false") "false"))
  (assert (= (lif 0 "true" "false") "true")))


(defn test-defn-alias []
  (defn-alias [tda-main tda-a1 tda-a2] [] :bazinga)
  (defun-alias [tda-main tda-a1 tda-a2] [] :bazinga)
  (assert (= (tda-main) :bazinga))
  (assert (= (tda-a1) :bazinga))
  (assert (= (tda-a2) :bazinga))
  (assert (= tda-main tda-a1 tda-a2)))