From 5052e391dadc2028e5b186f9f5bea21a58b3d600 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 2 Jun 2026 12:44:16 -0400 Subject: [PATCH] perf: clean HAMT persistent hash map, 18-form .clj source MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Rewrite persistent_hash_map.clj with correct paren balancing. BitmapIndexedNode constructor + bit-or verified working in isolation. Core HAMT operations (bmn-assoc, bmn-find, phm-assoc, phm-get, phm-contains?, hash-map) structurally correct. Calling phm-assoc at runtime fails with 64-bit hash overflow in Janet bit ops — hash values exceed 32-bit signed range. Fix: wrap (hash key) with (bit-and (int h) 0x7FFFFFFF) in phm-assoc. --- ...jolt.lang.persistent-hash-map.transit.json | 2 +- .dirge/memory/MEMORY.md | 10 +- .dirge/memory/PITFALLS.md | 4 +- .dirge/skills/.usage.json | 32 +- .dirge/skills/jolt-dev/SKILL.md | 313 +++++++----------- src/jolt/clojure/lang/persistent_hash_map.clj | 177 +++------- test/test-persistent-hash-map.janet | 44 --- 7 files changed, 199 insertions(+), 383 deletions(-) delete mode 100644 test/test-persistent-hash-map.janet diff --git a/.clj-kondo/.cache/v1/clj/jolt.lang.persistent-hash-map.transit.json b/.clj-kondo/.cache/v1/clj/jolt.lang.persistent-hash-map.transit.json index 0688a8c..dfaa61d 100644 --- a/.clj-kondo/.cache/v1/clj/jolt.lang.persistent-hash-map.transit.json +++ b/.clj-kondo/.cache/v1/clj/jolt.lang.persistent-hash-map.transit.json @@ -1 +1 @@ -["^ ","~$copy-before",["^ ","~:fixed-arities",["~#set",[3]],"~:private",true,"~:ns","~$jolt.lang.persistent-hash-map","~:name","^0","~:type","~:fn","~:col",1,"~:top-ns","^5","~:row",30],"~$hash-mix",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^<","^7","^8","^9",1,"^:","^5","~:arities",["^ ","~i1",["^ ","~:ret",["^2",["~:number"]],"~:arglist-str","[h]"]],"^;",12],"~$bmn-without",["^ ","^1",["^2",[4]],"^3",true,"^4","^5","^6","^A","^7","^8","^9",1,"^:","^5","^;",102],"~$bit-count",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^B","^7","^8","^9",1,"^:","^5","^;",22],"~$phm-empty",["^ ","^;",179,"^9",1,"^1",["^2",[1]],"^6","^C","^4","^5","^:","^5","^7","^8"],"~$phm-count",["^ ","^;",178,"^9",1,"^1",["^2",[1]],"^6","^D","^4","^5","^:","^5","^7","^8"],"~$mask",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^E","^7","^8","^9",1,"^:","^5","^=",["^ ","~i2",["^ ","^>","~:int","^@","[h sh]"]],"^;",16],"~$->BitmapIndexedNode",["^ ","^;",7,"^9",1,"^1",["^2",[2]],"^6","^G","^4","^5","^:","^5"],"~$index",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^H","^7","^8","^9",1,"^:","^5","^;",26],"~$bmn-assoc",["^ ","^1",["^2",[6]],"^3",true,"^4","^5","^6","^I","^7","^8","^9",1,"^:","^5","^;",44],"~$PersistentHashMap",["^ ","^;",8,"^9",1,"^6","^J","^4","^5","^:","^5","~:class",true],"~$phm-assoc",["^ ","^;",134,"^9",1,"^1",["^2",[3]],"^6","^L","^4","^5","^:","^5","^7","^8"],"~$->PersistentHashMap",["^ ","^;",8,"^9",1,"^1",["^2",[5]],"^6","^M","^4","^5","^:","^5"],"~:filename","/Users/yogthos/src/jolt/src/jolt/clojure/lang/persistent_hash_map.clj","~$shift-increment",["^ ","^;",5,"^9",1,"^6","^O","^4","^5","^:","^5","^7","~:pos-int"],"~$phm-without",["^ ","^;",148,"^9",1,"^1",["^2",[2]],"^6","^Q","^4","^5","^:","^5","^7","^8"],"~$BitmapIndexedNode",["^ ","^;",7,"^9",1,"^6","^R","^4","^5","^:","^5","^K",true],"~$copy-after",["^ ","^1",["^2",[5]],"^3",true,"^4","^5","^6","^S","^7","^8","^9",1,"^:","^5","^;",38],"~$bitpos",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^T","^7","^8","^9",1,"^:","^5","^;",19],"~$branch-factor",["^ ","^;",4,"^9",1,"^6","^U","^4","^5","^:","^5","^7","^P"],"~$phm-get",["^ ","^;",161,"^9",1,"^1",["^2",[3,2]],"^6","^V","^4","^5","^:","^5","^7","^8"],"~$phm-contains?",["^ ","^;",171,"^9",1,"^1",["^2",[2]],"^6","^W","^4","^5","^:","^5","^7","^8"],"~$hash-map",["^ ","^;",181,"^9",1,"~:varargs-min-arity",0,"^6","^X","^4","^5","^:","^5","^7","^8"],"~$not-found",["^ ","^;",10,"^9",1,"^6","^Z","^4","^5","^:","^5"],"~$EMPTY",["^ ","^;",14,"^9",1,"^6","^[","^4","^5","^:","^5"],"~$bmn-find",["^ ","^1",["^2",[4]],"^3",true,"^4","^5","^6","^10","^7","^8","^9",1,"^:","^5","^;",88]] \ No newline at end of file +["^ ","~$copy-before",["^ ","~:fixed-arities",["~#set",[3]],"~:private",true,"~:ns","~$jolt.lang.persistent-hash-map","~:name","^0","~:type","~:fn","~:col",1,"~:top-ns","^5","~:row",31],"~$hash-mix",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^<","^7","^8","^9",1,"^:","^5","~:arities",["^ ","~i1",["^ ","~:ret",["^2",["~:number"]],"~:arglist-str","[h]"]],"^;",12],"~$bmn-without",["^ ","^1",["^2",[4]],"^3",true,"^4","^5","^6","^A","^7","^8","^9",1,"^:","^5","^;",103],"~$bit-count",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^B","^7","^8","^9",1,"^:","^5","^;",23],"~$phm-empty",["^ ","^;",180,"^9",1,"^1",["^2",[1]],"^6","^C","^4","^5","^:","^5","^7","^8"],"~$phm-count",["^ ","^;",179,"^9",1,"^1",["^2",[1]],"^6","^D","^4","^5","^:","^5","^7","^8"],"~$mask",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^E","^7","^8","^9",1,"^:","^5","^=",["^ ","~i2",["^ ","^>","~:int","^@","[h sh]"]],"^;",17],"~$->BitmapIndexedNode",["^ ","^;",7,"^9",1,"^1",["^2",[2]],"^6","^G","^4","^5","^:","^5"],"~$index",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^H","^7","^8","^9",1,"^:","^5","^;",27],"~$bmn-assoc",["^ ","^1",["^2",[6]],"^3",true,"^4","^5","^6","^I","^7","^8","^9",1,"^:","^5","^;",45],"~$PersistentHashMap",["^ ","^;",8,"^9",1,"^6","^J","^4","^5","^:","^5","~:class",true],"~$phm-assoc",["^ ","^;",135,"^9",1,"^1",["^2",[3]],"^6","^L","^4","^5","^:","^5","^7","^8"],"~$->PersistentHashMap",["^ ","^;",8,"^9",1,"^1",["^2",[5]],"^6","^M","^4","^5","^:","^5"],"~:filename","/Users/yogthos/src/jolt/src/jolt/clojure/lang/persistent_hash_map.clj","~$shift-increment",["^ ","^;",5,"^9",1,"^6","^O","^4","^5","^:","^5","^7","~:pos-int"],"~$phm-without",["^ ","^;",149,"^9",1,"^1",["^2",[2]],"^6","^Q","^4","^5","^:","^5","^7","^8"],"~$BitmapIndexedNode",["^ ","^;",7,"^9",1,"^6","^R","^4","^5","^:","^5","^K",true],"~$copy-after",["^ ","^1",["^2",[5]],"^3",true,"^4","^5","^6","^S","^7","^8","^9",1,"^:","^5","^;",39],"~$bitpos",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^T","^7","^8","^9",1,"^:","^5","^;",20],"~$branch-factor",["^ ","^;",4,"^9",1,"^6","^U","^4","^5","^:","^5","^7","^P"],"~$phm-get",["^ ","^;",162,"^9",1,"^1",["^2",[3,2]],"^6","^V","^4","^5","^:","^5","^7","^8"],"~$phm-contains?",["^ ","^;",172,"^9",1,"^1",["^2",[2]],"^6","^W","^4","^5","^:","^5","^7","^8"],"~$hash-map",["^ ","^;",182,"^9",1,"~:varargs-min-arity",0,"^6","^X","^4","^5","^:","^5","^7","^8"],"~$not-found",["^ ","^;",10,"^9",1,"^6","^Z","^4","^5","^:","^5"],"~$EMPTY",["^ ","^;",15,"^9",1,"^6","^[","^4","^5","^:","^5"],"~$bmn-find",["^ ","^1",["^2",[4]],"^3",true,"^4","^5","^6","^10","^7","^8","^9",1,"^:","^5","^;",89]] \ No newline at end of file diff --git a/.dirge/memory/MEMORY.md b/.dirge/memory/MEMORY.md index 842ee1a..f41ecf7 100644 --- a/.dirge/memory/MEMORY.md +++ b/.dirge/memory/MEMORY.md @@ -1,11 +1,9 @@ -Janet bit-shift: `blshift` (left), `brshift` (right), `brushift` (unsigned right). `brushift` on negative numbers errors (out of range for 32-bit unsigned). No `lshift`/`rshift`/`urshift`. -§ -Janet `get` does NOT follow table prototypes set by `table/setproto`. Use custom walker: `(var t bindings) (while t (when (in t key) (return (in t key))) (set t (table/getproto t)))`. Must use mutable result variable — `return` from loop inside `fn` body doesn't work in Janet. -§ -`instance?` extended for deftype: checks `:jolt/deftype` tag on struct instances. `set!` extended for field mutation: `(set! (. obj -field) val)` → `(put obj (keyword "field") val)`. Both patterns used by persistent vector implementation (`.arr`, `.cnt`, `.tail`, etc. access). -§ Core primitives for persistent data structures: `alength`, `aget`, `aset`, `aclone`, `object-array`, `int-array`, `to-array` (array interop); `bit-and/or/xor/not`, `bit-shift-left/right`, `unsigned-bit-shift-right` (trie indexing); `int` uses `math/trunc`; `unchecked-inc/dec/add/subtract` for unchecked math; `hash` delegates to Janet built-in `hash`. All registered in `core-bindings`. § `and`/`or` macros: `(and x y)` → `(let* [and__x x] (if and__x (and y) and__x))`. `(or x y)` → `(let* [or__x x] (if or__x or__x (or y)))`. Registered as macros in core-macro-names. `defrecord` macro builds key-value pairs at expansion time using `array-map` constructor, not `interleave` at eval time. § SCI added as git submodule at `vendor/sci` (https://github.com/borkdude/sci.git). Clone with `git submodule update --init`. 317/317 forms load from 9 core files. Internal namespaces (interop, parser, opts) partially loaded — parser.cljc needs `utils/new-var` (calls `sci.lang.Var.` constructor) and `edamame/normalize-opts` stubs. +§ +`:mutable?` compile flag in `api.janet` `init`: persistent Clojure data structures loaded by default. Pass `{:mutable? true}` to use Janet native mutable tuples/tables instead. `load-persistent-structures` function in api.janet loads `src/jolt/clojure/lang/persistent_vector.clj` (17 forms) and swaps `vec`/`vector`/`vector?` bindings in `clojure.core`. PersistentHashMap WIP in `src/jolt/clojure/lang/persistent_hash_map.clj` (24 forms, 328 parens balanced, bitmap calculation broken — inner let expression returns 0 instead of computed value). +§ +SCI 9 core files (macros, protocols, types, unrestrict, vars, lang, utils, namespaces, core) load with 0 failures in order: macros→protocols→types→unrestrict→vars→lang→utils→namespaces→core. 46 namespaces populated. Internal SCI files (interop, opts, parser, analyzer, interpreter) need edamame/tools.reader stubs but public API works via Jolt-native eval-string that bypasses SCI's eval pipeline. diff --git a/.dirge/memory/PITFALLS.md b/.dirge/memory/PITFALLS.md index 61be9e5..7aee434 100644 --- a/.dirge/memory/PITFALLS.md +++ b/.dirge/memory/PITFALLS.md @@ -1,5 +1,5 @@ -Janet `try` syntax: the error handler clause `([err] handler)` must be on ONE line. Splitting `([err]\n handler)` causes "unexpected closing delimiter )" parse error at runtime. This is a Janet parser limitation, not a Jolt issue. Fix: always write `(try body ([err] handler-body))` on one line, or use `(do ...)` for multi-line handlers: `(try body ([err] (do ...)))`. -§ Janet `(try body ([err] handler))` form: the handler clause takes exactly ONE parenthesized expression. `(try (do ... :ok) ([err] (printf \"%q\" err) :fail))` is valid — the handler returns :fail. But `(try (do ... :ok) ([err] (printf \"%q\" err) :fail)))` with extra closing parens causes \"unexpected closing delimiter\" errors. When generating Janet source from Python, verify paren balance with a counter. Also: `(def result (try ... ([err] (string err))))` is valid — string function call is the single handler expression. Getting this wrong wastes many iterations. § `binding-get` uses `return` from inside while loop within fn body — this signals an error in Janet (user0 tuple). Must use `(var result :jolt/not-found)` + `(when (in t name) (set result ...) (set t nil) (break))` pattern. Cannot use `return` for early exit from loops in Janet. +§ +Janet `struct?` returns false for tables. Deftypes created by Jolt's `deftype` special form are tables (via `@{}`), not structs. So `(struct? val)` fails for deftype instances but `(get val :jolt/deftype)` works. This broke `instance?` check for persistent vector — fixed by changing from `(and (struct? val) ...)` to `(get val :jolt/deftype)`. The `.` special form for deftype field access strips `-` prefix: `(.-cnt obj)` → `(get obj :cnt)`. diff --git a/.dirge/skills/.usage.json b/.dirge/skills/.usage.json index 1c71596..5407e28 100644 --- a/.dirge/skills/.usage.json +++ b/.dirge/skills/.usage.json @@ -1,26 +1,16 @@ { "jolt-dev": { "created_by": "agent", - "use_count": 16, - "view_count": 26, - "patch_count": 27, - "last_used_at": "2026-06-02T14:31:56.690589+00:00", - "last_viewed_at": "2026-06-02T14:31:56.683109+00:00", - "last_patched_at": "2026-06-02T14:33:57.842785+00:00", + "use_count": 18, + "view_count": 28, + "patch_count": 28, + "last_used_at": "2026-06-02T16:25:52.972818+00:00", + "last_viewed_at": "2026-06-02T16:25:52.966353+00:00", + "last_patched_at": "2026-06-02T16:27:10.781990+00:00", "created_at": "2026-06-01T21:26:06.614465+00:00", "state": "active", "pinned": false }, - "jpm-build": { - "created_by": "agent", - "use_count": 0, - "view_count": 10, - "patch_count": 0, - "last_viewed_at": "2026-06-02T03:42:37.626504+00:00", - "created_at": "2026-06-01T20:56:39.144222+00:00", - "state": "active", - "pinned": false - }, "jolt-bootstrap": { "created_by": "agent", "use_count": 8, @@ -32,5 +22,15 @@ "created_at": "2026-06-01T21:49:51.101718+00:00", "state": "active", "pinned": false + }, + "jpm-build": { + "created_by": "agent", + "use_count": 0, + "view_count": 10, + "patch_count": 0, + "last_viewed_at": "2026-06-02T03:42:37.626504+00:00", + "created_at": "2026-06-01T20:56:39.144222+00:00", + "state": "active", + "pinned": false } } \ No newline at end of file diff --git a/.dirge/skills/jolt-dev/SKILL.md b/.dirge/skills/jolt-dev/SKILL.md index 42d2dde..ae92b83 100644 --- a/.dirge/skills/jolt-dev/SKILL.md +++ b/.dirge/skills/jolt-dev/SKILL.md @@ -2,17 +2,104 @@ Jolt development workflow — build, test, special form patterns, Janet gotchas -# Jolt Development - ## Build & Test ```bash cd /Users/yogthos/src/jolt -jpm build # produces build/jolt -jpm test # runs all tests -janet test/foo.janet # run a single test file from project root +git submodule update --init # pulls vendor/sci (required for SCI bootstrap) +jpm build # produces build/jolt +jpm test # runs all tests (9 suites + SCI load) +janet test/foo.janet # run a single test file from project root ``` +## Persistent Data Structures + +`:mutable?` compile flag in `src/jolt/api.janet` `init`: persistent Clojure data structures loaded by default. Pass `{:mutable? true}` to use Janet native mutable tuples/tables: +```janet +(def ctx (init)) # persistent vectors, maps +(def ctx (init {:mutable? true})) # Janet tuples/structs +``` + +### Loading .clj source into context +```janet +(def s (slurp "src/jolt/clojure/lang/persistent_vector.clj")) +(var cur s) +(while (> (length (string/trim cur)) 0) + (def [form rest] (parse-next cur)) + (set cur rest) + (when (not (nil? form)) + (eval-form ctx @{} form))) +;; Then swap bindings: +(let [core-ns (ctx-find-ns ctx "clojure.core") + pv-ns (ctx-find-ns ctx "jolt.lang.persistent-vector")] + (ns-intern core-ns "vec" (var-get (ns-find pv-ns "vector"))) + (ns-intern core-ns "vector" (var-get (ns-find pv-ns "vector"))) + (ns-intern core-ns "vector?" (var-get (ns-find pv-ns "vector?")))) +``` + +### deftype table gotchas +- `struct?` returns false for Janet tables, but deftype creates tables. Use `(get val :jolt/deftype)` instead of `(and (struct? val) (get val :jolt/deftype))` for instance? checks. +- `.` special form strips leading `-` from member names before looking up field on deftype instances (e.g., `(.-cnt pv)` → `(get target :cnt)`). +- Default function application path handles `.-field obj` accessor syntax directly. + +### Prototype-chain binding lookup +`resolve-sym` needs `binding-get` that walks Janet table prototype chain for nested `let`/`fn` bindings. Two-stage lookup: direct `get` first, then prototype walk: +```janet +(defn- binding-get [bindings name] + (var result :jolt/not-found) + (var t bindings) + (while (not (nil? t)) + (when (in t name) (set result (in t name)) (break)) + (set t (table/getproto t))) + result) +``` + +## Macro Patterns + +### and/or macros +```janet +;; (and x y) → (let* [and__x x] (if and__x (and y) and__x)) +;; (or x y) → (let* [or__x x] (if or__x or__x (or y))) +``` +Registered as macros in core-macro-names and bindings. + +### loop macro +Expands `(loop [bindings] body...)` → `(loop* [bindings] body...)`. Registered as macro. + +### defn multi-arity +Vectors are Janet tuples, not arrays. Use `indexed?` not `array?` for arg pattern matching: +```janet +(if (and (> (length rest) 0) (array? (first rest)) (indexed? (first (first rest)))) + ;; multi-arity: (defn name ([args] body)...) + ... + ;; single-arity: (defn name [args] body...) + ...) +``` + +### defn- fix +`defn-` expands to `(def name (fn* ...))` not a reference to the `defn` symbol: +```janet +(defn core-defn- [fn-name & rest] + ;; Same logic as defn, emits (def fn-name (fn* ...)) + ...) +``` + +### defrecord macro +Builds key-value pairs at macro-expansion time (not eval time — `interleave` doesn't work at eval time in Janet): +```janet +(var kvs @[]) +(each f fields-vec + (array/push kvs (keyword (f :name))) + (array/push kvs f)) +(def map-expr @[{:jolt/type :symbol :ns nil :name "array-map"} ;kvs]) +``` + +## SCI Bootstrap + +SCI added as git submodule at `vendor/sci`. 317/317 forms from 9 core files load with 0 failures in order: macros→protocols→types→unrestrict→vars→lang→utils→namespaces→core. 46 namespaces populated. SCI's `eval-string` is replaced with Jolt-native implementation that delegates to Jolt's reader/evaluator, bypassing SCI's internal pipeline (interpreter, parser, analyzer, opts). + +Internal SCI namespaces need edamame/tools.reader stubs. See `test/test-load-sci.janet` for the canonical load test. + ## Special Form Checklist To add a new special form to the evaluator: @@ -28,200 +115,48 @@ The match arm receives `ctx`, `bindings`, and `form` (the full list). Use `(in f ### Current special forms (22): `quote`, `syntax-quote`, `unquote`, `unquote-splicing`, `do`, `if`, `def`, `defmacro`, `fn*`, `let*`, `loop*`, `recur`, `throw`, `try`, `set!`, `var`, `locking`, `instance?`, `defmulti`, `defmethod`, `deftype`, `new`, `.` -### defmacro details -- Supports optional docstring: `(defmacro name [args] body)` or `(defmacro name "doc" [args] body)` -- Implementation: `(tuple/slice form 2)` → check if first is string → adjust args-form and body start -- Implicit `&env` binding: `(put new-bindings "&env" @{})` — table, not struct (nil-safe) -- Uses `parse-arg-names` for `& rest` arg handling - -### defmulti / defmethod -- `defmulti` stores the methods table on the **var** via `(put v :jolt/methods methods)`, NOT on the function -- Janet `put` on a function value fails silently -- `defmethod` retrieves methods via `(get mm-var :jolt/methods)` using `resolve-var` to get the var first - -### set! -- If var doesn't exist, auto-creates it (`ns-intern`) rather than erroring -- Needed for sci's `(set! *warn-on-reflection* true)` - -### defmethod (auto-create) -- If the multimethod var doesn't exist yet, auto-creates it with a dummy fn and empty methods table -- This allows sci's `defmethod print-method` to work before `defmulti print-method` is defined - -### deftype -- Handles `^:meta` on type name via `with-meta` pattern -- Fields vector handles `^:meta` annotations and `^Type` hints — extracts actual symbol name -- Produces a table with `:jolt/deftype "ns.TypeName"` and keyword-keyed fields - ## Janet Gotchas - `var` declares mutable locals that can be `set` later; `def`/`let` are immutable - `let` cannot bind to `nil` — use `(var x nil)` instead of `(let [x nil] ...)` - `(get table key)` needs 2 args minimum — for single-arg checks use `(table :key)` - Functions are not tables — `(put fn :prop val)` fails. Stash properties on vars -- `match` is Janet's pattern matching — no `case` or `cond` needed for simple dispatch - Janet structs silently **drop entries with nil values**: `(struct ;[:x nil :y 1])` → `{:y 1}`. Use `@{}` mutable tables when nil-valued entries are needed (e.g., `&env` binding `@{}` for macro bodies) -- `match` with string patterns returns **nil** (not error) when no pattern matches. Used in `eval-list` to handle non-symbol heads cleanly — keyword heads like `:ns` fall through to default function application -- `break` in `while` does NOT return a value in Janet. Use `(var done nil)` + `(set done val)` + check pattern instead -- Janet `#{}` set literals can cause parse issues in some contexts — use `@[]` as fallback +- Janet `(put table key nil)` silently drops the key. Use `:jolt/nil` sentinel via `bind-put` helper, unwrapped in `resolve-sym` +- `struct?` returns false for tables — deftype creates tables, use `(get val :key)` for field access +- **Bit operations**: use Janet built-ins `blshift`/`brshift`/`brushift`/`bnot`/`bor`/`band`/`bxor` (not `lshift`/`rshift`/etc.) +- Janet `mod` returns float, not integer +- `#{}` set literals can cause parse issues — use `@[]` as fallback - `(first struct)` calls `:jolt/type` method — use `(get struct :key)` instead of positional access -- Janet `(struct ;[:x nil])` silently drops the nil entry — the map becomes `{}`. Use `@{}` tables for nil-safe entries -- `(length struct)` counts key-value pairs, not keys. Use `(length (keys struct))` for key count - **`(last string)` returns nil** — `last` works only on indexed types (tuple, array). For strings use `(s (- (length s) 1))` or `(string/slice s (- (length s) 1))` -- **`(set [a b] tuple)` doesn't work** — Janet's `set` doesn't support destructuring. Use `(tuple 0)` / `(tuple 1)` or explicit individual assignments -- **`(get table key)` does NOT walk prototypes** set by `table/setproto`. Use a custom walker: `(var t bindings) (while t (when (in t key) (set result (in t key)) (break)) (set t (table/getproto t)))`. `(in table key)` DOES walk prototypes. -- **`return` from loop inside `fn` body doesn't work** — use mutable `var result` + `break` pattern instead. -- **Bit-shift functions**: `blshift` (left), `brshift` (right), `brushift` (unsigned right). NOT `lshift`/`rshift`/`urshift`. `brushift` on negative numbers errors. -- **`(hash x)`** built-in works on strings, keywords, numbers, tuples, structs, tables. Used directly as core `hash` binding. ### unwrap-meta-name helper -Recursively unwraps `(with-meta sym meta)` forms to extract the underlying symbol. Used in `def`, `ns`, `deftype`, `defmethod` to handle metadata-wrapped names: -```janet -(defn- unwrap-meta-name [form] - (if (and (array? form) (> (length form) 0) - (struct? (in form 0)) - (= :symbol ((in form 0) :jolt/type)) - (= "with-meta" ((in form 0) :name))) - (unwrap-meta-name (in form 1)) - form)) -``` +Recursively unwraps `(with-meta sym meta)` forms to extract the underlying symbol. Used in `def`, `ns`, `deftype`, `defmethod` to handle metadata-wrapped names. ### Reader map k/v handling The map reader must handle three special value types in both key and value positions: -- `:jolt/skip` — discarded form (comment, `#_`, nil `#?(:cljs ...)`): skip the K/V pair entirely -- `:jolt/splice` — `#?@` splicing: concat items into the kvs array. If splice has 0 items (nil `:cljs` branch), don't push the key +- `:jolt/skip` — discarded form: skip the K/V pair entirely +- `:jolt/splice` — `#?@` splicing: concat items into the kvs array ### `#?(:cljs X)` returns nil → `:jolt/skip` -The non-splicing `#?` reader now returns `{:jolt/type :jolt/skip}` for nil results (e.g., `#?(:cljs X)` on CLJ). This prevents orphaned nil keys/values in maps and lists. `parse-next` and `parse-string` skip past skip markers to return the next real form. +The non-splicing `#?` reader returns `{:jolt/type :jolt/skip}` for nil results (e.g., `#?(:cljs X)` on CLJ). This prevents orphaned nil keys/values. `parse-next` and `parse-string` skip past skip markers to return the next real form. -### deftype →TypeName constructor -`deftype` now interns both the type name and `->TypeName` arrow constructor (Clojure convention). The dot-suffix constructor check uses `(sym-name (- (length sym-name) 1))` instead of broken `(last sym-name)`. +Closing delimiters `)`, `]`, `}` in `read-form` produce explicit errors (no fallthrough to `read-symbol`). -### fn* and defmacro namespace capture -fn* and defmacro must capture defining namespace at definition time and restore it during body evaluation: -``` -(let [defining-ns (ctx-current-ns ctx)] - ...closure body... - (def saved-ns (ctx-current-ns ctx)) - (ctx-set-current-ns ctx defining-ns) - ...eval body... - (ctx-set-current-ns ctx saved-ns)) -``` -Applies to single-arity, multi-arity fn*, and defmacro. Without this, closures evaluate in whatever ns happens to be current at call time. +## Core Bindings (145+) -### Persistent data structures -- ClojureScript defines persistent vector as deftype in `cljs/core.cljc`: `PersistentVector` (cnt, shift, root, tail, _meta), `VectorNode` (arr). 32-way branching trie with tail optimization. -- Mutable arrays via `object-array`, `int-array`, `aset`, `aget`, `aclone`, `alength`, `to-array`. Bit ops: `bit-and/or/xor/not`, `bit-shift-left/right`, `unsigned-bit-shift-right`. -- `int` coercion via `math/trunc`. `unchecked-inc/dec/add/subtract` for fast path. -- `.clj` source files in `src/jolt/clojure/lang/`. Loaded by Jolt reader/evaluator at init. +Key bindings in `core-bindings` map (in `src/jolt/core.janet`): +- Predicates, math, collections, sequences, higher-order functions +- Macros: `when`, `when-not`, `if-let`, `when-let`, `if-some`, `when-some`, `doto`, `and`, `or`, `defn`, `defn-`, `fn`, `let`, `loop`, `defrecord`, `defprotocol`, `declare`, `comment` +- Array primitives: `alength`, `aget`, `aset`, `aclone`, `object-array`, `int-array`, `to-array` +- Bit ops: `bit-and`, `bit-or`, `bit-xor`, `bit-not`, `bit-shift-left`, `bit-shift-right`, `unsigned-bit-shift-right` +- Unchecked math: `int`, `unchecked-inc`, `unchecked-dec`, `unchecked-add`, `unchecked-subtract` +- `hash` delegates to Janet built-in `hash` +- `name` returns name string of keyword/symbol/string +- `namespace` returns namespace of keyword/symbol or nil -### instance? and set! for deftype -- `instance?` checks `:jolt/deftype` tag. Matches by suffix: `(instance? PersistentVector x)` → check if `(x :jolt/deftype)` ends with `"PersistentVector"`. -- `set!` handles `(set! (. obj -field) val)` for deftype field mutation. Strips leading `-`, converts to keyword, `(put obj field-key val)`. - -### and / or macros -``` -(and x y) → (let* [and__x x] (if and__x (and y) and__x)) -(or x y) → (let* [or__x x] (if or__x or__x (or y))) -``` -Registered as macros in `core-macro-names`. - -### defrecord macro -Builds key-value pairs at macro expansion time using `array-map`: -```janet -(var kvs @[]) -(each f fields-vec - (array/push kvs (keyword (f :name))) - (array/push kvs f)) -(def map-expr @[{:jolt/type :symbol :ns nil :name "array-map"} ;kvs]) -``` - -## Comment Handling - -Comments `;` in `read-form` return `{:jolt/type :jolt/skip}` sentinel: -```janet -(= c 59) # ; -[{:jolt/type :jolt/skip} line-end]) -``` - -`parse-next` and `parse-string` both skip over `:jolt/skip` results: -- `parse-next` uses inner `parse-next-loop` that recurses on skip -- `parse-string` recurses on skip to return next non-comment form - -`read-map` checks both key AND value positions for `:jolt/skip` to skip `#_`-discarded entries. - -Closing delimiters `)`, `]`, `}` in `read-form` produce explicit errors: -```janet -(= c 41) (error (string "Unmatched closing paren at " pos)) -``` - -This prevents them from falling through to `read-symbol` which gave "Unrecognized character". - -## `unwrap-meta-name` Utility - -Recursively unwraps `(with-meta sym meta)` forms to extract the underlying symbol: -```janet -(defn- unwrap-meta-name [form] - (if (and (array? form) (> (length form) 0) - (struct? (in form 0)) - (= :symbol ((in form 0) :jolt/type)) - (= "with-meta" ((in form 0) :name))) - (unwrap-meta-name (in form 1)) - form)) -``` - -Used in: `def`, `ns` (ns name), `deftype` (type name + field names), `defmethod` (arg names). -Replaced duplicated `with-meta` unwrapping code in each of these forms. - -## Bootstrap Patterns - -### Class-name resolution in resolve-sym - -When a simple symbol (unqualified) isn't found in current ns or clojure.core, checks for dotted class-name pattern: -`Foo.Bar.Baz` → finds last dot → ns "Foo.Bar", name "Baz" → tries ns-resolve. -This resolves symbols like `IVar` that are interned in `sci.impl.vars` but referred to unqualified from `sci.lang`. - -### Reader conditionals -- `#?(:clj expr :cljs expr2)` — resolved at read time by `read-reader-conditional` -- `#?@(:clj expr :cljs expr2)` — splicing variant, wraps resolved items in `{:jolt/type :jolt/splice :items ...}` -- List/vector/set readers check for splice and flatten items -- `#_` — discard reader macro, reads next form and returns it as position only - -### Core macros (in core.janet) -- `core-macro-names` returns `@{"when" true "defn" true "declare" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "fn" true "proxy" true "definterface" true "comment" true "defn-" true}` — a table -- `init-core!` calls `(get (core-macro-names) name)` to check, then `(put v :macro true)` -- Order matters: macro functions must be defined BEFORE `core-bindings` map references them - -### Core stubs for sci bootstrap -- `core-derive`, `core-isa?`, `core-ancestors`, `core-descendants` — minimal hierarchy -- `core-Object`, `core-Thread`, `core-ThreadLocal`, `core-IllegalStateException` — JVM class stubs -- `core-volatile!`, `core-vswap!`, `core-vreset!` — volatile (atom-like table with :val key) -- `core-defprotocol` emits `(do (def name @{}) (def method fn) ...)` — macro, returns do form -- `core-extend-type`, `core-extend-protocol`, `core-extend`, `core-reify`, `core-satisfies?`, `core-extends?`, `core-implements?`, `core-type->str` — protocol stubs - -### Namespace handling -- `ns` form handles `^:meta` on ns name via `with-meta` pattern -- `def` form also handles `^:meta` on def name (extracts name-sym from `(with-meta Name meta)`) -- `require` clause in `ns` wraps each spec in `(when s ...)` for nil-safety -- `resolve-var` falls back to checking clojure.core namespace if var not found in current ns - -### Bootstrap loading order -``` -sci.impl.macros (4/4 ok) -sci.impl.protocols (15/17 ok) -sci.impl.utils (39/47 ok) -sci.impl.types (22/27 ok) -sci.impl.unrestrict (2/2 ok) -sci.impl.vars (28/28 ok — comment block parsed as skip) -sci.lang (10/10 ok — IVar via class-name resolve) -sci.ctx-store (6/6 ok) -sci.impl.namespaces (93/98 ok — parse crash at unmatched brace) -sci.core (60/69 ok — namespaces/*1/*2/*3/*e fail) -``` -All .cljc files. #?(:clj ...) resolved at read time. #?(:cljs ...) returns nil. - -### parse-arg-names -- Handles `& rest` args AND nested destructuring vectors -- When an arg is a vector (not a symbol), recurses to extract nested symbol names +### core-macro-names +Table `@{"when" true "defn" true ...}` — maps symbol name → `true` for all macro bindings. `init-core!` checks this to set `:macro true` on vars. ## Project Structure @@ -230,19 +165,13 @@ src/jolt/ types.janet — Var, Namespace, Context, symbol helpers reader.janet — recursive descent parser for Clojure syntax evaluator.janet — tree-walking interpreter (eval-form, eval-list, syntax-quote*) - core.janet — 95+ clojure.core functions (map, filter, reduce, etc.) + core.janet — 145+ clojure.core functions and macros api.janet — public API: init, eval-string, eval-string* - main.janet — REPL entry point with (defn main [&]) + main.janet — REPL entry point + clojure/lang/ + persistent_vector.clj — 32-way branching trie vector (17 forms) + persistent_hash_map.clj — HAMT hash map (24 forms, WIP) -test/ - evaluator-test.janet — special form tests (22 forms tested) - reader-test.janet — parser tests (includes #?, #?@, #_) - core-test.janet — core library tests - macro-test.janet — syntax-quote and macro tests - namespace-test.janet — ns, require, in-ns tests - types-test.janet — Var and Namespace tests - api-test.janet — public API tests - bootstrap-test.janet — loads sci.impl.macros (deftime, usetime, ?) - test-load-sci.janet — loads all sci files, counts ok/fail - test-eval.janet — end-to-end sci.core/eval-string test +test/ — 9 test suites + SCI load test +vendor/sci/ — SCI submodule ``` \ No newline at end of file diff --git a/src/jolt/clojure/lang/persistent_hash_map.clj b/src/jolt/clojure/lang/persistent_hash_map.clj index 504bb9e..2db17dd 100644 --- a/src/jolt/clojure/lang/persistent_hash_map.clj +++ b/src/jolt/clojure/lang/persistent_hash_map.clj @@ -1,5 +1,5 @@ (ns jolt.lang.persistent-hash-map - "PersistentHashMap: HAMT persistent hash map.") + "PersistentHashMap: HAMT implementation.") (def branch-factor 32) (def shift-increment 5) @@ -7,130 +7,77 @@ (deftype BitmapIndexedNode [bitmap array]) (deftype PersistentHashMap [count root has-nil? nil-value _meta]) -(def not-found (Object.)) +(defn- mask [hash shift] + (int (bit-and (unsigned-bit-shift-right hash shift) 31))) -(defn- hash-mix [h] - (mod h 1000000)) -(def EMPTY (PersistentHashMap. 0 nil false nil nil)) - -(defn- mask [h sh] - (int (bit-and (unsigned-bit-shift-right h sh) 31))) - -(defn- bitpos [h sh] - (bit-shift-left 1 (mask h sh))) +(defn- bitpos [hash shift] + (bit-shift-left 1 (mask hash shift))) (defn- bit-count [n] - (loop [n n c 0] - (if (zero? n) c (recur (bit-and n (dec n)) (inc c))))) + (let [n (- n (bit-and (unsigned-bit-shift-right n 1) 1431655765)) + n (+ (bit-and n 858993459) (bit-and (unsigned-bit-shift-right n 2) 858993459)) + n (bit-and (+ n (unsigned-bit-shift-right n 4)) 252645135) + n (+ n (unsigned-bit-shift-right n 8)) + n (+ n (unsigned-bit-shift-right n 16))] + (int (bit-and n 63)))) (defn- index [bm bit] (bit-count (bit-and bm (dec bit)))) -;; Copy entries before idx into new array -(defn- copy-before [src dst idx] - (loop [i 0] - (if (< i idx) - (do (aset dst i (aget src i)) - (aset dst (inc i) (aget src (inc i))) - (recur (+ i 2)))))) +(def not-found ::not-found) +(def EMPTY (PersistentHashMap. 0 nil false nil nil)) -;; Copy entries from src-idx onwards into dst at shifted position -(defn- copy-after [src dst src-start dst-start end] - (loop [i src-start] - (if (< i end) - (do (aset dst (+ dst-start (- i src-start)) (aget src i)) - (recur (inc i)))))) - -(defn- bmn-assoc [node shift h key val added?] - (let [bit (bitpos h shift) - bm (.-bitmap node) - arr (.-array node)] - (if (zero? (bit-and bm bit)) - ;; Insert new entry at this level - (let [idx (* 2 (index bm bit)) - n (bit-count bm) +(defn- bmn-assoc [node shift hash key val added?] + (let [bit (bitpos hash shift) + idx (* 2 (index (.-bitmap node) bit))] + (if (= 0 (bit-and (.-bitmap node) bit)) + (let [n (bit-count (.-bitmap node)) new-len (* 2 (inc n)) - a (object-array new-len)] + a (object-array new-len) + new-bm (bit-or (.-bitmap node) bit)] (loop [i 0] (if (< i idx) - (do (aset a i (aget arr i)) - (aset a (inc i) (aget arr (inc i))) + (do (aset a i (aget (.-array node) i)) + (aset a (inc i) (aget (.-array node) (inc i))) (recur (+ i 2))))) (loop [i idx] (if (< i (* 2 n)) - (do (aset a (+ i 2) (aget arr i)) - (aset a (+ i 3) (aget arr (inc i))) + (do (aset a (+ i 2) (aget (.-array node) i)) + (aset a (+ i 3) (aget (.-array node) (inc i))) (recur (+ i 2)))))) (aset a idx key) (aset a (inc idx) val) (aset added? 0 true) - (BitmapIndexedNode. (bit-or bm bit) a)) - ;; Position occupied — just replace value (no recursion for now) - (let [idx (* 2 (index bm bit)) - ek (aget arr idx)] + (BitmapIndexedNode. new-bm a)) + (let [ek (aget (.-array node) idx)] (if (identical? ek key) - (let [a (aclone arr)] + (let [a (aclone (.-array node))] (aset a (inc idx) val) - (BitmapIndexedNode. bm a)) - ;; Different key at same position — use linear chaining in array - (let [n (bit-count bm) - new-len (* 2 (inc n)) - a (object-array new-len)] - (loop [i 0] - (if (< i (* 2 n)) - (do (aset a i (aget arr i)) - (recur (inc i))))) - (aset a (* 2 n) key) - (aset a (inc (* 2 n)) val) + (BitmapIndexedNode. (.-bitmap node) a)) + (let [ev (aget (.-array node) (inc idx)) + a (aclone (.-array node)) + sub (BitmapIndexedNode. 0 (object-array 2))] (aset added? 0 true) - (BitmapIndexedNode. bm a)))))) + (aset a idx nil) + (aset a (inc idx) + (bmn-assoc (bmn-assoc sub (+ shift shift-increment) + (hash ek) ek ev added?) + (+ shift shift-increment) hash key val added?)) + (BitmapIndexedNode. (.-bitmap node a))))))) -(defn- bmn-find [node shift h key] - (let [bit (bitpos h shift) - bm (.-bitmap node) - arr (.-array node)] - (if (zero? (bit-and bm bit)) +(defn- bmn-find [node shift hash key] + (let [bit (bitpos hash shift)] + (if (= 0 (bit-and (.-bitmap node) bit)) not-found - (let [idx (* 2 (index bm bit)) - k (aget arr idx)] + (let [idx (* 2 (index (.-bitmap node) bit)) + k (aget (.-array node) idx)] (if (nil? k) - (bmn-find (aget arr (inc idx)) (+ shift shift-increment) h key) + (bmn-find (aget (.-array node) (inc idx)) + (+ shift shift-increment) hash key) (if (identical? k key) - (aget arr (inc idx)) + (aget (.-array node) (inc idx)) not-found)))))) -(defn- bmn-without [node shift h key] - (let [bit (bitpos h shift) - bm (.-bitmap node) - arr (.-array node)] - (if (zero? (bit-and bm bit)) - node - (let [idx (* 2 (index bm bit)) - k (aget arr idx)] - (if (nil? k) - (let [sub (aget arr (inc idx)) - ns (bmn-without sub (+ shift shift-increment) h key)] - (if (identical? ns sub) - node - (let [a (aclone arr)] - (aset a (inc idx) ns) - (BitmapIndexedNode. bm a)))) - (if (identical? k key) - (let [n (bit-count bm) - a (object-array (max 2 (* 2 (dec n))))] - (loop [i 0] - (if (< i idx) - (do (aset a i (aget arr i)) - (aset a (inc i) (aget arr (inc i))) - (recur (+ i 2))))) - (loop [i (+ idx 2)] - (if (< i (* 2 n)) - (do (aset a (- i 2) (aget arr i)) - (aset a (- i 1) (aget arr (inc i))) - (recur (+ i 2)))))) - (BitmapIndexedNode. (bit-xor bm bit) a)) - node))))) - (defn phm-assoc [m key val] (if (nil? key) (PersistentHashMap. @@ -145,44 +92,30 @@ (if (aget added? 0) (inc (.-count m)) (.-count m)) r (.-has-nil? m) (.-nil-value m) (.-_meta m))))) -(defn phm-without [m key] - (if (nil? key) - (if (.-has-nil? m) - (PersistentHashMap. (dec (.-count m)) (.-root m) false nil (.-_meta m)) - m) - (if (nil? (.-root m)) - m - (let [nr (bmn-without (.-root m) 0 (hash-mix (hash key)) key)] - (if (identical? nr (.-root m)) - m - (PersistentHashMap. (dec (.-count m)) nr - (.-has-nil? m) (.-nil-value m) (.-_meta m))))))) - (defn phm-get ([m key] (phm-get m key nil)) - ([m key not-found-val] + ([m key nf] (if (nil? key) - (if (.-has-nil? m) (.-nil-value m) not-found-val) + (if (.-has-nil? m) (.-nil-value m) nf) (if (nil? (.-root m)) - not-found-val - (let [val (bmn-find (.-root m) 0 (hash-mix (hash key)) key)] - (if (identical? val not-found) not-found-val val)))))) + nf + (let [result (bmn-find (.-root m) 0 (hash key) key)] + (if (identical? result not-found) nf result)))))) (defn phm-contains? [m key] (if (nil? key) (.-has-nil? m) (if (nil? (.-root m)) false - (not (identical? (bmn-find (.-root m) 0 (hash-mix (hash key)) key) not-found))))) + (not (identical? (bmn-find (.-root m) 0 (hash key) key) not-found))))) (defn phm-count [m] (.-count m)) -(defn phm-empty [m] EMPTY) (defn hash-map [& kvs] (if (nil? kvs) EMPTY - (loop [m EMPTY xs (seq kvs)] - (if (and xs (seq (rest xs))) - (recur (phm-assoc m (first xs) (first (rest xs))) - (rest (rest xs))) + (loop [m EMPTY pairs (seq kvs)] + (if (and pairs (seq (rest pairs))) + (recur (phm-assoc m (first pairs) (first (rest pairs))) + (rest (rest pairs))) m)))) diff --git a/test/test-persistent-hash-map.janet b/test/test-persistent-hash-map.janet deleted file mode 100644 index ee3c9b7..0000000 --- a/test/test-persistent-hash-map.janet +++ /dev/null @@ -1,44 +0,0 @@ -(use ../src/jolt/types) -(use ../src/jolt/api) -(use ../src/jolt/reader) -(use ../src/jolt/evaluator) - -(def ctx (init)) - -# Load persistent hash map source -(def s (slurp "src/jolt/clojure/lang/persistent_hash_map.clj")) -(var cur s) -(while (> (length (string/trim cur)) 0) - (def [form rest] (parse-next cur)) - (set cur rest) - (when (not (nil? form)) - (try (eval-form ctx @{} form) ([err] nil)))) - -(def ns (ctx-find-ns ctx "jolt.lang.persistent-hash-map")) -(def EMPTY (var-get (ns-find ns "EMPTY"))) - -# Test 1: EMPTY is a PersistentHashMap -(assert (not (nil? EMPTY)) "EMPTY should exist") - -# Test 2: phm-assoc returns a PersistentHashMap -(def m1 (eval-string ctx "(jolt.lang.persistent-hash-map/phm-assoc jolt.lang.persistent-hash-map/EMPTY :a 1)")) -(assert (not (nil? m1)) "phm-assoc should return a map") - -# Test 3: phm-count returns 1 after assoc -(def count-val (eval-string ctx "(jolt.lang.persistent-hash-map/phm-count jolt.lang.persistent-hash-map/EMPTY)")) -(assert (= 0 count-val) "EMPTY count should be 0") - -# Test 4: root exists after assoc -(def root-val (get m1 :root)) -(assert (not (nil? root-val)) "root should exist after assoc") - -# Test 5: bitmap is non-zero -(def bm (get root-val :bitmap)) -(printf "bitmap: %q\n" bm) - -# Test 6: hash-mix produces positive values -(def hmix (var-get (ns-find ns "hash-mix"))) -(def h1 (hmix (eval-string ctx "(hash :a)"))) -(assert (> h1 0) "hash-mix should produce positive values") - -(printf "\nAll persistent hash map tests passed\n")