Disassociate fn arity choice from order of defined arities inline wit…

…h clojure.
babashka · Feb 16, 2021 · 4b2861a · 4b2861a
1 parent 7425611
commit 4b2861a
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 9 deletions.
diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc
@@ -221,13 +221,22 @@
           {:sci.impl/fixed-arity fixed-arity}))
       f)))
 
-(defn lookup-by-arity [arities arity]
-  (some (fn [f]
-          (let [{:sci.impl/keys [fixed-arity min-var-args-arity]} (meta f)]
-            (when (or (= arity fixed-arity )
-                      (and min-var-args-arity
-                           (>= arity min-var-args-arity)))
-              f))) arities))
+(defn lookup-by-arity [fixed-arities min-var-args-arity variadic-arity
+                       arity]
+  (or (get fixed-arities arity)
+      (when (and min-var-args-arity
+                 (>= arity min-var-args-arity))
+        variadic-arity)))
+
+(defn- fixed-arities [arities]
+  (->> arities
+       (map (juxt (comp :sci.impl/fixed-arity meta) identity))
+       (into {})))
+
+(defn- variadic-arity [arities]
+  (->> arities
+       (filter (comp :sci.impl/min-var-args-arity meta))
+       first))
 
 (defn eval-fn [ctx interpret {:sci.impl/keys [fn-bodies fn-name
                                               var] :as f}]
@@ -242,10 +251,14 @@
         single-arity? (= 1 (count fn-bodies))
         f (if single-arity?
             (fun ctx interpret (first fn-bodies) fn-name macro? false)
-            (let [arities (map #(fun ctx interpret % fn-name macro? true) fn-bodies)]
+            (let [arities (map #(fun ctx interpret % fn-name macro? true) fn-bodies)
+                  fixed-arities (fixed-arities arities)
+                  variadic-arity (variadic-arity arities)
+                  min-var-args-arity (:sci.impl/min-var-args-arity (meta variadic-arity))]
               (fn [& args]
                 (let [arg-count (count args)]
-                  (if-let [f (lookup-by-arity arities arg-count)]
+                  (if-let [f (lookup-by-arity fixed-arities min-var-args-arity variadic-arity
+                                              arg-count)]
                     (apply f args)
                     (throw (new #?(:clj Exception
                                    :cljs js/Error)

diff --git a/test/sci/core_test.cljc b/test/sci/core_test.cljc
@@ -189,6 +189,9 @@
   (is (= 2 (eval* '((fn foo [x & [y]] y) 1 2 3))))
   (is (= 1 (eval* '((fn ([x] x) ([x y] y)) 1))))
   (is (= 2 (eval* '((fn ([x] x) ([x y] y)) 1 2))))
+  (is (= "otherwise" (eval* '((fn ([x & xs] "variadic") ([x] "otherwise")) 1))))
+  (is (= "otherwise" (eval* '((fn ([x] "otherwise") ([x & xs] "variadic")) 1))))
+  (is (= "variadic" (eval* '((fn ([x] "otherwise") ([x & xs] "variadic")) 1 2))))
   (is (= '(2 3 4) (eval* '(apply (fn [x & xs] xs) 1 2 [3 4]))))
   (is (thrown-with-msg? #?(:clj Exception :cljs js/Error)
                         #"Can't have fixed arity function with more params than variadic function"