Merge pull request #78 from jolt-lang/jolt-6xn-arity

core: enforce fn arity in both modes (jolt-6xn); canonical seq-to-map-for-destructuring

docs/rfc/0003-transients.md

@@ -22,6 +22,11 @@ A transient is a tagged Janet table wrapping a *native* mutable host value
   key for the rebuilt persistent map.
 - transient set — `:kind :set :tbl TABLE` mapping `canon-key(x)` → `x`.
 
+`transient` accepts pvecs, mutable-build arrays, tuples (reader vectors and
+map entries — added in the seed-shrink rounds so `(into [] (first {:a 1}))`
+works through the vector fast path), sets, phms, and untagged struct maps.
+Sorted collections are rejected, as on the JVM (not editable).
+
 The bang ops (`conj!`, `assoc!`, `dissoc!`, `disj!`, `pop!`) mutate that host
 value in place and return the transient — O(1) per op (amortized for array
 push). `persistent!` rebuilds a persistent value from the host value and

jolt-core/clojure/core/20-coll.clj

@@ -528,15 +528,21 @@
           (fn* [] (coll->cells (cons (first s) (step (rest s) (first s))))))
         ()))))
 
-;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs:
-;; builds a map from consecutive pairs, dropping a trailing unpaired element.
+;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs —
+;; canonical Clojure 1.11 shape (core.clj seq-to-map-for-destructuring):
+;; even pairs build a map (later keys win, as createAsIfByAssoc), a SINGLE
+;; element is returned as-is (the trailing-map calling convention), and an
+;; unpaired key past pairs throws. The old jolt version silently dropped the
+;; trailing element, losing (f {:b 2}) kwargs calls.
 (defn seq-to-map-for-destructuring [s]
-  (if (sequential? s)
+  (if (next s)
     (loop [m {} xs (seq s)]
-      (if (and xs (next xs))
-        (recur (assoc m (first xs) (second xs)) (next (next xs)))
+      (if xs
+        (if (next xs)
+          (recur (assoc m (first xs) (second xs)) (nnext xs))
+          (throw (str "No value supplied for key: " (first xs))))
         m))
-    s))
+    (if (seq s) (first s) {})))
 
 ;; Phase 4 (jolt-1j0): host-coupled fns that are pure logic over existing core
 ;; primitives, so they need no new jolt.host surface.

src/jolt/backend.janet

@@ -183,10 +183,18 @@
     (and (not multi) (not ((first arities) :rest)))
     (emit-arity-fn ctx (first arities))
     # Single variadic arity: a thin wrapper collects the call's args so the rest
-    # seq can be built, then hands off to the arity fn.
+    # seq can be built, then hands off to the arity fn. Fewer args than the
+    # fixed params is an arity error (jolt-6xn) — without the guard the fixed
+    # binds fell off the end of the args tuple with a raw index error.
     (not multi)
-    (let [jargs (gsym)]
-      ['fn ['& jargs] (emit-arity-invoke ctx (first arities) jargs)])
+    (let [jargs (gsym)
+          ar (first arities)
+          nfixed (length (vview (ar :params)))]
+      ['fn ['& jargs]
+       ['if ['< ['length jargs] nfixed]
+        ['error ['string "Wrong number of args (" ['length jargs] ") passed to: "
+                 (or (node :name) "fn")]]
+        (emit-arity-invoke ctx ar jargs)]])
     # Multi-arity: dispatch on arg count. Fixed arities match exactly; the (one)
     # variadic arity matches >= its fixed count.
     (let [jargs (gsym)
@@ -196,7 +204,8 @@
         (def nfixed (length (vview (ar :params))))
         (array/push cf (if (ar :rest) [>= nsym nfixed] [= nsym nfixed]))
         (array/push cf (emit-arity-invoke ctx ar jargs)))
-      (array/push cf ['error "wrong number of args passed to fn"])
+      (array/push cf ['error ['string "Wrong number of args (" nsym ") passed to: "
+                              (or (node :name) "fn")]])
       ['fn ['& jargs]
        ['do ['def nsym ['length jargs]] (tuple/slice cf)]])))
 

src/jolt/evaluator.janet

@@ -1730,7 +1730,8 @@
                    (cond
                      f (apply f fn-args)
                      (and variadic-fn (>= n variadic-min)) (apply variadic-fn fn-args)
-                     (error (string "Wrong number of args (" n ") passed to fn"))))))
+                     (error (string "Wrong number of args (" n ") passed to: "
+                                    (or fn-name "fn")))))))
                self)
              # Single-arity: (fn* [args] body...)
              (let [args-form (in form 1)
@@ -1757,7 +1758,16 @@
                    (set result (eval-form ctx fn-bindings body-form)))
                  (ctx-set-current-ns ctx saved-ns)
                  result))
