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

destructuring via shared expander; fix sequential let + nth nil-default

Browse source 
core-let now expands destructuring (Clojure's destructure algorithm: nth/nthnext/
get over gensym roots) so both the interpreter and the compiler see only plain
bindings — the compiler compiles destructuring for free, and it's a step toward
moving destructuring out of the kernel. Handles vector (& rest, :as, nested), map
(:keys/:strs/:syms incl. namespaced, :as, :or, explicit pairs).

Two real bugs fixed in passing:
- compiler let*/loop* analyzed all binding inits in the OUTER scope, so a later
  binding couldn't see an earlier one ((let [x 1 y x] y) miscompiled). Now scope
  accumulates across bindings.
- core-nth treated an explicit nil not-found as 'no default' and threw on out of
  bounds; (nth coll i nil) now returns nil (Clojure semantics), via arity.

Baselines held: conformance 218/218 both modes, clojure-test-suite 3913 interp /
3932 compile, destructuring-spec green.
This commit is contained in:
Yogthos 2026-06-06 09:36:36 -04:00
parent b6e41bf499
commit b3a80507cc
2 changed files with 103 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

17
src/jolt/compiler.janet
View file

@ -435,6 +435,9 @@
"fn*" (analyze-fn form bindings ctx)
"let*" (let [bind-vec (in form 1)
body-exprs (tuple/slice form 2)
# Accumulate scope as we go so a later binding's init can
# reference an earlier binding (sequential let scoping).
acc (do (var bb @{}) (loop [[k v] :pairs bindings] (put bb k v)) bb)
binding-pairs (do
(var pairs @[])
(var i 0)
@ -445,16 +448,12 @@
(uncompilable "destructuring let binding"))
name (sym-s :name)
val-form (if (< (+ i 1) n) (in bind-vec (+ i 1)) nil)
val-ast (if val-form (analyze-form val-form bindings ctx) {:op :const :val nil})]
val-ast (if val-form (analyze-form val-form acc ctx) {:op :const :val nil})]
(array/push pairs {:name name :init val-ast})
(put acc name :jolt/local)
(+= i 2))))
pairs)
body-bindings (do
(var bb @{})
(loop [[k v] :pairs bindings] (put bb k v))
(each bp binding-pairs
(put bb (bp :name) :jolt/local))
bb)
body-bindings acc
analyzed-body (map |(analyze-form $ body-bindings ctx) body-exprs)
n-body (length analyzed-body)]
{:op :let
@ -466,6 +465,7 @@
(first analyzed-body))})
"loop*" (let [bind-vec (in form 1)
loop-name (make-loop-name)
acc (do (var bb @{}) (loop [[k v] :pairs bindings] (put bb k v)) bb)
binding-pairs (do
(var pairs @[])
(var i 0)
@ -476,8 +476,9 @@
(uncompilable "destructuring loop binding"))
name (sym-s :name)
val-form (if (< (+ i 1) n) (in bind-vec (+ i 1)) nil)
val-ast (if val-form (analyze-form val-form bindings ctx) {:op :const :val nil})]
val-ast (if val-form (analyze-form val-form acc ctx) {:op :const :val nil})]
(array/push pairs {:name name :init val-ast})
(put acc name :jolt/local)
(+= i 2))))
pairs)
param-names (map |($ :name) binding-pairs)

109
src/jolt/core.janet
View file

