From 51860a553ebb932d588fad5d96ee810b6437b3ce Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 2 Jun 2026 10:23:02 -0400 Subject: [PATCH] feat: array/bit/hash primitives for persistent data structures Added 22 new clojure.core bindings needed to implement persistent data structures as Clojure source files: Array operations: alength, aget, aset, aclone, object-array, int-array, to-array (host interop for trie arrays) Bit operations: bit-and, bit-or, bit-xor, bit-not, bit-shift-left, bit-shift-right, unsigned-bit-shift-right (for 32-way trie indexing) Integer ops: int (trunc), unchecked-inc/dec/add/subtract Other: hash, namespace, set! support for (set! (. obj -field) val) instance? support for deftype types via :jolt/deftype tag All 9 test suites pass. 317/317 SCI forms load. --- src/jolt/core.janet | 76 ++++++++++++++++++++++++++++++++++++++++ src/jolt/evaluator.janet | 57 +++++++++++++++++++++--------- 2 files changed, 116 insertions(+), 17 deletions(-) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index afff7b8..ac67852 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -542,6 +542,14 @@ (if (string? x) x "")))) +(defn core-namespace + "Returns the namespace of a keyword, symbol, or nil if none." + [x] + (if (keyword? x) (string x) + (if (and (struct? x) (= :symbol (x :jolt/type))) + (if (x :ns) (if (struct? (x :ns)) ((x :ns) :name) (string (x :ns))) nil) + nil))) + (def core-subs (fn [& args] (case (length args) @@ -569,6 +577,50 @@ (print "\n") nil) +# ============================================================ +# Array primitives (needed for persistent data structures) +# ============================================================ + +(def core-alength (fn [arr] (length arr))) +(def core-aget (fn [arr idx] (in arr idx))) +(def core-aset (fn [arr idx val] (put arr idx val) val)) +(def core-aclone (fn [arr] (array/slice arr 0))) +(def core-object-array (fn [size] (array/new-filled size nil))) +(def core-int-array (fn [size] (array/new-filled size 0))) +(def core-to-array (fn [coll] + (def arr @[]) + (each x coll (array/push arr x)) + arr)) + +# ============================================================ +# Bit operations (needed for persistent data structures) +# ============================================================ + +(def core-bit-and (fn [a b] (band a b))) +(def core-bit-or (fn [a b] (bor a b))) +(def core-bit-xor (fn [a b] (bxor a b))) +(def core-bit-not (fn [a] (bnot a))) +(def core-bit-shift-left (fn [x n] (blshift x n))) +(def core-bit-shift-right (fn [x n] (brshift x n))) +(def core-unsigned-bit-shift-right (fn [x n] (brushift x n))) + +# ============================================================ +# Integer coercion +# ============================================================ + +(def core-int (fn [x] (math/trunc x))) +(def core-unchecked-inc (fn [x] (+ x 1))) +(def core-unchecked-dec (fn [x] (- x 1))) +(def core-unchecked-add (fn [& xs] (+ ;xs))) +(def core-unchecked-subtract (fn [& xs] (- ;xs))) + +# ============================================================ +# Hash +# ============================================================ + +(def core-hash (fn [x] (hash x))) + + # ============================================================ # Atom # ============================================================ @@ -938,6 +990,30 @@ "println" core-println "pr" core-pr "prn" core-prn + # Array primitives (for persistent data structures) + "alength" core-alength + "aget" core-aget + "aset" core-aset + "aclone" core-aclone + "object-array" core-object-array + "int-array" core-int-array + "to-array" core-to-array + # Bit operations + "bit-and" core-bit-and + "bit-or" core-bit-or + "bit-xor" core-bit-xor + "bit-not" core-bit-not + "bit-shift-left" core-bit-shift-left + "bit-shift-right" core-bit-shift-right + "unsigned-bit-shift-right" core-unsigned-bit-shift-right + # Integer coercion / unchecked math + "int" core-int + "unchecked-inc" core-unchecked-inc + "unchecked-dec" core-unchecked-dec + "unchecked-add" core-unchecked-add + "unchecked-subtract" core-unchecked-subtract + # Hash + "hash" core-hash "atom" core-atom "atom?" core-atom? "deref" core-deref diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 7439215..795718b 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -464,29 +464,52 @@ (run-finally finally-body) (error err))) (eval-form ctx bindings body-form)))) - "set!" (let [target-sym (in form 1) - val (eval-form ctx bindings (in form 2)) - v (resolve-var ctx bindings target-sym)] - (if v - (do (var-set v val) val) - # Auto-create var if it doesn't exist (e.g., *warn-on-reflection*) - (let [ns-name (ctx-current-ns ctx) - ns (ctx-find-ns ctx ns-name)] - (def new-v (ns-intern ns (target-sym :name) val)) - val))) + "set!" (let [target (in form 1) + val (eval-form ctx bindings (in form 2))] + # (set! (. obj -field) val) — instance field mutation + (if (and (array? target) (> (length target) 0) + (struct? (first target)) + (= :symbol ((first target) :jolt/type)) + (= "." ((first target) :name))) + (let [obj (eval-form ctx bindings (in target 1)) + field-sym (in target 2) + field-name (field-sym :name) + field-key (keyword (if (and (> (length field-name) 0) (= "-" (string/slice field-name 0 1))) + (string/slice field-name 1) + field-name))] + (if (get obj :jolt/deftype) + (do (put obj field-key val) val) + (error (string "Can't set! field on non-deftype: " (type obj))))) + # (set! var val) — normal var mutation + (let [target-sym target + v (resolve-var ctx bindings target-sym)] + (if v + (do (var-set v val) val) + # Auto-create var if it doesn't exist + (let [ns-name (ctx-current-ns ctx) + ns (ctx-find-ns ctx ns-name)] + (def new-v (ns-intern ns (target-sym :name) val)) + val))))) "var" (let [target-sym (in form 1) v (resolve-var ctx bindings target-sym)] (if v v (error (string "Unable to resolve var: " (sym-name-str target-sym) " in var")))) "locking" (eval-form ctx bindings (in form 2)) "instance?" (let [type-sym (in form 1) val (eval-form ctx bindings (in form 2))] - (match (type-sym :name) - "Number" (number? val) - "String" (string? val) - "Boolean" (or (= true val) (= false val)) - "Keyword" (keyword? val) - "Object" true - false)) + (if (and (struct? val) (get val :jolt/deftype)) + (let [type-tag (val :jolt/deftype) + type-name (type-sym :name)] + (or (= type-tag type-name) + (and (> (length type-tag) (length type-name)) + (= (string/slice type-tag (- (length type-tag) (length type-name))) + type-name)))) + (match (type-sym :name) + "Number" (number? val) + "String" (string? val) + "Boolean" (or (= true val) (= false val)) + "Keyword" (keyword? val) + "Object" true + false))) "defmulti" (let [name-sym (in form 1) dispatch-fn (eval-form ctx bindings (in form 2)) ns (ctx-find-ns ctx (ctx-current-ns ctx))