Make assoc into a function instead of a special form

NEWS

@@ -12,6 +12,7 @@ Changes from 0.13.0
      as necessary, so you can write ``(eval `(+ 1 ~n))`` instead of
      ``(eval `(+ 1 ~(HyInteger n)))``
    * Literal `Inf`s and `NaN`s must now be capitalized like that
+   * `assoc` is now a function instead of a special form
    * `get` is available as a function
 
    [ Bug Fixes ]

docs/language/api.rst

@@ -281,39 +281,6 @@ the assert, and is the string that will be raised with the
   ; AssertionError: one should equal two
 
 
-assoc
------
-
-``assoc`` is used to associate a key with a value in a dictionary or to set an
-index of a list to a value. It takes at least three parameters: the *data
-structure* to be modified, a *key* or *index*, and a *value*. If more than
-three parameters are used, it will associate in pairs.
-
-Examples of usage:
-
-.. code-block:: clj
-
-  =>(do
-  ... (setv collection {})
-  ... (assoc collection "Dog" "Bark")
-  ... (print collection))
-  {u'Dog': u'Bark'}
-
-  =>(do
-  ... (setv collection {})
-  ... (assoc collection "Dog" "Bark" "Cat" "Meow")
-  ... (print collection))
-  {u'Cat': u'Meow', u'Dog': u'Bark'}
-
-  =>(do
-  ... (setv collection [1 2 3 4])
-  ... (assoc collection 2 None)
-  ... (print collection))
-  [1, 2, None, 4]
-
-.. note:: ``assoc`` modifies the datastructure in place and returns ``None``.
-
-
 break
 -----
 

docs/language/core.rst

@@ -6,6 +6,41 @@ Hy Core
 Core Functions
 ==============
 
+.. _assoc-fn:
+
+assoc
+-----
+
+``assoc`` is used to associate a key with a value in a dictionary or to set an
+index of a list to a value. It takes at least three parameters: the *data
+structure* to be modified, a *key* or *index*, and a *value*. If more than
+three parameters are used, it will associate in pairs.
+
+Examples of usage:
+
+.. code-block:: clj
+
+  =>(do
+  ... (setv collection {})
+  ... (assoc collection "Dog" "Bark")
+  ... (print collection))
+  {u'Dog': u'Bark'}
+
+  =>(do
+  ... (setv collection {})
+  ... (assoc collection "Dog" "Bark" "Cat" "Meow")
+  ... (print collection))
+  {u'Cat': u'Meow', u'Dog': u'Bark'}
+
+  =>(do
+  ... (setv collection [1 2 3 4])
+  ... (assoc collection 2 None)
+  ... (print collection))
+  [1, 2, None, 4]
+
+.. note:: ``assoc`` modifies the datastructure in place and returns ``None``.
+
+
 .. _butlast-fn:
 
 butlast

hy/compiler.py

@@ -1386,30 +1386,6 @@ def compile_cut_expression(self, expr):
                             step=step.expr),
             ctx=ast.Load())
 
-    @builds("assoc")
-    @checkargs(min=3, even=False)
-    def compile_assoc_expression(self, expr):
-        expr.pop(0)  # assoc
-        # (assoc foo bar baz)  => foo[bar] = baz
-        target = self.compile(expr.pop(0))
-        ret = target
-        i = iter(expr)
-        for (key, val) in ((self.compile(x), self.compile(y))
-                           for (x, y) in zip(i, i)):
-
-            ret += key + val + ast.Assign(
-                lineno=expr.start_line,
-                col_offset=expr.start_column,
-                targets=[
-                    ast.Subscript(
-                        lineno=expr.start_line,
-                        col_offset=expr.start_column,
-                        value=target.force_expr,
-                        slice=ast.Index(value=key.force_expr),
-                        ctx=ast.Store())],
-                value=val.force_expr)
-        return ret
-
     @builds("with_decorator")
     @checkargs(min=1)
     def compile_decorate_expression(self, expr):

hy/core/language.hy

@@ -21,6 +21,12 @@
 (import [hy.compiler [HyASTCompiler spoof-positions]])
 (import [hy.importer [hy-eval :as eval]])
 
+(defn assoc [coll &rest kvs]
+  (if (odd? (len kvs))
+    (raise (TypeError "`assoc` takes an odd number of arguments")))
+  (for* [[k v] (partition kvs)]
+    (setv (get coll k) v)))
+
 (defn butlast [coll]
   "Returns coll except of last element."
   (drop-last 1 coll))
@@ -310,9 +316,7 @@
     (do
       (defn merge-entry [m e]
         (setv k (get e 0) v (get e 1))
-        (if (in k m)
-          (assoc m k (f (get m k) v))
-          (assoc m k v))
+        (assoc m k (if (in k m) (f (get m k) v) v))
         m)
       (defn merge2 [m1 m2]
         (reduce merge-entry (.items m2) (or m1 {})))
@@ -459,7 +463,7 @@
     (or a b)))
 
 (def *exports*
-  '[*map accumulate butlast calling-module-name chain coll? combinations
+  '[*map accumulate assoc butlast calling-module-name chain coll? combinations
     comp complement compress cons cons? constantly count cycle dec distinct
     disassemble drop drop-last drop-while empty? eval even? every? first filter
     flatten float? fraction gensym group-by identity inc input instance?

tests/compilers/test_ast.py

@@ -301,19 +301,6 @@ def test_ast_good_drop():
     can_compile("(drop 1 [2 3])")
 
 
-def test_ast_good_assoc():
-    "Make sure AST can compile valid assoc"
-    can_compile("(assoc x y z)")
-
-
-def test_ast_bad_assoc():
-    "Make sure AST can't compile invalid assoc"
-    cant_compile("(assoc)")
-    cant_compile("(assoc 1)")
-    cant_compile("(assoc 1 2)")
-    cant_compile("(assoc 1 2 3 4)")
-
-
 def test_ast_bad_with():
     "Make sure AST can't compile invalid with"
     cant_compile("(with*)")

tests/native_tests/language.hy

@@ -628,12 +628,34 @@
   (assoc vals "two" "three")
   (assert (= (get vals "two") "three")))
 
+
 (defn test-multiassoc []
   "NATIVE: test assoc multiple values"
   (setv vals {"one" "two"})
   (assoc vals "two" "three" "four" "five")
   (assert (and (= (get vals "two") "three") (= (get vals "four") "five") (= (get vals "one") "two"))))
 
+
+(defn test-assoc-slice []
+  (import string)
+  (setv l (list string.ascii-lowercase))
+  (assoc l (slice 2 11 3) "XXX")
+  (assert (= (.join "" l) "abXdeXghXjklmnopqrstuvwxyz")))
+
+
+(defn test-assoc-eval-lvalue-once []
+  "`assoc` only evaluates its lvalue once"
+  ; https://github.com/hylang/hy/issues/1068
+  (setv counter [])
+  (setv d {})
+  (defn f []
+    (.append counter 1)
+    d)
+  (assoc (f)  "a" 1  "b" 2  "c" 3)
+  (assert (= d {"a" 1  "b" 2  "c" 3}))
+  (assert (= counter [1])))
+
+
 (defn test-pass []
   "NATIVE: Test pass worksish"
   (if True (do) (do))