Merge branch 'master' into pr/425

Conflicts:
	hy/core/language.hy

docs/language/api.rst

@@ -28,7 +28,9 @@ languages.
     and `i♥u` will become `hy_iu_t0x`.
 
   * Symbols that contain dashes will have them replaced with underscores. For
-    example, `render-template` will become `render_template`.
+    example, `render-template` will become `render_template`. This means that
+    symbols with dashes will shadow their underscore equivalents, and vice
+    versa.
 
 
 Builtins
@@ -97,6 +99,36 @@ appends it as the last argument. The following code demonstrates this:
     5 10
 
 
+apply
+-----
+
+`apply` is used to apply an optional list of arguments and an optional
+dictionary of kwargs to a function.
+
+Usage: `(apply fn-name [args] [kwargs])`
+
+Examples:
+
+.. code-block:: clj
+    (defn thunk []
+      "hy there")
+
+    (apply thunk)
+    ;=> "hy there"
+
+    (defn total-purchase [price amount &optional [fees 1.05] [vat 1.1]]
+      (* price amount fees vat))
+
+    (apply total-purchase [10 15])
+    ;=> 173.25
+
+    (apply total-purchase [10 15] {"vat" 1.05})
+    ;=> 165.375
+
+    (apply total-purchase [] {"price" 10 "amount" 15 "vat" 1.05})
+    ;=> 165.375
+
+
 and
 ---
 
@@ -990,6 +1022,42 @@ given conditional is False. The following shows how the macro expands into code.
       None 
       (do statement))
 
+
+unquote
+-------
+
+Within a quasiquoted form, `unquote` forces evaluation of a symbol. `unquote`
+is aliased to the `~` symbol.
+
+.. code-block:: clj
+
+    (def name "Cuddles")
+    (quasiquote (= name (unquote name)))
+    ;=> (u'=' u'name' u'Cuddles')
+
+    `(= name ~name)
+    ;=> (u'=' u'name' u'Cuddles')
+
+
+unquote-splice
+--------------
+
+`unquote-splice` forces the evaluation of a symbol within a quasiquoted form,
+much like `unquote`. `unquote-splice` can only be used when the symbol being
+unquoted contains an iterable value, as it "splices" that iterable into the
+quasiquoted form. `unquote-splice` is aliased to the `~@` symbol.
+
+.. code-block:: clj
+
+    (def nums [1 2 3 4])
+    (quasiquote (+ (unquote-splice nums)))
+    ;=> (u'+' 1L 2L 3L 4L)
+
+    `(+ ~@nums)
+    ;=> (u'+' 1L 2L 3L 4L)
+
+
+
 when
 ----
 

docs/language/core.rst

@@ -6,6 +6,29 @@ Hy Core
 Core Functions
 ===============
 
+.. _is-coll-fn:
+
+coll?
+----
+
+.. versionadded:: 0.9.13
+
+Usage: ``(coll? x)``
+
+Returns true if argument is iterable and not a string.
+
+.. code-block:: clojure
+
+   => (coll? [1 2 3 4])
+   True
+
+   => (coll? {"a" 1 "b" 2})
+   True
+
+   => (coll? "abc")
+   False
+
+
 .. _dec-fn:
 
 dec

hy/contrib/profile.hy

@@ -23,7 +23,15 @@
 ;;; These macros make debugging where bottlenecks exist easier.
 
 
