From 1c59c3b98139d3777308aa9fd18fdf6a0aad288b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C4=93ctia=20Landau?= Date: Tue, 18 Nov 2025 19:33:11 +0200 Subject: [PATCH] improve :arglists generation, add relevant tests, update README --- README.md | 26 ++++++++++++-------------- src/defun/core.cljc | 24 ++++++++++++++++++++++-- test/defun/core_test.clj | 27 ++++++++++++++++++--------- 3 files changed, 52 insertions(+), 25 deletions(-) diff --git a/README.md b/README.md index 96f7f3a..12fb71c 100644 --- a/README.md +++ b/README.md @@ -154,23 +154,21 @@ Of course, you can use `defun-` to define a function that is private just as `de ### More Patterns -In fact ,the above `say-hi` function will be expanded to be: +In fact, the above `accum` function can be thought of as expanding to be approximately: ``` clj (defn - say-hi - {:arglists '([& args])} - [& args#] - (clojure.core.match/match - [(vec args#)] - [[:dennis]] - (do "Hi,good morning, dennis.") - [[:catty]] - (do "Hi, catty, what time is it?") - [[:green]] - (do "Hi,green, what a good day!") - [[other]] - (do (str "Say hi to " other)))) + accum + {:arglists '([n] [n ret])} + ([-n] (accum n defun.core/placeholder)) + ([-n -ret] + (clojure.core.match/match [[-n -ret]] + [n defun.core/placeholder] + (do (recur n 0)) + [0 ret] + (do ret) + [n ret] + (do (recur (dec n) (+ n ret)))))) ``` The argument vector is in fact a pattern in core.match, so we can use all patterns that supported by [core.match](https://github.com/clojure/core.match/wiki/Basic-usage). diff --git a/src/defun/core.cljc b/src/defun/core.cljc index be2f89d..3efaf48 100644 --- a/src/defun/core.cljc +++ b/src/defun/core.cljc @@ -152,6 +152,26 @@ (map #(cons `fun %) fnspecs))) ~@body))) +(defn- unify-arity-sigs [[k sigs]] + (letfn + [(fold-sig [sigs sig] + (->> sig + (map #(cond-> % (seq? %) first)) + (conj sigs))) + (unify-sig-part [& parts] + (let [parts (->> parts (map #(cond-> % (not (symbol? %)) ((fn [_] '_)))))] + (or (some #(when (not= '_ %) %) parts) (first parts))))] + (->> sigs + (reduce fold-sig []) + (apply mapv unify-sig-part)))) + +(defn- sigs [body] + (->> (@#'clojure.core/sigs body) + vec + (group-by count) + sort + (map unify-arity-sigs))) + #?(:clj (defmacro defun "Define a function just like clojure.core/defn, but using core.match to @@ -161,8 +181,8 @@ body (if (vector? (first body)) (list body) body) - name (vary-meta name assoc :arglists (list 'quote (@#'clojure.core/sigs body)))] - `(def ~name (fun ~@body))))) + name (vary-meta name assoc :arglists (list 'quote (sigs body)))] + `(def ~name (fun ~name ~@body))))) #?(:clj (defmacro defun- diff --git a/test/defun/core_test.clj b/test/defun/core_test.clj index 53ddfcf..fbb7d31 100644 --- a/test/defun/core_test.clj +++ b/test/defun/core_test.clj @@ -10,7 +10,8 @@ (* x x)) (is (= 4 (square 2))) (is (= 9 (square 3))) - (is (thrown? IllegalArgumentException (square 3 4))))) + (is (thrown? IllegalArgumentException (square 3 4))) + (is (= '([x]) (-> #'square meta :arglists))))) (deftest test-say-hi (testing "say-hi" @@ -23,7 +24,8 @@ (is (= "Hi,good morning, dennis." (say-hi :dennis))) (is (= "Hi, catty, what time is it?" (say-hi :catty))) (is (= "Hi,green, what a good day!" (say-hi :green))) - (is (= "Say hi to someone" (say-hi "someone"))))) + (is (= "Say hi to someone" (say-hi "someone"))) + (is (= '([other]) (-> #'say-hi meta :arglists))))) (deftest test-recursive-function (testing "accum" @@ -32,13 +34,15 @@ ([n ret] (recur (dec n) (+ n ret))) ([n] (recur n 0))) (is (= 6 (accum 3))) - (is (= 5050 (accum 100)))) + (is (= 5050 (accum 100))) + (is (= '([n] [n ret]) (-> #'accum meta :arglists)))) (testing "fib" (defun fib ([0] 0) ([1] 1) ([n] (+ (fib (- n 1)) (fib (- n 2))))) - (is (= 55 (fib 10))))) + (is (= 55 (fib 10))) + (is (= '([n]) (-> #'fib meta :arglists))))) (deftest test-guards (testing "funny" @@ -46,14 +50,16 @@ ([(N :guard #(= 42 %))] true) ([_] false)) (is (funny 42)) - (is (not (funny 43)))) + (is (not (funny 43))) + (is (= '([N]) (-> #'funny meta :arglists)))) (testing "valid-geopoint?" (defun valid-geopoint? ([(_ :guard #(and (> % -180) (< % 180))) (_ :guard #(and (> % -90) (< % 90)))] true) ([_ _] false)) (is (valid-geopoint? 30 30)) - (is (not (valid-geopoint? -181 30))))) + (is (not (valid-geopoint? -181 30))) + (is (= '([_ _]) (-> #'valid-geopoint? meta :arglists))))) (deftest test-match-literals (testing "test1" @@ -63,7 +69,8 @@ ([false true] 3) ([false false] 4)) (is (= 2 (test1 true true))) - (is (= 4 (test1 false false))))) + (is (= 4 (test1 false false))) + (is (= '([_ _]) (-> #'test1 meta :arglists))))) (deftest test-match-vector (testing "test3" @@ -73,13 +80,15 @@ ([[1 2 3]] :a2)) (is (= :a2 (test3 [1 2 3]))) (is (= :a0 (test3 [3 3 2]))) - (is (= :a1 (test3 [1 1 3])))) + (is (= :a1 (test3 [1 1 3]))) + (is (= '([_]) (-> #'test3 meta :arglists)))) (testing "test2" (defun test2 ([([1] :seq)] :a0) ([([1 2] :seq)] :a1) ([([1 2 nil nil nil] :seq)] :a2)) - (is (= :a2 (test2 [1 2 nil nil nil]))))) + (is (= :a2 (test2 [1 2 nil nil nil]))) + (is (= '([_]) (-> #'test2 meta :arglists))))) (deftest test-private-macro (testing "private macro"