feat: assoc-in/update-in/fnil; fix update to use immutable assoc; fix latent core-assoc table-copy bug (splice of pairs)

This commit is contained in:
Yogthos 2026-06-04 14:34:53 -04:00
parent 08de360315
commit fc6c630d5d
5 changed files with 38 additions and 4 deletions

View file

@ -0,0 +1 @@
["^ ","~$bucket-count",["^ ","~:row",4,"~:col",1,"~:name","^0","~:ns","~$jolt.lang.persistent-hash-map","~:top-ns","^5","~:type","~:pos-int"],"~$bucket-contains?",["^ ","~:fixed-arities",["~#set",[2]],"~:private",true,"^4","^5","^3","^9","^7","~:fn","^2",1,"^6","^5","^1",71],"~$phm-empty",["^ ","^1",128,"^2",1,"^:",["^;",[1]],"^3","^>","^4","^5","^6","^5","^7","^="],"~$bucket-entries",["^ ","^:",["^;",[1]],"^<",true,"^4","^5","^3","^?","^7","^=","^2",1,"^6","^5","^1",52],"~$bucket-keys",["^ ","^:",["^;",[1]],"^<",true,"^4","^5","^3","^@","^7","^=","^2",1,"^6","^5","^1",59],"~$phm-count",["^ ","^1",125,"^2",1,"^:",["^;",[1]],"^3","^A","^4","^5","^6","^5","^7","^="],"~$copy-buckets",["^ ","^:",["^;",[3]],"^<",true,"^4","^5","^3","^B","^7","^=","^2",1,"^6","^5","^1",88],"~$map?",["^ ","^1",170,"^2",1,"^:",["^;",[1]],"^3","^C","^4","^5","^6","^5","^7","^="],"~$phm-conj",["^ ","^1",167,"^2",1,"^:",["^;",[2]],"^3","^D","^4","^5","^6","^5","^7","^="],"~$phm-dissoc",["^ ","^1",108,"^2",1,"^:",["^;",[2]],"^3","^E","^4","^5","^6","^5","^7","^="],"~$phm-seq",["^ ","^1",131,"^2",1,"^:",["^;",[1]],"^3","^F","^4","^5","^6","^5","^7","^="],"~$bucket-dissoc",["^ ","^:",["^;",[2]],"^<",true,"^4","^5","^3","^G","^7","^=","^2",1,"^6","^5","^1",37],"~$PersistentHashMap",["^ ","^1",6,"^2",1,"^3","^H","^4","^5","^6","^5","~:class",true],"~$phm-assoc",["^ ","^1",97,"^2",1,"^:",["^;",[3]],"^3","^J","^4","^5","^6","^5","^7","^="],"~$phm-from-pairs",["^ ","^:",["^;",[1]],"^<",true,"^4","^5","^3","^K","^7","^=","^2",1,"^6","^5","^1",158],"~$->PersistentHashMap",["^ ","^1",6,"^2",1,"^:",["^;",[3]],"^3","^L","^4","^5","^6","^5"],"~:filename","/Users/yogthos/src/jolt/src/jolt/clojure/lang/persistent_hash_map.clj","~$bucket-vals",["^ ","^:",["^;",[1]],"^<",true,"^4","^5","^3","^N","^7","^=","^2",1,"^6","^5","^1",65],"~$hash-key",["^ ","^:",["^;",[1]],"^<",true,"^4","^5","^3","^O","^7","^=","^2",1,"^6","^5","~:arities",["^ ","~i1",["^ ","~:ret",["^;",["~:number","~:nat-int"]],"~:arglist-str","[k]"]],"^1",10],"~$phm-get",["^ ","^1",79,"^2",1,"^:",["^;",[3,2]],"^3","^U","^4","^5","^6","^5","^7","^="],"~$phm-contains?",["^ ","^1",121,"^2",1,"^:",["^;",[2]],"^3","^V","^4","^5","^6","^5","^P",["^ ","~i2",["^ ","^Q",["^;",["~:boolean"]],"^T","[m k]"]],"^7","^="],"~$hash-map",["^ ","^1",164,"^2",1,"~:varargs-min-arity",0,"^3","^X","^4","^5","^6","^5","^7","^="],"~$phm-keys",["^ ","^1",140,"^2",1,"^:",["^;",[1]],"^3","^Z","^4","^5","^6","^5","^7","^="],"~$bucket-find",["^ ","^:",["^;",[2]],"^<",true,"^4","^5","^3","^[","^7","^=","^2",1,"^6","^5","^1",13],"~$phm-vals",["^ ","^1",149,"^2",1,"^:",["^;",[1]],"^3","^10","^4","^5","^6","^5","^7","^="],"~$bucket-assoc",["^ ","^:",["^;",[3]],"^<",true,"^4","^5","^3","^11","^7","^=","^2",1,"^6","^5","^1",21],"~$EMPTY-PHM",["^ ","^1",8,"^2",1,"^3","^12","^4","^5","^6","^5"]]