+               (def n-fixed (length fixed-pats))
                (set self (fn [& fn-args]
+                 # ArityException semantics (jolt-6xn): a fixed arity takes
+                 # exactly its params, a variadic one at least its fixed params.
+                 # The compiled path enforces this natively (janet fn arity);
+                 # this keeps the interpreter oracle in agreement.
+                 (def n (length fn-args))
+                 (when (if rest-pat (< n n-fixed) (not= n n-fixed))
+                   (error (string "Wrong number of args (" n ") passed to: "
+                                  (or fn-name "fn"))))
                  (var fn-bindings @{})
                  (table/setproto fn-bindings bindings)
                  (var i 0)

test/spec/functions-spec.janet

@@ -194,3 +194,24 @@
   ["one extra"          "'(2)"   "((fn [a & r] r) 1 2)"]
   ["rest destructure with no args" ":nil"
    "((fn [& [a]] (if a :truthy :nil)))"])
+
+# Arity enforcement (jolt-6xn): fixed arities throw on any mismatch, variadic
+# arities on fewer than the fixed params — Clojure's ArityException, in both
+# the interpreter and the compiled path.
+(defspec "functions / arity enforcement"
+  ["fixed extra args"      :throws "((fn [x] x) 1 2)"]
+  ["fixed missing args"    :throws "((fn [x y] x) 1)"]
+  ["fixed zero of one"     :throws "((fn [x] x))"]
+  ["named defn extra"      :throws "(do (defn af1 [x] x) (af1 1 2))"]
+  ["overlay fn extra"      :throws "(identity 1 2)"]
+  ["through apply"         :throws "(apply (fn [x] x) [1 2])"]
+  ["through update"        :throws "(update {:k 1} :k identity 1 2 3 4)"]
+  ["variadic below min"    :throws "((fn [x & r] x))"]
+  ["variadic at min"       "nil"   "((fn [x & r] r) 1)"]
+  ["variadic above min"    "(quote (2 3))" "((fn [x & r] r) 1 2 3)"]
+  ["multi-arity no match"  :throws "((fn ([x] x) ([x y] y)) 1 2 3)"]
+  ["multi-arity variadic below min" :throws "((fn ([x] x) ([x y & r] r)))"]
+  ["destructured param counts as one" "3" "((fn [[a b] c] c) [1 2] 3)"]
+  ["destructured extra throws" :throws "((fn [[a b]] a) [1 2] [3 4])"]
+  ["hof exact arity ok"    "[2 4]" "(mapv (fn [x] (* 2 x)) [1 2])"]
+  ["zero-arity fn ok"      "7"     "((fn [] 7))"])

test/spec/untested-vars-spec.janet

@@ -157,7 +157,10 @@
   ["special-symbol? if" "true" "(special-symbol? (quote if))"]
   ["special-symbol? fn name" "false" "(special-symbol? (quote foo))"]
   ["destructure expands" "true" "(pos? (count (destructure (quote [[a b] x]))))"]
-  ["seq-to-map-for-destructuring" "{:a 1}" "(seq-to-map-for-destructuring (quote (:a 1)) nil)"]
+  ["seq-to-map-for-destructuring" "{:a 1}" "(seq-to-map-for-destructuring (quote (:a 1)))"]
+  ["s2m trailing map passes through" "{:b 2}" "(seq-to-map-for-destructuring (list {:b 2}))"]
+  ["s2m unpaired key throws" :throws "(seq-to-map-for-destructuring (quote (:a 1 :b)))"]
+  ["s2m kwargs trailing map call" "2" "((fn [& {:keys [b]}] b) {:b 2})"]
   ["*clojure-version* major" "1" "(:major *clojure-version*)"]
   ["*ns* user" "\"user\"" "(str *ns*)"]
   ["*1 nil outside repl" "nil" "*1"]