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.
This commit is contained in:
parent
5ae537474b
commit
51860a553e
2 changed files with 116 additions and 17 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue