From cbc610c665a1d1b1c21abb8e2a7d72839d2565c1 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 4 Jun 2026 14:31:24 -0400 Subject: [PATCH] fix: unified recursive destructuring (nested seq/map, :strs/:syms, :or, :as, fn-params); proper defn docstring/attr-map handling --- .beads/interactions.jsonl | 1 + .beads/issues.jsonl | 9 ++ src/jolt/core.janet | 60 ++++++------ src/jolt/evaluator.janet | 189 +++++++++++++++++++++++++++++--------- test/conformance.janet | 38 ++++++++ 5 files changed, 221 insertions(+), 76 deletions(-) diff --git a/.beads/interactions.jsonl b/.beads/interactions.jsonl index 1c685e5..9443e87 100644 --- a/.beads/interactions.jsonl +++ b/.beads/interactions.jsonl @@ -4,3 +4,4 @@ {"id":"int-2eef7613","kind":"field_change","created_at":"2026-06-04T18:06:02.544998Z","actor":"Yogthos","issue_id":"jolt-wec","extra":{"field":"status","new_value":"closed","old_value":"open"}} {"id":"int-a7573343","kind":"field_change","created_at":"2026-06-04T18:09:14.608401Z","actor":"Yogthos","issue_id":"jolt-alz","extra":{"field":"status","new_value":"closed","old_value":"open"}} {"id":"int-40cd8348","kind":"field_change","created_at":"2026-06-04T18:09:15.510649Z","actor":"Yogthos","issue_id":"jolt-nte","extra":{"field":"status","new_value":"closed","old_value":"open"}} +{"id":"int-57f4d2b3","kind":"field_change","created_at":"2026-06-04T18:31:23.83434Z","actor":"Yogthos","issue_id":"jolt-9sb","extra":{"field":"status","new_value":"closed","old_value":"open"}} diff --git a/.beads/issues.jsonl b/.beads/issues.jsonl index 6d67bb0..a71cc04 100644 --- a/.beads/issues.jsonl +++ b/.beads/issues.jsonl @@ -4,3 +4,12 @@ {"_type":"issue","id":"jolt-x8s","title":"CRITICAL: collections not callable as IFn (vector/map/set)","status":"closed","priority":1,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T17:46:14Z","created_by":"Yogthos","updated_at":"2026-06-04T17:50:54Z","closed_at":"2026-06-04T17:50:54Z","dependency_count":0,"dependent_count":0,"comment_count":0} {"_type":"issue","id":"jolt-alz","title":"CRITICAL: self-referential lazy-seq/lazy-cat yields only literal prefix","status":"closed","priority":1,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T17:46:13Z","created_by":"Yogthos","updated_at":"2026-06-04T18:09:15Z","closed_at":"2026-06-04T18:09:15Z","dependency_count":0,"dependent_count":0,"comment_count":0} {"_type":"issue","id":"jolt-wec","title":"CRITICAL: multi-collection map returns unrealized thunk","status":"closed","priority":1,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T17:46:12Z","created_by":"Yogthos","updated_at":"2026-06-04T18:06:02Z","closed_at":"2026-06-04T18:06:02Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-gxr","title":"HIGH: aliased namespace calls (require :as) don't resolve (s/join)","status":"open","priority":2,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:58Z","created_by":"Yogthos","updated_at":"2026-06-04T18:09:58Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-4z9","title":"HIGH: dispatch — multimethod :default, protocol-on-record, extend-protocol","status":"open","priority":2,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:57Z","created_by":"Yogthos","updated_at":"2026-06-04T18:09:57Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-40n","title":"HIGH: update/update-in/assoc-in fail on map literals (struct)","status":"open","priority":2,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:56Z","created_by":"Yogthos","updated_at":"2026-06-04T18:09:56Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-ytt","title":"HIGH: str semantics — (str nil)='nil' should be '', (str :b)='b' should be ':b'","status":"open","priority":2,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:56Z","created_by":"Yogthos","updated_at":"2026-06-04T18:09:56Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-9sb","title":"HIGH: destructuring gaps (nested seq, :strs, nested map, fn-param)","status":"closed","priority":2,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:55Z","created_by":"Yogthos","updated_at":"2026-06-04T18:31:24Z","closed_at":"2026-06-04T18:31:24Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-7dy","title":"MED: compiler path lacks IFn dispatch (collections-as-fn) — only interpreter fixed","status":"open","priority":3,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:10:00Z","created_by":"Yogthos","updated_at":"2026-06-04T18:10:00Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-90c","title":"MED: filter/take-while not lazy — infinite-seq (take N (filter p (range))) loops","status":"open","priority":3,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:10:00Z","created_by":"Yogthos","updated_at":"2026-06-04T18:10:00Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-7n5","title":"MED: REPL display — def/defn should print #'ns/name; lazy-seq printer realizes only head ((0 \u003cfunction\u003e))","status":"open","priority":3,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:59Z","created_by":"Yogthos","updated_at":"2026-06-04T18:09:59Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-h0n","title":"MED: missing core fns — letfn fnil trampoline doseq cycle partition-all reductions dedupe keep-indexed map-indexed transduce reduce-kv assoc-in peek subvec read-string format","status":"open","priority":3,"issue_type":"feature","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:58Z","created_by":"Yogthos","updated_at":"2026-06-04T18:09:58Z","dependency_count":0,"dependent_count":0,"comment_count":0} diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 67e74f3..1795b61 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -1453,43 +1453,39 @@ @[{:jolt/type :symbol :ns nil :name "pop-thread-bindings"}]]]]) +(defn- defn->def + "Shared expansion for defn/defn-: (name doc-string? attr-map? params body...) + or (name doc-string? attr-map? ([params] body)... attr-map?) -> (def name (fn* ...))." + [fn-name rest] + (var items (array/slice rest)) + # strip optional docstring + (when (and (> (length items) 0) (string? (first items))) + (set items (array/slice items 1))) + # strip optional attr-map (a map literal, i.e. struct/table that isn't a symbol) + (when (and (> (length items) 0) + (let [x (first items)] + (and (or (struct? x) (table? x)) + (not (and (struct? x) (= :symbol (get x :jolt/type))))))) + (set items (array/slice items 1))) + (def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"}]) + (if (and (> (length items) 0) (array? (first items)) (indexed? (first (first items)))) + # multi-arity: each remaining item is an ([params] body...) clause + (each pair items (array/push fn-form pair)) + # single-arity: items = [params-vector body...] + (do + (array/push fn-form (first items)) + (each b (tuple/slice items 1) (array/push fn-form b)))) + @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]) + (defn core-defn - "Macro: (defn name [args] body) or (defn name ([args] body)...) - -> (def name (fn* ...) )" + "Macro: (defn name doc-string? attr-map? [args] body...) (or multi-arity) + -> (def name (fn* ...))" [fn-name & rest] - # Multi-arity if rest starts with list of [args] pairs - (if (and (> (length rest) 0) (array? (first rest)) (indexed? (first (first rest)))) - (let [pairs rest] - (def fn-form @[]) - (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) - (each pair pairs (array/push fn-form pair)) - @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]) - # Single-arity: (defn name [args] body...) - (let [args-form (first rest) - body (tuple/slice rest 1)] - (def fn-form @[]) - (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) - (array/push fn-form args-form) - (each b body (array/push fn-form b)) - @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]))) + (defn->def fn-name rest)) # defn- — same as defn (private not enforced in Jolt) (defn core-defn- [fn-name & rest] - # Multi-arity if rest starts with list of [args] pairs - (if (and (> (length rest) 0) (array? (first rest)) (indexed? (first (first rest)))) - (let [pairs rest] - (def fn-form @[]) - (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) - (each pair pairs (array/push fn-form pair)) - @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]) - # Single-arity: (defn- name [args] body...) - (let [args-form (first rest) - body (tuple/slice rest 1)] - (def fn-form @[]) - (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) - (array/push fn-form args-form) - (each b body (array/push fn-form b)) - @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]))) + (defn->def fn-name rest)) # Hierarchy stubs for sci bootstrap (def core-make-hierarchy make-hierarchy) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 2947f65..0647ae7 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -271,6 +271,135 @@ (if rest-name (array/push all rest-name)) {:fixed (tuple/slice (tuple ;fixed)) :rest rest-name :all (tuple/slice (tuple ;all))}) +# ============================================================ +# Destructuring (Clojure-compatible, recursive) +# ============================================================ + +(defn- parse-params + "Parse a parameter vector into raw patterns: {:fixed [pat...] :rest pat-or-nil}. + Unlike parse-arg-names, patterns are kept intact (not flattened) so they can + be destructured against the corresponding argument." + [args-form] + (var fixed @[]) + (var rest-pat nil) + (var i 0) + (while (< i (length args-form)) + (let [a (in args-form i)] + (if (and (struct? a) (= :symbol (a :jolt/type)) (= "&" (a :name))) + (do (+= i 1) + (when (< i (length args-form)) (set rest-pat (in args-form i))) + (+= i 1)) + (do (array/push fixed a) (+= i 1))))) + {:fixed (tuple/slice (tuple ;fixed)) :rest rest-pat}) + +(defn- d-realize + "Realize a lazy-seq to an array for positional destructuring; pass others through." + [val] + (if (lazy-seq? val) + (do + (var items @[]) (var cur val) (var go true) + (while go + (let [cell (realize-ls cur)] + (if (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell))) + (set go false) + (do (array/push items (in cell 0)) + (let [rt (in cell 1)] + (if (nil? rt) (set go false) (set cur (make-lazy-seq rt)))))))) + items) + val)) + +(defn- d-get + "Look up key k in a map-like value (phm/struct/table/nil)." + [m k] + (cond + (phm? m) (phm-get m k) + (or (struct? m) (table? m)) (get m k) + true nil)) + +(defn- find-or-default + "Find the :or default expression for binding name nm, or :jolt/none." + [or-map nm] + (var result :jolt/none) + (when or-map + (each k (keys or-map) + (when (and (struct? k) (= :symbol (k :jolt/type)) (= nm (k :name))) + (set result (get or-map k))))) + result) + +(var destructure-bind nil) +(set destructure-bind + (fn dbind [ctx bindings pat val] + (cond + # plain symbol + (and (struct? pat) (= :symbol (pat :jolt/type))) + (bind-put bindings (pat :name) val) + # sequential pattern (vector of sub-patterns) + (indexed? pat) + (let [rv (d-realize val) + seqable? (indexed? rv)] + (var di 0) (var vi 0) + (def n (length pat)) + (while (< di n) + (let [elem (in pat di)] + (cond + # & rest + (and (struct? elem) (= :symbol (elem :jolt/type)) (= "&" (elem :name))) + (do + # rest binds a seq (jolt list = array), per Clojure semantics + (destructure-bind ctx bindings (in pat (+ di 1)) + (if (and seqable? (< vi (length rv))) + (array/slice (if (tuple? rv) (array/slice rv) rv) vi) + @[])) + (set di (+ di 2))) + # :as whole + (= elem :as) + (do + (destructure-bind ctx bindings (in pat (+ di 1)) val) + (set di (+ di 2))) + # positional element + true + (do + (destructure-bind ctx bindings elem + (if (and seqable? (< vi (length rv))) (in rv vi) nil)) + (+= di 1) (+= vi 1)))))) + # map pattern (struct/table that isn't a symbol) + (or (struct? pat) (table? pat)) + (do + (def or-map (get pat :or)) + (def as-sym (get pat :as)) + (when as-sym (destructure-bind ctx bindings as-sym val)) + # :keys (keyword lookup), :strs (string lookup), :syms (symbol lookup) + (each spec [[:keys (fn [nm] (keyword nm))] + [:strs (fn [nm] nm)] + [:syms (fn [nm] {:jolt/type :symbol :ns nil :name nm})]] + (let [kw (in spec 0) keyf (in spec 1) names (get pat kw)] + (when (and names (indexed? names)) + (each s names + (let [nm (if (and (struct? s) (= :symbol (s :jolt/type))) (s :name) (string s)) + v (d-get val (keyf nm)) + v (if (nil? v) + (let [d (find-or-default or-map nm)] + (if (= d :jolt/none) nil (eval-form ctx bindings d))) + v)] + (bind-put bindings nm v)))))) + # direct {local-pattern key-expr} entries (local may itself be a + # nested vector/map pattern). Special keys are keywords; skip them. + (each k (keys pat) + (when (not (keyword? k)) + (let [key-val (eval-form ctx bindings (get pat k)) + v (d-get val key-val)] + (if (and (struct? k) (= :symbol (k :jolt/type))) + # symbol target: apply :or default if missing + (let [nm (k :name) + v (if (nil? v) + (let [d (find-or-default or-map nm)] + (if (= d :jolt/none) nil (eval-form ctx bindings d))) + v)] + (bind-put bindings nm v)) + # nested pattern target + (destructure-bind ctx bindings k v)))))) + true (error (string "Unsupported destructuring pattern: " (string/format "%q" pat)))))) + # Dispatch a special form by its string name. (defn- unwrap-meta-name "Recursively unwrap (with-meta sym meta) forms to extract the underlying symbol. @@ -444,20 +573,20 @@ (each pair pairs (let [args-form (in pair 0) body (tuple/slice pair 1) - arg-info (parse-arg-names args-form) - fixed-names (arg-info :fixed) - rest-name (arg-info :rest) - n-fixed (length fixed-names)] + param-info (parse-params args-form) + fixed-pats (param-info :fixed) + rest-pat (param-info :rest) + n-fixed (length fixed-pats)] (put arities n-fixed (fn [& fn-args] (var fn-bindings @{}) (table/setproto fn-bindings bindings) (var i 0) - (each arg-name fixed-names - (bind-put fn-bindings arg-name (fn-args i)) + (each pat fixed-pats + (destructure-bind ctx fn-bindings pat (fn-args i)) (++ i)) - (when rest-name - (put fn-bindings rest-name (tuple/slice fn-args i))) + (when rest-pat + (destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i))) (put fn-bindings :jolt/loop-fn self) # Use defining namespace for symbol resolution (def saved-ns (ctx-current-ns ctx)) @@ -477,20 +606,20 @@ # Single-arity: (fn* [args] body...) (let [args-form (in form 1) body (tuple/slice form 2) - arg-info (parse-arg-names args-form) - fixed-names (arg-info :fixed) - rest-name (arg-info :rest) + param-info (parse-params args-form) + fixed-pats (param-info :fixed) + rest-pat (param-info :rest) defining-ns (ctx-current-ns ctx)] (var self nil) (set self (fn [& fn-args] (var fn-bindings @{}) (table/setproto fn-bindings bindings) (var i 0) - (each arg-name fixed-names - (bind-put fn-bindings arg-name (fn-args i)) + (each pat fixed-pats + (destructure-bind ctx fn-bindings pat (fn-args i)) (++ i)) - (when rest-name - (put fn-bindings rest-name (tuple/slice fn-args i))) + (when rest-pat + (destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i))) (put fn-bindings :jolt/loop-fn self) # Use defining namespace for symbol resolution (def saved-ns (ctx-current-ns ctx)) @@ -510,35 +639,7 @@ (while (< i len) (let [pat (bind-vec i)] (def val (eval-form ctx new-bindings (bind-vec (+ i 1)))) - # Handle destructuring patterns - (if (struct? pat) - (let [keys-vec (get pat :keys)] - (if (and keys-vec (indexed? keys-vec)) - (each k keys-vec - (def kname (if (keyword? k) (string k) (k :name))) - (bind-put new-bindings kname (get val (keyword kname)))) - (bind-put new-bindings (pat :name) val))) - (if (indexed? pat) - # Sequential destructuring (vector pattern) - (do - (var di 0) - (while (< di (length pat)) - (let [inner-pat (in pat di)] - (if (and (struct? inner-pat) (= :symbol (inner-pat :jolt/type)) (= "&" (inner-pat :name))) - # & rest: next element gets (drop di val) - (do - (+= di 1) - (when (< di (length pat)) - (let [rest-pat (in pat di)] - (bind-put new-bindings - (if (struct? rest-pat) (rest-pat :name) rest-pat) - (tuple/slice val di))))) - (if (struct? inner-pat) - (bind-put new-bindings (inner-pat :name) (get val di)) - (bind-put new-bindings inner-pat (get val di))))) - (+= di 1))) - # Plain symbol binding - (bind-put new-bindings (pat :name) val))) + (destructure-bind ctx new-bindings pat val) (+= i 2)))) (var result nil) (each body-form body diff --git a/test/conformance.janet b/test/conformance.janet index 4ff0e22..d85a0c7 100644 --- a/test/conformance.janet +++ b/test/conformance.janet @@ -59,6 +59,44 @@ ["into map pairs" "{:a 1 :b 2}" "(into {} [[:a 1] [:b 2]])"] ["into map onto map" "{:a 1 :b 2 :c 3}" "(into {:a 1} [[:b 2] [:c 3]])"] ["into list" "(quote (3 2 1))" "(into (list) [1 2 3])"] + + ### ---- HIGH: destructuring ---- + ["destr nested seq" "[1 2 3]" "(let [[a [b c]] [1 [2 3]]] [a b c])"] + ["destr rest+as" "[1 (quote (2 3)) [1 2 3]]" "(let [[a & r :as all] [1 2 3]] [a r all])"] + ["destr map :keys" "[1 2]" "(let [{:keys [a b]} {:a 1 :b 2}] [a b])"] + ["destr map :or" "[1 99]" "(let [{:keys [a b] :or {b 99}} {:a 1}] [a b])"] + ["destr map :strs" "[1 2]" "(let [{:strs [a b]} {\"a\" 1 \"b\" 2}] [a b])"] + ["destr map :as" "[1 {:a 1}]" "(let [{:keys [a] :as m} {:a 1}] [a m])"] + ["destr nested map" "5" "(let [{{:keys [x]} :pos} {:pos {:x 5}}] x)"] + ["destr fn-param seq" "7" "((fn [[a b]] (+ a b)) [3 4])"] + ["destr fn-param map" "3" "((fn [{:keys [a b]}] (+ a b)) {:a 1 :b 2})"] + ["destr let map key" "1" "(let [{a :a} {:a 1}] a)"] + + ### ---- HIGH: update / assoc-in on map literals ---- + ["update inc" "{:a 2}" "(update {:a 1} :a inc)"] + ["update extra args" "{:a 111}" "(update {:a 1} :a + 10 100)"] + ["update-in" "{:a {:b 2}}" "(update-in {:a {:b 1}} [:a :b] inc)"] + ["assoc-in" "{:a {:b 1 :c 2}}" "(assoc-in {:a {:b 1}} [:a :c] 2)"] + ["assoc-in create" "{:a {:b 1}}" "(assoc-in {} [:a :b] 1)"] + ["update-in fnil" "{:a {:b 1}}" "(update-in {} [:a :b] (fnil inc 0))"] + ["get-in" "1" "(get-in {:a {:b {:c 1}}} [:a :b :c])"] + + ### ---- HIGH: str semantics ---- + ["str nil empty" "\"\"" "(str nil)"] + ["str concat nil" "\"a1\"" "(str \"a\" 1 nil)"] + ["str keyword" "\":b\"" "(str :b)"] + ["str symbol" "\"foo\"" "(str (quote foo))"] + ["str mixed" "\"a:b1\"" "(str \"a\" :b 1)"] + ["str seq" "\"[1 2 3]\"" "(str [1 2 3])"] + + ### ---- HIGH: dispatch ---- + ["multimethod" "9" "(do (defmulti area :shape) (defmethod area :sq [s] (* (:s s) (:s s))) (area {:shape :sq :s 3}))"] + ["multimethod default" ":def" "(do (defmulti f identity) (defmethod f :default [x] :def) (f 99))"] + ["protocol on record" "16" "(do (defprotocol Sh (ar [s])) (defrecord Sq [side] Sh (ar [_] (* side side))) (ar (->Sq 4)))"] + ["reify dispatch" "42" "(do (defprotocol P (m [_])) (m (reify P (m [_] 42))))"] + + ### ---- HIGH: aliased namespace calls ---- + ["require :as alias" "\"1,2,3\"" "(do (require (quote [clojure.string :as s])) (s/join \",\" [1 2 3]))"] ]) (var pass 0)