diff --git a/simalq/macros.hy b/simalq/macros.hy index 50957ce..df9608b 100644 --- a/simalq/macros.hy +++ b/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 diff --git a/simalq/tile/__init__.hy b/simalq/tile/__init__.hy index 4d4d2fa..d0f6786 100644 --- a/simalq/tile/__init__.hy +++ b/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 diff --git a/simalq/tile/monster.hy b/simalq/tile/monster.hy index 9de31fa..7b1c352 100644 --- a/simalq/tile/monster.hy +++ b/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 diff --git a/tests/test_util.hy b/tests/test_util.hy index d4a0f02..ebb3fdf 100644 --- a/tests/test_util.hy +++ b/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))