Add pun

NEWS.rst

@@ -5,6 +5,7 @@ Unreleased
 
 New Features
 ------------------------------
+* New macro `pun`.
 * New macro `map-hyseq`.
 
 Bug Fixes

docs/index.rst

@@ -150,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/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_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))