Use defmacro-kwargs from Hyrule.

Author: Kodiologist

simalq/macros.hy

@@ -1,5 +1,5 @@
 (require
-  hyrule [unless])
+  hyrule [unless defmacro-kwargs])
 
 
 (defmacro defmeth [#* args]
@@ -46,108 +46,6 @@
     ~@dynadoc))
 
 
-(defmacro defmacro-kwargs [mname params #* body]
-  (setv [ps p-rest p-kwargs] (parse-params params))
-  (setv g (hy.gensym))
-  `(defmacro ~mname [#* ~g]
-    (setv ~g (hy.I.simalq/macros.match-params ~g '~params))
-    ~@(gfor
-      name [#* (.keys ps) #* (if p-rest [p-rest] []) #* (if p-kwargs [p-kwargs] [])]
-      `(setv ~(hy.models.Symbol name) (get ~g ~name)))
-    ~@body))
-
-(defn match-params [args params]
-  "Match a interable of arguments against a parameter list in the
-  style of a `defn` lambda list. The parameter-list syntax here is
-  somewhat restricted: annotations are forbiddden, `/` and `*` aren't
-  recognized, and nothing is allowed after `#* args` other than `#**
-  kwargs`.
-
-  Return a dictionary of parameters and their values."
-
-  (setv [ps p-rest p-kwargs] (parse-params params))
-
-  ; Loop over `args`.
-  (setv  args (list args)  collected-rest []  collected-kwargs {}  i-pos 0)
-  (while args
-    (setv x (.pop args 0))
-    (cond
-
-      (and
-          (isinstance x hy.models.Expression)
-          x
-          (isinstance (get x 0) hy.models.Symbol)
-          (in (hy.mangle (get x 0)) ["unpack_iterable" "unpack_mapping"]))
-        ; Unpacking would require evaluating the elements of `args`, which we
-        ; want to avoid.
-        (raise (TypeError "unpacking is not allowed in `args`"))
-
-      (isinstance x hy.models.Keyword) (do
-        ; A keyword argument
-        (setv x (hy.mangle x.name))
-        (when (or
-            (in x collected-kwargs)
-            (and (in x ps) (is-not (get ps x "value") None)))
-          (raise (TypeError (+ "keyword argument repeated: " x))))
-        (setv v (.pop args 0))
-        (cond
-          (in x ps)
-            (setv (get ps x "value") v)
-          p-kwargs
-            (setv (get collected-kwargs x) v)
-          True
-            (raise (TypeError f"unexpected keyword argument '{x}'"))))
-
-      True (do
-        ; A positional argument
-        (cond
-          (< i-pos (len ps)) (do
-            (setv [k d] (get (list (.items ps)) i-pos))
-            (if (is (get d "value") None)
-              (setv (get d "value") x)
-              (raise (TypeError f"got multiple values for argument '{k}'"))))
-          p-rest
-            (.append collected-rest x)
-          True
-            (raise (TypeError f"takes {(len ps)} positional arguments but more were given")))
-        (+= i-pos 1))))
-
-  ; Return the result.
-  (dict
-    #** (dfor
-      [p d] (.items ps)
-      p (cond
-        (is-not (get d "value") None)
-          (get d "value")
-        (is-not (get d "default") None)
-          (get d "default")
-        True
-          (raise (TypeError f"missing a required positional argument: '{p}'"))))
-    #** (if p-rest {p-rest (tuple collected-rest)} {})
-    #** (if p-kwargs {p-kwargs collected-kwargs} {})))
-
-(eval-and-compile (defn parse-params [params]
-  "A subroutine for `defmacro-kwargs` and `match-params`."
-  (import
-    funcparserlib.parser [maybe many]
-    hy.model-patterns [SYM FORM sym brackets pexpr])
-
-  (setv msym (>> SYM hy.mangle))
-  (defn pvalue [root wanted]
-    (>> (pexpr (+ (sym root) wanted)) (fn [x] (get x 0))))
-  (setv [ps p-rest p-kwargs] (.parse
-    (+
-      (many (| msym (brackets msym FORM)))
-      (maybe (pvalue "unpack-iterable" msym))
-      (maybe (pvalue "unpack-mapping" msym)))
-    params))
-  (setv ps (dfor
-    p ps
-    :setv [k dv] (if (isinstance p hy.models.List) p [p None])
-    k (dict :value None :default dv)))
-  [ps p-rest p-kwargs]))
-
-
 (defmacro-kwargs defdataclass [class-name superclasses #* args #** kwargs]
   #[[Syntactic sugar for common uses of data classes. Code like
 

simalq/tile/__init__.hy

@@ -3,8 +3,8 @@
 ;; --------------------------------------------------------------
 
 (require
-  hyrule [unless]
-  simalq.macros [field-defaults defmeth defmacro-kwargs])
+  hyrule [unless defmacro-kwargs]
+  simalq.macros [field-defaults defmeth])
 (import
   copy [deepcopy]
   re

simalq/tile/monster.hy

@@ -3,8 +3,8 @@
 ;; --------------------------------------------------------------
 
 (require
-  hyrule [unless do-n list-n]
-  simalq.macros [field-defaults pop-integer-part defmeth defmacro-kwargs]
+  hyrule [unless do-n list-n defmacro-kwargs]
+  simalq.macros [field-defaults pop-integer-part defmeth]
   simalq.tile [deftile])
 (import
   re

tests/test_util.hy

@@ -2,69 +2,13 @@
 
 
 (require
-  simalq.macros [pop-integer-part defmacro-kwargs])
+  simalq.macros [pop-integer-part])
 (import
   fractions [Fraction :as f/]
-  simalq.macros [match-params]
   simalq.util [mixed-number]
   pytest)
 
 
-
-(defn test-match-params []
-
-  (defn f [args]
-    (match-params args '[a b [c "default-c"] #* rest #** kw]))
-  (assert (=
-    (f [1 2])
-    (dict :a 1 :b 2 :c '"default-c" :rest #() :kw {})))
-  (assert (=
-    (f '[1 2])
-    (dict :a '1 :b '2 :c '"default-c" :rest #() :kw {})))
-  (assert (=
-    (f '[1 2 3 4 (+ 4 1)])
-    (dict :a '1 :b '2 :c '3 :rest #('4 '(+ 4 1)) :kw {})))
-  (assert (=
-    (f '[:a 1 :b 2 :c 3 :extra 4])
-    (dict :a '1 :b '2 :c '3 :rest #() :kw {"extra" '4})))
-  (assert (=
-    (f '[:b 2 1])
-    (dict :a '1 :b '2 :c '"default-c" :rest #() :kw {})))
-  (assert (=
-    (f '[:b 2 :extra "foo" :a 1])
-    (dict :a '1 :b '2 :c '"default-c" :rest #() :kw {"extra" '"foo"})))
-  (assert (=
-    (f '[1 2 3 4 5 6 7 :x 10 :y 11])
-    (dict :a '1 :b '2 :c '3 :rest #('4 '5 '6 '7) :kw {"x" '10 "y" '11})))
-
-  ; Mangling
-  (assert (=
-    (match-params
-      '[1 :⬢ ☤ :⚘ 3 :☘ 4]
-      '[a-b ⬢ #** ✈])
-    (dict
-      :a_b '1
-      :hyx_Xblack_hexagonX '☤
-      :hyx_XairplaneX {"hyx_XflowerX" '3 "hyx_XshamrockX" '4})))
-
-  ; Unpacking
-  (with [(pytest.raises TypeError :match "^unpacking is not allowed in `args`$")]
-    (f '[1 2 3 #* [1 2]]))
-  (with [(pytest.raises TypeError :match "^unpacking is not allowed in `args`$")]
-    (f '[1 2 3 #** {"qq" 1 "xx" 2}])))
-
-
-(defn test-defmacro-kwargs []
-   (defmacro-kwargs m [a b [c "default-c"] #* rest #** kw]
-     [a b c rest kw])
-   (assert (=
-     (m 1 2)
-     [1 2 "default-c" #() {}]))
-   (assert (=
-     (m :b "bb" :a "aa" :foo "hello")
-     ["aa" "bb" "default-c" #() {"foo" "hello"}])))
-
-
 (defn test-pop-integer-part []
   (setv x (f/ 1 3))
   (assert (= (pop-integer-part x) 0))