Merge branch 'master' into pr/585

AUTHORS

@@ -46,3 +46,4 @@
 * Brendan Curran-Johnson <brendan@bcjbcj.ca>
 * Ivan Kozik <ivan@ludios.org>
 * Allison Kaptur <allison.kaptur@gmail.com>
+* Matthew Wampler-Doty <matthew.wampler.doty@gmail.com>

docs/language/api.rst

@@ -613,6 +613,27 @@ del
   => dic
   {}
 
+doto
+----
+
+.. versionadded:: 0.10.1
+
+`doto` macro is used to make a sequence of method calls for an object easy.
+
+.. code-block:: clj
+
+  => (doto [] (.append 1) (.append 2) .reverse)
+  [2 1]
+
+.. code-block:: clj
+
+  => (setv collection [])
+  => (.append collection 1)
+  => (.append collection 2)
+  => (.reverse collection)
+  => collection
+  [2 1]
+
 eval
 ----
 

hy/compiler.py

@@ -1751,18 +1751,19 @@ class HyASTCompiler(object):
     def _compile_assign(self, name, result,
                         start_line, start_column):
         result = self.compile(result)
-
-        if result.temp_variables and isinstance(name, HyString):
-            result.rename(name)
-            return result
-
         ld_name = self.compile(name)
-        st_name = self._storeize(ld_name)
 
+        if result.temp_variables \
+           and isinstance(name, HyString) \
+           and '.' not in name:
+            result.rename(name)
+        else:
+            st_name = self._storeize(ld_name)
             result += ast.Assign(
                 lineno=start_line,
                 col_offset=start_column,
-            targets=[st_name], value=result.force_expr)
+                targets=[st_name],
+                value=result.force_expr)
 
         result += ld_name
         return result

hy/contrib/anaphoric.hy

@@ -46,9 +46,10 @@
 
 (defmacro ap-map [form lst]
   "Yield elements evaluated in the form for each element in the list."
-  `(let [[f (lambda [it] ~form)]]
-     (for [v ~lst]
-       (yield (f v)))))
+  (let [[v (gensym 'v)] [f (gensym 'f)]]
+    `(let [[~f (lambda [it] ~form)]]
+       (for [~v ~lst]
+         (yield (~f ~v))))))
 
 
 (defmacro ap-map-when [predfn rep lst]

hy/core/language.hy

@@ -34,6 +34,10 @@
   (if (not (numeric? x))
     (raise (TypeError (.format "{0!r} is not a number" x)))))
 
+(defn butlast [coll]
+  "Returns coll except of last element."
+  (itertools.islice coll 0 (dec (len coll))))
+
 (defn coll? [coll]
   "Checks whether item is a collection"
   (and (iterable? coll) (not (string? coll))))
@@ -58,17 +62,17 @@
   (- n 1))
 
 (defn disassemble [tree &optional [codegen false]]
-  "Dump the python AST for a given Hy tree to standard output
+  "Return the python AST for a quoted Hy tree as a string.
    If the second argument is true, generate python code instead."
   (import astor)
   (import hy.compiler)
 
   (fake-source-positions tree)
   (setv compiled (hy.compiler.hy_compile tree (calling-module-name)))
-  (print ((if codegen
+  ((if codegen
             astor.codegen.to_source
             astor.dump)
-          compiled)))
+          compiled))
 
 (defn distinct [coll]
   "Return a generator from the original collection with duplicates
@@ -327,7 +331,7 @@
   (_numeric_check n)
   (= n 0))
 