-(defmacro/g! profile [&rest body]
+(defmacro profile/calls [&rest body]
+  `(do
+     (import [pycallgraph [PyCallGraph]]
+             [pycallgraph.output [GraphvizOutput]])
+     (with* [(apply PyCallGraph [] {"output" (GraphvizOutput)})]
+           ~@body)))
+
+
+(defmacro/g! profile/cpu [&rest body]
   " Profile a bit of code "
   `(do
      (import cProfile pstats)

hy/core/language.hy

@@ -30,6 +30,10 @@
   (if (not (numeric? x))
     (raise (TypeError (.format "{0!r} is not a number" x)))))
 
+(defn coll? [coll]
+  "Checks whether item is a collection"
+  (and (iterable? coll) (not (string? coll))))
+
 (defn cycle [coll]
   "Yield an infinite repetition of the items in coll"
   (setv seen [])
@@ -112,7 +116,7 @@
 
 (defn flatten [coll]
   "Return a single flat list expanding all members of coll"
-  (if (and (iterable? coll) (not (string? coll)))
+  (if (coll? coll)
     (_flatten coll [])
     (raise (TypeError (.format "{0!r} is not a collection" coll)))))
 
@@ -306,9 +310,10 @@
   (_numeric_check n)
   (= n 0))
 
-(def *exports* '[calling-module-name cycle dec distinct disassemble
-                 drop drop-while empty? even? filter first flatten float?
-                 gensym inc instance? integer integer? iterable? iterate
-                 iterator? macroexpand macroexpand-1 neg? nil? none?
-                 nth numeric? odd? pos? remove repeat repeatedly rest
-                 second string string? take take-nth take-while zero?])
+(def *exports* '[calling-module-name coll? cycle dec distinct
+		 disassemble drop drop-while empty? even? filter flatten
+		 float? gensym inc instance? integer integer? iterable?
+		 iterate iterator? macroexpand macroexpand-1 neg? nil?
+		 none?  nth numeric? odd? pos? remove repeat repeatedly
+		 second string string? take take-nth take-while zero?
+         first rest])

hy/core/macros.hy

@@ -45,10 +45,18 @@
 
   (if (empty? body)
     (macro-error None "`for' requires a body to evaluate"))
-  (if args
-    `(for* [~(.pop args 0) ~(.pop args 0)]
-       (for ~args ~@body))
-    `(do ~@body)))
+
+  (if (empty? args)
+    `(do ~@body)
+    (if (= (len args) 2)
+      ; basecase, let's just slip right in.
+      `(for* [~@args] ~@body)
+      ; otherwise, let's do some legit handling.
+      (let [[alist (slice args 0 nil 2)]
+            [ilist (slice args 1 nil 2)]]
+        `(do
+           (import itertools)
+           (for* [(, ~@alist) (itertools.product ~@ilist)] ~@body))))))
 
 
 (defmacro with [args &rest body]

tests/native_tests/core.hy

@@ -30,6 +30,14 @@
 (defn assert-equal [x y]
   (assert (= x y)))
 
+(defn test-coll? []
+  "NATIVE: testing coll?"
+  (assert-true (coll? [1 2 3]))
+  (assert-true (coll? {"a" 1 "b" 2}))
+  (assert-true (coll? (range 10)))
+  (assert-false (coll? "abc"))
+  (assert-false (coll? 1)))
+
 (defn test-cycle []
   "NATIVE: testing cycle"
   (assert-equal (list (cycle [])) [])

tests/native_tests/language.hy

@@ -41,6 +41,46 @@
   (assert (= count 150)))
 
 
+(defn test-nasty-for-nesting []
+  "NATIVE: test nesting for loops harder"
+  ;; This test and feature is dedicated to @nedbat.
+
+  ;; let's ensure empty iterating is an implicit do
+  (setv t 0)
+  (for [] (setv t 1))
+  (assert (= t 1))
+
+  ;; OK. This first test will ensure that the else is hooked up to the
+  ;; for when we break out of it.
+  (for [x (range 2)
+        y (range 2)]
+      (break)
+    (else (throw Exception)))
+
+  ;; OK. This next test will ensure that the else is hooked up to the
+  ;; "inner" iteration
+  (for [x (range 2)
+        y (range 2)]
+    (if (= y 1) (break))
+    (else (throw Exception)))
+
+  ;; OK. This next test will ensure that the else is hooked up to the
+  ;; "outer" iteration
+  (for [x (range 2)
+        y (range 2)]
+    (if (= x 1) (break))
+    (else (throw Exception)))
+
+  ;; OK. This next test will ensure that we call the else branch exactly
+  ;; once.
+  (setv flag 0)
+  (for [x (range 2)
+        y (range 2)]
+    (+ 1 1)
+    (else (setv flag (+ flag 2))))
+  (assert (= flag 2)))
+
+
 (defn test-while-loop []
   "NATIVE: test while loops?"
   (setv count 5)