@ -1088,19 +1088,23 @@
result))))
(defn core-nth
"Return the nth element of a sequential collection."
[coll idx &opt default]
"Return the nth element of a sequential collection. With a not-found arg, return
it when idx is out of bounds (even if it's nil); without one, throw — matching
Clojure, where (nth coll i nil) returns nil rather than throwing."
[coll idx & rest]
(def has-default (> (length rest) 0))
(def default (if has-default (in rest 0) nil))
(defn oob [n] (if has-default default (error (string "Index " idx " out of bounds, length: " n))))
(if (nil? coll) default # (nth nil i) -> nil / default, never throws
(if (core-transient? coll)
(let [a (coll :arr)] (if (and (>= idx 0) (< idx (length a))) (in a idx) default))
(let [a (coll :arr)] (if (and (>= idx 0) (< idx (length a))) (in a idx) (oob (length a))))
(if (plist? coll)
(let [a (pl->array coll)]
(if (and (>= idx 0) (< idx (length a))) (in a idx)
(if (nil? default) (error (string "Index " idx " out of bounds, length: " (length a))) default)))
(if (and (>= idx 0) (< idx (length a))) (in a idx) (oob (length a))))
(if (pvec? coll)
(if (and (>= idx 0) (< idx (pv-count coll)))
(pv-nth coll idx)
(if (nil? default) (error (string "Index " idx " out of bounds, length: " (pv-count coll))) default))
(oob (pv-count coll)))
(if (lazy-seq? coll)
(do
(var cur coll)
@ -1108,17 +1112,12 @@
(while (and (< i idx) (ls-first cur))
(set cur (ls-rest cur))
(++ i))
(if (ls-first cur) (ls-first cur)
(if (nil? default)
(error (string "Index " idx " out of bounds"))
default)))
(if (ls-first cur) (ls-first cur) (oob idx)))
(do
(var c (realize-for-iteration coll))
(if (and (>= idx 0) (< idx (length c)))
(if (string? c) (make-char (in c idx)) (in c idx))
(if (nil? default)
(error (string "Index " idx " out of bounds, length: " (length c)))
default)))))))))
(oob (length c))))))))))
(defn core-sort
"(sort coll) or (sort comparator coll). Comparator may return a boolean or a
@ -2814,12 +2813,92 @@
(each a args (array/push result a))
result)
# --- Destructuring expansion (Clojure's `destructure`) -----------------------
# Expands a binding vector containing destructuring patterns into a plain binding
# vector (alternating plain-symbol / init-form), using nth/nthnext/get. Shared by
# let/loop/fn so BOTH the interpreter and the compiler see only plain bindings —
# the compiler can then compile destructuring (it never sees a pattern), and the
# kernel needn't destructure at runtime. Mirrors evaluator/destructure-bind.
(defn- d-sym [name] {:jolt/type :symbol :ns nil :name name})
(defn- d-amp? [x] (and (struct? x) (= :symbol (x :jolt/type)) (= "&" (x :name))))
(defn- d-plain-sym? [x] (and (struct? x) (= :symbol (x :jolt/type))))
(defn- d-find-or [or-map nm]
# [has-default default-form] for binding name nm in an :or map
(var found false) (var dv nil)
(when or-map
(each k (keys or-map)
(when (and (d-plain-sym? k) (= nm (k :name)))
(set found true) (set dv (get or-map k)))))
[found dv])
(var d-process nil)
(defn- d-vec [pat g out]
(var i 0) (var idx 0) (def n (length pat))
(while (< i n)
(def elem (in pat i))
(cond
(d-amp? elem)
(do (d-process (in pat (+ i 1)) @[(d-sym "nthnext") g idx] out) (+= i 2))
(= elem :as)
(do (d-process (in pat (+ i 1)) g out) (+= i 2))
true
(do (d-process elem @[(d-sym "nth") g idx nil] out) (++ idx) (++ i)))))
(defn- d-map [pat g out]
(def or-map (get pat :or))
(def as-sym (get pat :as))
(when as-sym (array/push out as-sym) (array/push out g))
(each spec [[:keys :kw] [:strs :str] [:syms :sym]]
(def kw (in spec 0)) (def kind (in spec 1)) (def names (get pat kw))
(when names
(each s names
(def is-sym (d-plain-sym? s))
(def local (if is-sym (s :name) (string s)))
# A namespaced symbol in :keys/:syms (x/y) looks up the namespaced key
# but binds the bare local y.
(def nsp (and is-sym (s :ns)))
(def keyform (case kind
:kw (keyword (if nsp (string nsp "/" local) local))
:str local
:sym @[(d-sym "quote") {:jolt/type :symbol :ns nsp :name local}]))
(def fo (d-find-or or-map local))
(array/push out (d-sym local))
(array/push out (if (in fo 0)
@[(d-sym "get") g keyform (in fo 1)]
@[(d-sym "get") g keyform])))))
(each k (keys pat)
(when (not (keyword? k)) # explicit {pattern key-expr}
(d-process k @[(d-sym "get") g (get pat k)] out))))
(set d-process
(fn dp [pat init out]
(cond
(d-plain-sym? pat) (do (array/push out pat) (array/push out init))
(tuple? pat) (let [g (gensym "_d__")]
(array/push out g) (array/push out init) (d-vec pat g out))
(and (struct? pat) (nil? (pat :jolt/type)))
(let [g (gensym "_d__")]
(array/push out g) (array/push out init) (d-map pat g out))
(error "unsupported destructuring pattern"))))
(defn core-destructure
"Clojure `destructure`: binding vector with patterns -> plain binding vector."
[bindings]
(def out @[])
(var i 0) (def n (length bindings))
(while (< i n) (d-process (in bindings i) (in bindings (+ i 1)) out) (+= i 2))
(tuple/slice out))
(defn core-let
"Macro: (let [bindings] body) → (let* [bindings] body)"
"Macro: (let [bindings] body) → (let* [plain-bindings] body), expanding
destructuring patterns so the compiler/interpreter see only plain symbols."
[bindings & body]
(def result @[])
(array/push result {:jolt/type :symbol :ns nil :name "let*"})
(array/push result bindings)
(array/push result (core-destructure bindings))
(each b body (array/push result b))
result)