From b3a80507cc11a13832044e0561f972f0f6a16d56 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sat, 6 Jun 2026 09:36:36 -0400 Subject: [PATCH] destructuring via shared expander; fix sequential let + nth nil-default MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- src/jolt/compiler.janet | 17 ++++--- src/jolt/core.janet | 109 ++++++++++++++++++++++++++++++++++------ 2 files changed, 103 insertions(+), 23 deletions(-) diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index e51a9e6..7cdb13b 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -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) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index ebf6b90..56f2bf5 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -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)