simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #59 from jolt-lang/variadic-recur

Browse source 
evaluator: recur into a variadic arity binds the rest seq directly (fixes the hang)
This commit is contained in:
Dmitri Sotnikov 2026-06-10 18:29:08 -04:00 • committed by GitHub
commit 7c2d556dc5
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 84 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

88
src/jolt/evaluator.janet
View file

@ -1407,16 +1407,16 @@
fixed-pats (param-info :fixed) fixed-pats (param-info :fixed)
rest-pat (param-info :rest) rest-pat (param-info :rest)
n-fixed (length fixed-pats) n-fixed (length fixed-pats)
f (fn [& fn-args] # recur-entry: where (recur ...) re-enters THIS arity. For
(var fn-bindings @{}) # a fixed arity it's the dispatcher (exact count re-selects
(table/setproto fn-bindings bindings) # it). For the VARIADIC arity, recur takes n-fixed + 1 args
(var i 0) # with the LAST bound DIRECTLY as the rest seq (Clojure) —
(each pat fixed-pats # re-entering through the varargs collector would wrap it
(destructure-bind ctx fn-bindings pat (fn-args i)) # in a fresh 1-element rest list and the seq never empties
(++ i)) # (the jolt-4df hang).
(when rest-pat recur-entry-box @[nil]
(destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i))) run-clause (fn [fn-bindings]
(put fn-bindings :jolt/loop-fn self) (put fn-bindings :jolt/loop-fn (in recur-entry-box 0))
(when fn-name (bind-put fn-bindings fn-name self)) (when fn-name (bind-put fn-bindings fn-name self))
# Use defining namespace for symbol resolution # Use defining namespace for symbol resolution
(def saved-ns (ctx-current-ns ctx)) (def saved-ns (ctx-current-ns ctx))
@ -1429,10 +1429,33 @@
(each body-form body (each body-form body
(set result (eval-form ctx fn-bindings body-form))) (set result (eval-form ctx fn-bindings body-form)))
(ctx-set-current-ns ctx saved-ns) (ctx-set-current-ns ctx saved-ns)
result)] result)
f (fn [& fn-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each pat fixed-pats
(destructure-bind ctx fn-bindings pat (fn-args i))
(++ i))
(when rest-pat
(destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i)))
(run-clause fn-bindings))]
(if rest-pat (if rest-pat
(do (set variadic-fn f) (set variadic-min n-fixed)) (do
(put arities n-fixed f)))) (put recur-entry-box 0
(fn [& recur-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each pat fixed-pats
(destructure-bind ctx fn-bindings pat (recur-args i))
(++ i))
(destructure-bind ctx fn-bindings rest-pat (get recur-args i))
(run-clause fn-bindings)))
(set variadic-fn f) (set variadic-min n-fixed))
(do
(put recur-entry-box 0 (fn [& recur-args] (apply self recur-args)))
(put arities n-fixed f)))))
(set self (fn [& fn-args] (set self (fn [& fn-args]
(let [n (length fn-args) (let [n (length fn-args)
f (get arities n)] f (get arities n)]
@ -1450,16 +1473,9 @@
rest-pat (param-info :rest) rest-pat (param-info :rest)
defining-ns (ctx-current-ns ctx)] defining-ns (ctx-current-ns ctx)]
(var self nil) (var self nil)
(set self (fn [& fn-args] (var recur-entry nil)
(var fn-bindings @{}) (def run-body (fn [fn-bindings]
(table/setproto fn-bindings bindings) (put fn-bindings :jolt/loop-fn recur-entry)
(var i 0)
(each pat fixed-pats
(destructure-bind ctx fn-bindings pat (fn-args i))
(++ i))
(when rest-pat
(destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i)))
(put fn-bindings :jolt/loop-fn self)
(when fn-name (bind-put fn-bindings fn-name self)) (when fn-name (bind-put fn-bindings fn-name self))
# Use defining namespace for symbol resolution # Use defining namespace for symbol resolution
(def saved-ns (ctx-current-ns ctx)) (def saved-ns (ctx-current-ns ctx))
@ -1473,6 +1489,32 @@
(set result (eval-form ctx fn-bindings body-form))) (set result (eval-form ctx fn-bindings body-form)))
(ctx-set-current-ns ctx saved-ns) (ctx-set-current-ns ctx saved-ns)
result)) result))
(set self (fn [& fn-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each pat fixed-pats
(destructure-bind ctx fn-bindings pat (fn-args i))
(++ i))
(when rest-pat
(destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i)))
(run-body fn-bindings)))
# recur re-enters here: for a variadic fn it takes n-fixed + 1
# args, the LAST bound DIRECTLY as the rest seq (Clojure) — going
# back through the varargs collector wrapped the seq in a fresh
# 1-element rest list, so it never emptied (the jolt-4df hang).
(set recur-entry
(if rest-pat
(fn [& recur-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each pat fixed-pats
(destructure-bind ctx fn-bindings pat (recur-args i))
(++ i))
(destructure-bind ctx fn-bindings rest-pat (get recur-args i))
(run-body fn-bindings))
self))
self))) self)))
"let*" (let [bind-vec (in form 1) "let*" (let [bind-vec (in form 1)
body (tuple/slice form 2)] body (tuple/slice form 2)]

19
test/spec/functions-spec.janet
View file

@ -162,3 +162,22 @@
["char-name space" "\"space\"" "(char-name-string \\space)"] ["char-name space" "\"space\"" "(char-name-string \\space)"]
["char-name newline" "\"newline\"" "(char-name-string \\newline)"] ["char-name newline" "\"newline\"" "(char-name-string \\newline)"]
["char-name none" "nil" "(char-name-string \\a)"]) ["char-name none" "nil" "(char-name-string \\a)"])
# recur into a VARIADIC fn arity binds the LAST recur arg directly as the
# rest seq (Clojure: recur to a variadic head takes n-fixed + 1 args, no
# re-collection). The interpreter used to re-enter through the varargs
# collector, wrapping the seq in a fresh 1-element rest list — xs never
# emptied and the loop hung (jolt-4df).
(defspec "functions / recur into variadic arity"
["counts rest via recur" "3"
"((fn cnt [acc & xs] (if (seq xs) (recur (inc acc) (rest xs)) acc)) 0 :a :b :c)"]
["zero-fixed variadic" "4"
"((fn f [& xs] (if (< (count xs) 4) (recur (cons :x xs)) (count xs))) :a)"]
["rest empties to nil" "(quote (:done))"
"((fn f [& xs] (if xs (recur (next xs)) (list :done))) 1 2)"]
["multi-arity variadic recur" "6"
"((fn ma ([a] a) ([a & xs] (if (seq xs) (recur (+ a (first xs)) (rest xs)) a))) 1 2 3)"]
["recur passes nil rest" ":empty"
"((fn f [acc & xs] (if (seq xs) (recur acc (rest xs)) :empty)) 0 1)"]
["fixed-arity recur untouched" "10"
"((fn f [n acc] (if (pos? n) (recur (dec n) (+ acc 2)) acc)) 5 0)"])