File diff suppressed because one or more lines are too long

View file

@ -0,0 +1 @@
["^ ","~:classpath",["~#set",[]],"~:project-hash","","~:project-root","/Users/yogthos/src/jolt","~:settings-hash","99914b932bd37a50b983c5e7c90ae93b","~:kondo-config-hash","a5ffe1b0410baf2fa8f60d5a7fcf416d8516c8422ab9d3ed5b4f53e9bb3ddf3f","~:dependency-scheme","zipfile","~:analysis",null,"~:analysis-checksums",["^ "],"~:project-analysis-type","~:project-and-full-dependencies","~:version",13,"~:stubs-generation-namespaces",["^1",[]]]

View file

@ -41,6 +41,9 @@
"dissoc" "core-dissoc"
"get" "core-get"
"get-in" "core-get-in"
"assoc-in" "core-assoc-in"
"update-in" "core-update-in"
"fnil" "core-fnil"
"contains?" "core-contains?"
"count" "core-count"
"empty?" "core-empty?"

View file

@ -158,7 +158,7 @@
(defn core-assoc [m & kvs]
(if (phm? m)
(do (var result m) (var i 0) (while (< i (length kvs)) (set result (phm-assoc result (kvs i) (kvs (+ i 1)))) (+= i 2)) result)
(do (var result @{}) (when m (each k (if (struct? m) (keys m) (keys (table ;(pairs m)))) (put result k (get m k))))
(do (var result @{}) (when m (each k (keys m) (put result k (get m k))))
(var i 0) (while (< i (length kvs)) (let [k (kvs i) v (kvs (+ i 1))] (put result k v) (+= i 2)))
(if (struct? m) (table/to-struct result) result))))
@ -1650,9 +1650,34 @@
# update — works on both structs and tables
(defn core-update [m k f & args]
(let [current (get m k)
new-val (apply f current args)]
(put m k new-val)))
(core-assoc m k (apply f (core-get m k) args)))
(defn- ks-rest [ks]
(if (tuple? ks) (tuple/slice ks 1) (array/slice ks 1)))
(defn core-assoc-in [m ks v]
(let [k (in ks 0)]
(if (<= (length ks) 1)
(core-assoc m k v)
(let [sub (core-get m k)]
(core-assoc m k (core-assoc-in (if (nil? sub) {} sub) (ks-rest ks) v))))))
(defn core-update-in [m ks f & args]
(let [k (in ks 0)]
(if (<= (length ks) 1)
(core-assoc m k (apply f (core-get m k) args))
(let [sub (core-get m k)]
(core-assoc m k (apply core-update-in (if (nil? sub) {} sub) (ks-rest ks) f args))))))
(defn core-fnil [f & defaults]
(fn [& args]
(def new-args (array/slice args))
(var i 0)
(each d defaults
(when (and (< i (length new-args)) (nil? (in new-args i)))
(put new-args i d))
(++ i))
(apply f new-args)))
# copy-var stubs for sci.impl.copy-vars (used by sci.impl.namespaces)
(defn core-copy-core-var [sym] nil)
@ -2025,6 +2050,9 @@
"comment" core-comment
"resolve" core-resolve
"update" core-update
"update-in" core-update-in
"assoc-in" core-assoc-in
"fnil" core-fnil
"copy-core-var" core-copy-core-var
"copy-var" core-copy-var
"macrofy" core-macrofy