Merge pull request #105 from Kodiologist/pun

Add `map-hyseq` and `pun`

NEWS.rst

@@ -3,6 +3,11 @@
 Unreleased
 ======================================================
 
+New Features
+------------------------------
+* New macro `pun`.
+* New macro `map-hyseq`.
+
 Bug Fixes
 ------------------------------
 * `map-model` now calls `as-model` only once (before its own recursion),

docs/index.rst

@@ -104,6 +104,7 @@ API
 .. hy:automacro:: defmacro-kwargs
 .. hy:automacro:: defmacro!
 .. hy:autofunction:: macroexpand-all
+.. hy:autofunction:: map-hyseq
 .. hy:autofunction:: map-model
 .. hy:autofunction:: match-fn-params
 .. hy:automacro:: with-gensyms
@@ -149,6 +150,7 @@ API
 .. hy:autofunction:: parse-args
 .. hy:automacro:: profile/calls
 .. hy:automacro:: profile/cpu
+.. hy:automacro:: pun
 .. hy:autofunction:: sign
 .. hy:automacro:: smacrolet
 .. hy:autofunction:: xor

hyrule/control.hy

@@ -173,7 +173,7 @@
 
 
 (defmacro defmain [args #* body]
-  #[[Define a function to be called when :attr:`__name__` equals ``"__main__"``
+  #[[Define a function to be called when :attr:`module.__name__` equals ``"__main__"``
   (see :mod:`__main__`). ``args`` is the function's lambda list, which will be
   matched against :data:`sys.argv`. Recall that the first element of
   ``sys.argv`` is always the name of the script being invoked, whereas the rest

hyrule/macrotools.hy

@@ -270,21 +270,34 @@
   (_map-model (hy.as-model x) f))
 
 (defn _map-model [x f]
-  (cond
-    (is-not (setx value (f x)) None)
-      (hy.as-model value)
-    (isinstance x hy.models.Sequence)
-      ((type x)
-        (gfor  elem x  (_map-model elem f))
-        #** (cond
-          (isinstance x hy.models.FString)
-            {"brackets" x.brackets}
-          (isinstance x hy.models.FComponent)
-            {"conversion" x.conversion}
-          True
-            {}))
-    True
-      x))
+  (if (is-not (setx value (f x)) None)
+    (hy.as-model value)
+    (map-hyseq x (fn [contents]
+      (gfor  elem contents  (_map-model elem f))))))
+
+(defn map-hyseq [x f]
+
+  "Apply the function ``f`` to the contents of the :ref:`sequential model <hy:hysequence>` ``x`` gathered into a tuple. ``f`` should return an iterable object. This result is then wrapped in the original model type, preserving attributes such as the brackets of an :class:`hy.models.FString`. ::
+
+    (map-hyseq '[:a :b :c] (fn [x]
+      (gfor  e x  (hy.models.Keyword (.upper e.name)))))
+      ; => '[:A :B :C]
+
+  Unlike :hy:func:`map-model`, ``map-hyseq`` isn't inherently recursive.
+
+  If ``x`` isn't a sequential Hy model, it's returned as-is, without calling ``f``."
+
+  (if (isinstance x hy.models.Sequence)
+    ((type x)
+      (f (tuple x))
+      #** (cond
+        (isinstance x hy.models.FString)
+          {"brackets" x.brackets}
+        (isinstance x hy.models.FComponent)
+          {"conversion" x.conversion}
+        True
+          {}))
+    x))
 
 
 (defmacro with-gensyms [args #* body]

hyrule/misc.hy

@@ -4,8 +4,10 @@
 (import
   sys
   importlib.util
+  itertools
   hy.scoping [ScopeLet]
-  hyrule.collections [by2s])
+  hyrule.collections [by2s]
+  hyrule.macrotools [map-hyseq])
 
 
 (defmacro comment [#* body]
@@ -190,6 +192,27 @@
      (print (.getvalue ~g!hy-s))))
 
 
+(defmacro pun [#* body]
+  #[[Evaluate ``body`` with a shorthand for keyword arguments that are set to variables of the same name. Any keyword whose name starts with an exclamation point, such as ``:!foo``, is replaced with a keyword followed by a symbol, such as ``:foo foo``::
+
+    (setv  a 1  b 2  c 3)
+    (pun (dict :!a :!b :!c))
+      ; i.e., (dict :a a :b b :c c)
+      ; => {"a" 1  "b" 2  "c" 3}
+
+  This macro is named after the `NamedFieldPuns <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/record_puns.html>`__ language extension to Haskell.]]
+
+  (map-hyseq `(do ~@body) _pun))
+
+(defn _pun [x]
+  (itertools.chain.from-iterable (gfor
+    e x
+    (if (and (isinstance e hy.models.Keyword) (.startswith e.name "!"))
+      [(hy.models.Keyword (cut e.name 1 None))
+        (hy.models.Symbol (cut e.name 1 None))]
+      [(map-hyseq e _pun)]))))
+
+
 (do-mac (do
   (setv code "
       (cond

tests/test_macrotools.hy

@@ -3,7 +3,7 @@
          :readers [/])
 (import
   pytest
-  hyrule [macroexpand-all map-model match-fn-params])
+  hyrule [macroexpand-all map-hyseq map-model match-fn-params])
 
 
 (defn test-defmacro-kwargs []
@@ -110,6 +110,42 @@
              '(setv blah 1))))
 
 
+(defn test-map-hyseq []
+
+  ; If `x` isn't sequential (or not a model at all), `f` isn't called.
+  (assert (=
+    (map-hyseq
+      3
+      (fn [x] (raise ValueError)))
+    3))
+  (assert (=
+    (map-hyseq
+      [1 2]
+      (fn [x] (raise ValueError)))
+    [1 2]))
+
+  ; `f` can be called when `x` is empty.
+  (assert (=
+    (map-hyseq
+      '[]
+      (fn [x] ['4]))
+    '[4]))
+
+  ; `f` gets the sequence contents as a tuple.
+  (setv saw None)
+  (assert (=
+    (map-hyseq
+      '{1 2  3 4}
+      (fn [x]
+        (nonlocal saw)
+        (setv saw x)
+        (gfor  e x  (hy.models.Integer (+ e 1)))))
+    '{2 3  4 5}))
+  (assert (= saw #('1 '2 '3 '4))))
+  ; Preservation of sequence attributes is tested as part of testing
+  ; `map-model`.
+
+
 (defn test-map-model []
 
   ; When the callback returns `None`, the element is recursed into, or

tests/test_misc.hy

@@ -1,5 +1,5 @@
 (require
-  hyrule [comment of smacrolet])
+  hyrule [comment of pun smacrolet])
 (import
   sys
   pytest
@@ -88,6 +88,22 @@
   (assert (= (xor 0 False) False)))
 
 
+(defn test-pun [] (pun
+  (setv   adam 1  bob 2  chris 3  !bob 100)
+  (assert (=
+    [:!adam :!bob :!chris]
+    [:adam 1 :bob 2 :chris 3]))
+  (assert (=
+    (dict :!adam :!bob :!chris)
+    {"adam" 1  "bob" 2  "chris" 3}))
+  (assert (=
+    (dict :!adam :bob 4 :!chris)
+    {"adam" 1  "bob" 4  "chris" 3}))
+  (assert (=
+    (dict :!adam :!!bob :!chris)
+    {"adam" 1  (hy.mangle "!bob") 100  "chris" 3}))))
+
+
 (defn test-sign []
   (assert (= (sign -9) -1))
   (assert (= (sign -0.1) -1))