perf: clean HAMT persistent hash map, 18-form .clj source
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.
This commit is contained in:
Yogthos
parent
677d059c0b
commit
5052e391da
7 changed files with 199 additions and 383 deletions
|
|
@ -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]]
|
||||
["^ ","~$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]]
|
||||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)`.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
}
|
||||
|
|
@ -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
|
||||
```
|
||||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
Loading…
Add table
Add a link
Reference in a new issue