-(def *exports* '[calling-module-name coll? cons cons? cycle dec distinct
+(def *exports* '[butlast calling-module-name coll? cons cons? cycle dec distinct
                  disassemble drop drop-while empty? even? every? first filter
                  flatten float? gensym identity inc instance? integer
                  integer? integer-char? iterable? iterate iterator? keyword?

hy/core/macros.hy

@@ -31,34 +31,6 @@
         [hy._compat [PY33 PY34]])
 
 
-(defmacro for [args &rest body]
-  "shorthand for nested for loops:
-  (for [x foo
-        y bar]
-    baz) ->
-  (for* [x foo]
-    (for* [y bar]
-      baz))"
-
-  (if (odd? (len args))
-    (macro-error args "`for' requires an even number of args."))
-
-  (if (empty? body)
-    (macro-error None "`for' requires a body to evaluate"))
-
-  (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]
   "shorthand for nested for* loops:
   (with [[x foo] [y bar]] baz) ->
@@ -116,6 +88,26 @@
   root)
 
 
+(defmacro for [args &rest body]
+  "shorthand for nested for loops:
+  (for [x foo
+        y bar]
+    baz) ->
+  (for* [x foo]
+    (for* [y bar]
+      baz))"
+  (cond 
+   [(odd? (len args))
+    (macro-error args "`for' requires an even number of args.")]
+   [(empty? body)
+    (macro-error None "`for' requires a body to evaluate")]
+   [(empty? args) `(do ~@body)]
+   [(= (len args) 2)  `(for* [~@args] ~@body)]
+   [true 
+    (let [[alist (slice args 0 nil 2)]]
+      `(for* [(, ~@alist) (genexpr (, ~@alist) [~@args])] ~@body))]))
+
+
 (defmacro -> [head &rest rest]
   ;; TODO: fix the docstring by someone who understands this
   (setv ret head)
@@ -127,6 +119,18 @@
   ret)
 
 
+(defmacro doto [form &rest expressions]
+  "Performs a sequence of potentially mutating actions
+   on an initial object, returning the resulting object"
+  (setv f (gensym))
+  (defn build-form [expression]
+    (if (isinstance expression HyExpression)
+      `(~(first expression) ~f ~@(rest expression))
+      `(~expression ~f)))
+  `(let [[~f ~form]]
+     ~@(map build-form expressions)
+     ~f))
+
 (defmacro ->> [head &rest rest]
   ;; TODO: fix the docstring by someone who understands this
   (setv ret head)

tests/native_tests/contrib/anaphoric.hy

@@ -54,7 +54,9 @@
   (assert-equal (list (ap-map (* it 3) [1 2 3]))
                 [3 6 9])
   (assert-equal (list (ap-map (* it 3) []))
-                []))
+                [])
+  (assert-equal (let [[v 1] [f 1]] (list (ap-map (it v f) [(fn [a b] (+ a b))])))
+                [2]))
 
 (defn test-ap-map-when []
   "NATIVE: testing anaphoric map-when"

tests/native_tests/core.hy

@@ -57,6 +57,34 @@
   (try (do (dec None) (assert False))
        (catch [e [TypeError]] (assert (in "not a number" (str e))))))
 
+(defn test-setv []
+  "NATIVE: testing setv mutation"
+  (setv x 1)
+  (setv y 1)
+  (assert-equal x y)
+  (setv x (setv y  12))
+  (assert-equal x 12)
+  (assert-equal y 12)
+  (setv x (setv y (fn [x] 9)))
+  (assert-equal (x y) 9)
+  (assert-equal (y x) 9)
+  (try (do (setv a.b 1) (assert False))
+       (catch [e [NameError]] (assert (in "name 'a' is not defined" (str e)))))
+  (try (do (setv b.a (fn [x] x)) (assert False))
+       (catch [e [NameError]] (assert (in "name 'b' is not defined" (str e)))))
+  (import itertools)
+  (setv foopermutations (fn [x] (itertools.permutations x)))
+  (setv p (set [(, 1 3 2) (, 3 2 1) (, 2 1 3) (, 3 1 2) (, 1 2 3) (, 2 3 1)]))
+  (assert-equal (set (itertools.permutations [1 2 3])) p)
+  (assert-equal (set (foopermutations [3 1 2])) p)
+  (setv permutations- itertools.permutations)
+  (setv itertools.permutations (fn [x] 9))
+  (assert-equal (itertools.permutations p) 9)
+  (assert-equal (foopermutations foopermutations) 9)
+  (setv itertools.permutations permutations-)
+  (assert-equal (set (itertools.permutations [2 1 3])) p)
+  (assert-equal (set (foopermutations [2 3 1])) p))
+
 (defn test-distinct []
   "NATIVE: testing the distinct function"
   (setv res (list (distinct [ 1 2 3 4 3 5 2 ])))
@@ -482,6 +510,16 @@
   (setv res (zipwith operator.sub [3 7 9] [1 2 4]))
   (assert-equal (list res) [2 5 5]))
 
+(defn test-doto []
+  "NATIVE: testing doto macro"
+  (setv collection [])
+  (doto collection (.append 1) (.append 2) (.append 3))
+  (assert-equal collection [1 2 3])
+  (setv res (doto (set) (.add 2) (.add 1)))
+  (assert-equal res (set [1 2]))
+  (setv res (doto [] (.append 1) (.append 2) .reverse))
+  (assert-equal res [2 1]))
+
 (defn test-is-keyword []
   "NATIVE: testing the keyword? function"
   (assert (keyword? ':bar))

tests/native_tests/language.hy

@@ -29,7 +29,7 @@
 
 
 (defn test-for-loop []
-  "NATIVE: test for loops?"
+  "NATIVE: test for loops"
   (setv count 0)
   (for [x [1 2 3 4 5]]
     (setv count (+ count x)))
@@ -38,7 +38,11 @@
   (for [x [1 2 3 4 5]
         y [1 2 3 4 5]]
     (setv count (+ count x y)))
-  (assert (= count 150)))
+  (assert (= count 150))
+  (assert (= (list ((fn [] (for [x [[1] [2 3]] y x] (yield y)))))
+             (list-comp y [x [[1] [2 3]] y x])))
+  (assert (= (list ((fn [] (for [x [[1] [2 3]] y x z (range 5)] (yield z)))))
+             (list-comp z [x [[1] [2 3]] y x z (range 5)]))))
 
 
 (defn test-nasty-for-nesting []
@@ -942,22 +946,10 @@
 
 (defn test-disassemble []
   "NATIVE: Test the disassemble function"
-  (import sys)
-  (if-python2
-   (import [io [BytesIO :as StringIO]])
-   (import [io [StringIO]]))
-  (setv prev-stdout sys.stdout)
-  (setv sys.stdout (StringIO))
-  (disassemble '(do (leaky) (leaky) (macros)))
-  (setv stdout (.getvalue sys.stdout))
-  (setv sys.stdout prev-stdout)
-  (assert (in "leaky" stdout))
-  (assert (in "macros" stdout))
-  (setv sys.stdout (StringIO))
-  (disassemble '(do (leaky) (leaky) (macros)) true)
-  (setv stdout (.getvalue sys.stdout))
-  (setv sys.stdout prev-stdout)
-  (assert (= stdout "leaky()\nleaky()\nmacros()\n")))
+  (assert (= (disassemble '(do (leaky) (leaky) (macros)))
+             "Module(\n    body=[\n        Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),\n        Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),\n        Expr(value=Call(func=Name(id='macros'), args=[], keywords=[], starargs=None, kwargs=None))])"))
+  (assert (= (disassemble '(do (leaky) (leaky) (macros)) true)
+             "leaky()\nleaky()\nmacros()")))
 
 
 (defn test-attribute-access []