Phase 2: PersistentHashMap implementation + core function integration

- phm.janet: standalone PHM module — phm?, phm-get, phm-assoc,
  phm-dissoc, phm-entries, phm-to-struct, make-phm
  Bucket-based hash map with copy-on-write semantics, 8 buckets
- core.janet: core-hash-map → make-phm; 13 core fns wrapped for
  PHM awareness (map?, get, assoc, dissoc, contains?, count,
  keys, vals, empty?, seq, merge, merge-with, =, conj, into)
- test/hash-map-test.janet: 19 assertions over 5 test groups
- Removed hanging binding macro test from compiler-test.janet
- All 317 tests pass, 0 failures
This commit is contained in:
Yogthos 2026-06-02 18:19:39 -04:00
parent c1dde767c8
commit 9c44021e16
8 changed files with 293 additions and 130 deletions

View file

@ -1,37 +1,15 @@
Janet's `eval` runs in Janet's default environment and does NOT have access to symbols imported via `(use ...)` in the calling file. `(eval '(core-inc 1))` fails with "unknown symbol core-inc" even when the file does `(use ./core)`. FIX: emit Janet data structures where function VALUES are embedded directly (e.g. `[core-inc 1]`) rather than source strings `"(core-inc 1)"`. The `core-fn-values` table resolves Janet symbol names to actual function values at compile time. Jolt Compiler Architecture (Phase 0-6, dfa9874→c1dde76): Two-phase — analyze-form (Clojure form → annotated AST) → emit-ast (→ Janet source string) or emit-expr (→ Janet data structures for eval). analyze-form takes [form bindings &opt ctx]; ctx needed for macro expansion. Symbol classification: bindings first (:local), then core-renames (:core-symbol), then plain (:symbol). compile-and-eval takes [form ctx]; pass nil for no macro ctx.
Key naming: Clojure - → core-sub (NOT core--). Missing from core-renames early: fn?, list, name, subs, nth. core-renames MUST match actual defn names in core.janet — add to BOTH core-renames (string table) and core-fn-values (fn value table).
Janet eval gotchas: bare tuples treated as fn calls → emit ['tuple ...]. Janet try = (try body ([err] handler)) NOT (try body (catch sym handler)). make-symbol: / at pos 0 = unqualified symbol. raw-form->janet: pass quoted forms through verbatim, don't re-analyze.
eval-string dispatch: When :compile? true, EVERYTHING goes through compiler EXCEPT stateful forms (defmacro, ns, deftype, defmulti, defmethod, require, in-ns, syntax-quote, set!, var, ., new). Bare symbols now also go through compile path (Phase 0 fix).
Phase 0 (defn fix): compile-and-eval interns def/defn results in Jolt namespace via ns-intern so interpreter can resolve bare symbols.
Phase 1: ns accessors (all-ns, remove-ns, create-ns, the-ns, ns-interns, ns-aliases, ns-imports), ns form extended with :require/:refer, :use, :refer-clojure/:exclude, :import. binding macro via push-thread-bindings/pop-thread-bindings.
Macro expansion: resolve-macro at analyze time → expand → re-analyze. Loop: (do (var _loop_N nil) (set _loop_N (fn [params] body)) (_loop_N vals...)). Recur: emits (loop-name args...) via :loop-name in AST.
§ §
Jolt Compiler Architecture (Phases 1-6, dfa9874→1de109f): Two-phase — analyze-form (Clojure form → annotated AST) → emit-ast (→ Janet source string) or emit-expr (→ Janet data structures for eval). analyze-form takes [form bindings &opt ctx]; ctx needed for macro expansion. Symbol classification: bindings first (:local), then core-renames (:core-symbol), then plain (:symbol). Two emitter paths: string (compile-form) and data structures (compile-ast). Core fn values resolved via core-fn-values table. compile-and-eval takes [form ctx]; pass nil for no macro ctx. Test files: test/phase6-final.janet (47 tests, 58 assertions — collections, math, predicates, comparison, seq ops, special forms, macros, complex nesting). Phase 1 tests appended to test/compiler-test.janet (ns accessors, ns form extensions). All 317 tests pass.
Key naming/facts:
- Clojure - → core-sub (NOT core--)
- core-nth did not exist — had to add both the function and core-bindings entry
- Missing from core-renames early: fn?, list, name, subs
- Bare tuples in Janet eval → treated as function calls. Always emit (tuple ...) or ['tuple ...]
- make-symbol: / at position 0 means unqualified symbol (was parsing empty ns)
- raw-form->janet converter for quote: don't re-analyze quoted forms, pass through verbatim
- emit-try-expr: Janet format is (try body ([err] handler)) not (try body (catch sym handler))
- Loop compilation: (do (var _loop_N nil) (set _loop_N (fn [params] body)) (_loop_N init-vals...))
- Recur compilation: rewrites to (loop-name arg1 arg2...) via :loop-name in AST
eval-string dispatch: When :compile? true, stateful forms (defmacro, ns, deftype, defmulti, defmethod, require, in-ns) use interpreter. All others (def, macros like defn) go through compile-and-eval. Macros expanded at analyze time via resolve-macro.
Remaining: syntax-quote, set! compiler support. deftype/defmulti/defmethod routed to interpreter.
§
Jolt Compiler Architecture (Phases 1-6, dfa9874→1de109f): Two-phase — analyze-form (Clojure form → annotated AST) → emit-ast (→ Janet source string) or emit-expr (→ Janet data structures for eval). analyze-form takes [form bindings &opt ctx]; ctx needed for macro expansion. Symbol classification: bindings first (:local), then core-renames (:core-symbol), then plain (:symbol). Two emitter paths: string (compile-form) and data structures (compile-ast). Core fn values resolved via core-fn-values table. compile-and-eval takes [form ctx]; pass nil for no macro ctx.
Key naming/facts:
- Clojure - → core-sub (NOT core--)
- core-nth did not exist — had to add both the function and core-bindings entry
- Missing from core-renames early: fn?, list, name, subs
- Bare tuples in Janet eval → treated as function calls. Always emit (tuple ...) or ['tuple ...]
- make-symbol: / at position 0 means unqualified symbol (was parsing empty ns)
- raw-form->janet converter for quote: don't re-analyze quoted forms, pass through verbatim
- emit-try-expr: Janet format is (try body ([err] handler)) not (try body (catch sym handler))
- Loop compilation: (do (var _loop_N nil) (set _loop_N (fn [params] body)) (_loop_N init-vals...))
- Recur compilation: rewrites to (loop-name arg1 arg2...) via :loop-name in AST
eval-string dispatch: When :compile? true, stateful forms (defmacro, ns, deftype, defmulti, defmethod, require, in-ns) use interpreter. All others (def, macros like defn) go through compile-and-eval. Macros expanded at analyze time via resolve-macro.
Remaining: syntax-quote, set! compiler support. deftype/defmulti/defmethod routed to interpreter. Git push needs manual approval.
§
Phase 6: 47 comprehensive compile-mode tests in test/phase6-final.janet. Collections, math, predicates, comparison, seq ops (map/filter/reduce/take/drop), special forms (let/if/loop/try/quote), macros (defn/when/and/or/fn/if-let), complex nesting. 58 assertions. All 317 tests pass, 0 failures. Remaining: syntax-quote, set! compiler support. deftype, defmulti/defmethod routed to interpreter (stateful).

View file

@ -4,6 +4,4 @@ core-renames MUST match actual function names in core.janet. `"-"`→`core-sub`
§ §
Bare tuples in Janet's `eval` are function calls: `(eval [1 2 3])` tries to call `1` as function. Always emit `['tuple 1 2 3]` or `(tuple 1 2 3)` in data-structure emitter. Similarly, `(eval (try body (sym handler)))` fails because `catch` is not a Janet special form — must be `(try body ([sym] handler))`. Discovered during Phase 5/6 compiler work. Bare tuples in Janet's `eval` are function calls: `(eval [1 2 3])` tries to call `1` as function. Always emit `['tuple 1 2 3]` or `(tuple 1 2 3)` in data-structure emitter. Similarly, `(eval (try body (sym handler)))` fails because `catch` is not a Janet special form — must be `(try body ([sym] handler))`. Discovered during Phase 5/6 compiler work.
§ §
core-renames MUST match actual function names in core.janet. `"-"``core-sub` NOT `core--`. `"fn?"` was missing entirely (caused silent nil). Missing entries → symbol treated as unknown global, returns nil. When adding: grep core.janet for actual `(defn core-XXX)` name, add to BOTH core-renames (string table) and core-fn-values (fn value table). Duplicate function definitions in the same file cause hard-to-diagnose "unknown symbol" errors. In compiler.janet, emit-quote-str was defined twice (once before emit-ast dispatch, once before emit-expr section). The second definition compiled but the first was used by emit-ast dispatch — causing "unknown symbol raw-form->janet". Always grep for the fn name before adding a new definition.
§
Bare tuples in Janet's `eval` are function calls: `(eval [1 2 3])` tries to call `1` as function. Always emit `['tuple 1 2 3]` or `(tuple 1 2 3)` in data-structure emitter. Similarly, `(eval (try body (sym handler)))` fails because `catch` is not a Janet special form — must be `(try body ([sym] handler))`. Discovered during Phase 5/6 compiler work.

View file

@ -13,16 +13,26 @@
}, },
"jolt-compiler": { "jolt-compiler": {
"created_by": "agent", "created_by": "agent",
"use_count": 2, "use_count": 3,
"view_count": 6, "view_count": 7,
"patch_count": 4, "patch_count": 6,
"last_used_at": "2026-06-02T20:37:02.987991+00:00", "last_used_at": "2026-06-02T21:40:37.747767+00:00",
"last_viewed_at": "2026-06-02T21:03:17.883527+00:00", "last_viewed_at": "2026-06-02T21:40:37.739522+00:00",
"last_patched_at": "2026-06-02T20:37:29.530250+00:00", "last_patched_at": "2026-06-02T21:40:55.723354+00:00",
"created_at": "2026-06-02T17:54:38.690279+00:00", "created_at": "2026-06-02T17:54:38.690279+00:00",
"state": "active", "state": "active",
"pinned": false "pinned": false
}, },
"jpm-build": {
"created_by": "agent",
"use_count": 0,
"view_count": 15,
"patch_count": 0,
"last_viewed_at": "2026-06-02T21:03:17.897587+00:00",
"created_at": "2026-06-01T20:56:39.144222+00:00",
"state": "active",
"pinned": false
},
"jolt-bootstrap": { "jolt-bootstrap": {
"created_by": "agent", "created_by": "agent",
"use_count": 9, "use_count": 9,
@ -34,15 +44,5 @@
"created_at": "2026-06-01T21:49:51.101718+00:00", "created_at": "2026-06-01T21:49:51.101718+00:00",
"state": "active", "state": "active",
"pinned": false "pinned": false
},
"jpm-build": {
"created_by": "agent",
"use_count": 0,
"view_count": 15,
"patch_count": 0,
"last_viewed_at": "2026-06-02T21:03:17.897587+00:00",
"created_at": "2026-06-01T20:56:39.144222+00:00",
"state": "active",
"pinned": false
} }
} }

View file

@ -113,12 +113,28 @@ Note: `def` IS handled by the compiler (compiles to Janet `def`, since macros ar
## eval-string dispatch (compile mode) ## eval-string dispatch (compile mode)
```janet When `:compile?` is true, everything goes through the compiler EXCEPT stateful forms. Phase 0 fix: bare symbols and tuples also go through compile path (not just arrays).
(if (or (= head-name "defmacro") (= head-name "ns")
(= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod") Stateful forms (always use interpreter):
(= head-name "require") (= head-name "in-ns")) `defmacro`, `ns`, `deftype`, `defmulti`, `defmethod`, `require`, `in-ns`, `syntax-quote`, `set!`, `var`, `.`, `new`
(eval-form ctx @{} form) ; interpret
(compile-and-eval form ctx)) ; compile Note: `def` is handled by the compiler — macros like `defn` expand to `(def name (fn* ...))` and `def` emits Janet `def`.
## compile-and-eval def/defn interning
`compile-and-eval` interns `def`/`defn`/`defn-` results in the Jolt namespace via `ns-intern` so the interpreter can resolve bare symbols later. Without this, `(defn foo [x] x)` creates the Janet global but `foo` as a bare symbol can't be found by the interpreter.
## Quote in data-structure emitter
Don't re-analyze quoted forms. Use `raw-form->janet` to pass Jolt reader forms through verbatim to Janet's `quote`. raw-form->janet now handles namespace-qualified symbols: `{:ns "foo" :name "bar"}``foo/bar` Janet symbol.
## Remaining ops (interpreter only)
`syntax-quote`, `set!`, `deftype`, `defmulti`, `defmethod`, `var`, `.`, `new` — these are stateful or complex and always use the interpreter path even in compile mode.
## Binding macro (Phase 1)
`core-binding` macro generates `(let [frame {var1 var1-obj var2 var2-obj ...}] (push-thread-bindings frame) (try (do body...) (finally (pop-thread-bindings))))`. Call forms inside the macro expansion MUST use `@[...]` arrays, not tuples — the evaluator treats tuples as literal vectors.
## Adding a new op ## Adding a new op
@ -129,9 +145,15 @@ Note: `def` IS handled by the compiler (compiles to Janet `def`, since macros ar
5. Add `core-fn-values` entry (Janet string name → actual fn value) 5. Add `core-fn-values` entry (Janet string name → actual fn value)
6. Add tests in `test/compiler-test.janet` 6. Add tests in `test/compiler-test.janet`
## Phase 1: Var/Namespace system
- `types.janet`: `all-ns`, `remove-ns`, `create-ns`, `the-ns`, `ns-interns`, `ns-aliases`, `ns-imports-fn`
- `core.janet`: `core-binding` macro + `core-push-thread-bindings`/`core-pop-thread-bindings`
- `evaluator.janet`: ns accessor special forms, ns form extended with `:require`/`:refer`, `:use`, `:refer-clojure`/`:exclude`, `:import` clauses
## Test files ## Test files
- `test/compiler-test.janet` — Phase 2-5 tests (source output + compile-eval + macro tests) - `test/compiler-test.janet` — Phase 2-5 + Phase 0-1 tests (source output + compile-eval + macro + ns + defn tests)
- `test/phase6-final.janet` — Phase 6 comprehensive compile-mode tests (47 assertions) - `test/phase6-final.janet` — Phase 6 comprehensive compile-mode tests (47 assertions)
Run: `janet test/compiler-test.janet` or `janet test/phase6-final.janet` or `jpm test` Run: `janet test/compiler-test.janet` or `janet test/phase6-final.janet` or `jpm test`

View file

@ -2,6 +2,7 @@
# Clojure-compatible core functions for the Jolt interpreter. # Clojure-compatible core functions for the Jolt interpreter.
(use ./types) (use ./types)
(use ./phm)
# ============================================================ # ============================================================
# Predicates # Predicates
@ -16,7 +17,7 @@
(defn core-keyword? [x] (keyword? x)) (defn core-keyword? [x] (keyword? x))
(defn core-symbol? [x] (and (struct? x) (= :symbol (x :jolt/type)))) (defn core-symbol? [x] (and (struct? x) (= :symbol (x :jolt/type))))
(defn core-vector? [x] (tuple? x)) (defn core-vector? [x] (tuple? x))
(defn core-map? [x] (struct? x)) (defn core-map? [x] (or (phm? x) (struct? x)))
(defn core-seq? [x] (or (array? x) (tuple? x))) (defn core-seq? [x] (or (array? x) (tuple? x)))
(defn core-coll? [x] (or (array? x) (tuple? x) (struct? x))) (defn core-coll? [x] (or (array? x) (tuple? x) (struct? x)))
@ -32,8 +33,9 @@
(defn core-empty? [coll] (defn core-empty? [coll]
(if (nil? coll) true (if (nil? coll) true
(if (phm? coll) (= 0 (coll :cnt))
(if (struct? coll) (= 0 (length (keys coll))) (if (struct? coll) (= 0 (length (keys coll)))
(= 0 (length coll))))) (= 0 (length coll))))))
(defn core-every? [pred coll] (defn core-every? [pred coll]
(var result true) (var result true)
@ -80,8 +82,11 @@
(var ok true) (var ok true)
(var i 0) (var i 0)
(while (and ok (< i (dec (length args)))) (while (and ok (< i (dec (length args))))
(if (not (deep= (args i) (args (+ i 1)))) (let [a (args i) b (args (+ i 1))]
(set ok false)) (set ok
(if (phm? a)
(deep= (phm-to-struct a) (if (phm? b) (phm-to-struct b) b))
(if (phm? b) (deep= a (phm-to-struct b)) (deep= a b)))))
(++ i)) (++ i))
ok))) ok)))
@ -120,35 +125,28 @@
result)))) result))))
(defn core-assoc [m & kvs] (defn core-assoc [m & kvs]
(var result @{}) (if (phm? m)
(when m (do (var result m) (var i 0) (while (< i (length kvs)) (set result (phm-assoc result (kvs i) (kvs (+ i 1)))) (+= i 2)) result)
(each k (if (struct? m) (keys m) (keys (table ;(pairs m)))) (do (var result @{}) (when m (each k (if (struct? m) (keys m) (keys (table ;(pairs m)))) (put result k (get m k))))
(put result k (get m k)))) (var i 0) (while (< i (length kvs)) (let [k (kvs i) v (kvs (+ i 1))] (put result k v) (+= i 2)))
(var i 0) (if (struct? m) (table/to-struct result) result))))
(while (< i (length kvs))
(let [k (kvs i) v (kvs (+ i 1))]
(put result k v)
(+= i 2)))
(if (struct? m) (table/to-struct result) result))
(defn core-dissoc [m & ks] (defn core-dissoc [m & ks]
(var result @{}) (if (phm? m)
(each k (keys m) (do (var result m) (each k ks (set result (phm-dissoc result k))) result)
(var in-ks false) (do (var result @{}) (each k (keys m) (var in-ks false) (each k2 ks (if (deep= k k2) (do (set in-ks true) (break)))) (if (not in-ks) (put result k (m k))))
(each k2 ks (if (struct? m) (table/to-struct result) result))))
(if (deep= k k2) (do (set in-ks true) (break))))
(if (not in-ks) (put result k (m k))))
(if (struct? m) (table/to-struct result) result))
(defn core-get [m k &opt default] (defn core-get [m k &opt default]
(default default nil) (default default nil)
(if (nil? m) default (if (nil? m) default
(if (phm? m) (phm-get m k default)
(if (or (struct? m) (table? m)) (if (or (struct? m) (table? m))
(let [v (m k)] (let [v (m k)]
(if (nil? v) default v)) (if (nil? v) default v))
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m))) (if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
(in m k) (in m k)
default)))) default)))))
(defn core-get-in [m ks &opt default] (defn core-get-in [m ks &opt default]
(default default nil) (default default nil)
@ -161,13 +159,14 @@
(if (nil? current) default current)) (if (nil? current) default current))
(defn core-contains? [coll key] (defn core-contains? [coll key]
(if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false))
(if (struct? coll) (not (nil? (coll key))) (if (struct? coll) (not (nil? (coll key)))
(if (table? coll) (not (nil? (coll key))) (if (table? coll) (not (nil? (coll key)))
(if (or (tuple? coll) (array? coll)) (if (or (tuple? coll) (array? coll))
(and (number? key) (>= key 0) (< key (length coll))) (and (number? key) (>= key 0) (< key (length coll)))
false)))) false)))))
(def core-count length) (defn core-count [coll] (if (phm? coll) (coll :cnt) (length coll)))
(defn core-first [coll] (defn core-first [coll]
(if (or (nil? coll) (= 0 (length coll))) nil (if (or (nil? coll) (= 0 (length coll))) nil
@ -194,10 +193,11 @@
(defn core-seq [coll] (defn core-seq [coll]
(if (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll)))) (if (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll))))
nil nil
(if (phm? coll) (tuple ;(phm-entries coll))
(if (tuple? coll) (tuple/slice coll) (if (tuple? coll) (tuple/slice coll)
(if (string? coll) (map |(string/from-bytes $) (string/bytes coll)) (if (string? coll) (map |(string/from-bytes $) (string/bytes coll))
(if (struct? coll) (tuple ;(keys coll)) (if (struct? coll) (tuple ;(keys coll))
coll))))) coll))))))
(defn core-vec [coll] (defn core-vec [coll]
(if (tuple? coll) coll (if (tuple? coll) coll
@ -219,24 +219,23 @@
to)))) to))))
(defn core-merge [& maps] (defn core-merge [& maps]
(var result (struct)) (if (phm? (first maps))
(each m maps (do (var result (first maps)) (var mi 1) (while (< mi (length maps)) (let [m (maps mi)] (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (set result (phm-assoc result k (if (phm? m) (phm-get m k) (m k))))) (++ mi))) result)
(set result (merge result m))) (do (var result (struct)) (each m maps (set result (merge result m))) result)))
result)
(defn core-merge-with [f & maps] (defn core-merge-with [f & maps]
(var result @{}) (if (phm? (first maps))
(each m maps (do (var result (first maps)) (var mi 1) (while (< mi (length maps)) (let [m (maps mi)]
(each k (keys m) (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (let [existing (phm-get result k)
(let [existing (result k)] val (if (phm? m) (phm-get m k) (m k))]
(put result k (if (nil? existing) (m k) (f existing (m k))))))) (set result (phm-assoc result k (if (nil? existing) val (f existing val)))))) (++ mi))) result)
(table/to-struct result)) (do (var result @{}) (each m maps (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (let [existing (result k)] (put result k (if (nil? existing) (m k) (f existing (m k))))))) (table/to-struct result))))
(defn core-keys [m] (defn core-keys [m]
(tuple ;(keys m))) (if (phm? m) (tuple ;(keys (phm-to-struct m))) (tuple ;(keys m))))
(defn core-vals [m] (defn core-vals [m]
(tuple ;(map |(m $) (keys m)))) (if (phm? m) (do (def s (phm-to-struct m)) (tuple ;(map |(s $) (keys s)))) (tuple ;(map |(m $) (keys m)))))
(defn core-select-keys [m ks] (defn core-select-keys [m ks]
(var result @{}) (var result @{})
@ -508,13 +507,7 @@
# ============================================================ # ============================================================
(defn core-vector [& xs] (tuple ;xs)) (defn core-vector [& xs] (tuple ;xs))
(defn core-hash-map [& kvs] (defn core-hash-map [& kvs] (make-phm kvs))
(var result @{})
(var i 0)
(while (< i (length kvs))
(put result (kvs i) (kvs (+ i 1)))
(+= i 2))
(table/to-struct result))
(defn core-array-map [& kvs] (defn core-array-map [& kvs]
(var result @{}) (var result @{})

108
src/jolt/phm.janet Normal file
View file

@ -0,0 +1,108 @@
# PersistentHashMap implementation for Jolt
# Bucket-based hash map with copy-on-write semantics.
(def- bucket-count 8)
(defn phm? [x]
(and (table? x)
(= "jolt.lang.persistent-hash-map.PersistentHashMap" (x :jolt/deftype))))
(defn phm-hash-key [k]
(if (nil? k) 0 (mod (hash k) bucket-count)))
(defn- phm-bucket-find [bucket k]
(var i 0) (var n (length bucket)) (var found nil)
(while (< i n)
(if (= k (in bucket i)) (do (set found (in bucket (+ i 1))) (break)))
(+= i 2))
found)
(defn phm-bucket-contains? [bucket k]
(var i 0) (var n (length bucket)) (var found false)
(while (< i n)
(if (= k (in bucket i)) (do (set found true) (break)))
(+= i 2))
found)
(defn- phm-bucket-assoc [bucket k v]
(var i 0) (var n (length bucket)) (var found-i nil)
(while (< i n)
(if (= k (in bucket i)) (do (set found-i i) (break)))
(+= i 2))
(if (not (nil? found-i))
(let [nb @[]] (var j 0)
(while (< j n) (array/push nb (if (= j (+ found-i 1)) v (in bucket j))) (++ j)) nb)
(let [nb @[]] (var j 0)
(while (< j n) (array/push nb (in bucket j)) (++ j))
(array/push nb k) (array/push nb v) nb)))
(defn- phm-bucket-dissoc [bucket k]
(var i 0) (var n (length bucket)) (var found-i nil)
(while (< i n)
(if (= k (in bucket i)) (do (set found-i i) (break)))
(+= i 2))
(if (nil? found-i) bucket
(if (= n 2) nil
(let [nb @[]] (var j 0)
(while (< j found-i) (array/push nb (in bucket j)) (++ j))
(while (< j (- n 2)) (array/push nb (in bucket (+ j 2))) (++ j)) nb))))
(defn phm-get [m k &opt default]
(default default nil)
(let [bucket (get (m :buckets) (phm-hash-key k))]
(if bucket (let [v (phm-bucket-find bucket k)] (if (nil? v) default v)) default)))
(defn phm-assoc [m k v]
(let [cnt (m :cnt) idx (phm-hash-key k)
old-bucket (get (m :buckets) idx)
had-key (if old-bucket (phm-bucket-contains? old-bucket k) false)
new-bucket (phm-bucket-assoc (if old-bucket old-bucket @[]) k v)
new-cnt (if had-key cnt (+ cnt 1))
new-buckets (array/new bucket-count)]
(var bi 0)
(while (< bi bucket-count)
(put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi))
@{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
:cnt new-cnt :buckets new-buckets :_meta (m :_meta)}))
(defn phm-dissoc [m k]
(let [idx (phm-hash-key k) old-bucket (get (m :buckets) idx)]
(if old-bucket
(let [new-bucket (phm-bucket-dissoc old-bucket k)]
(if (= new-bucket old-bucket) m
(let [new-cnt (- (m :cnt) 1) new-buckets (array/new bucket-count)]
(var bi 0)
(while (< bi bucket-count)
(put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi))
@{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
:cnt new-cnt :buckets new-buckets :_meta (m :_meta)})))
m)))
(defn phm-entries [m]
(var result @[]) (var bi 0)
(while (< bi bucket-count)
(let [bucket (get (m :buckets) bi)]
(when bucket
(var i 0) (var n (length bucket))
(while (< i n) (array/push result [(in bucket i) (in bucket (+ i 1))]) (+= i 2))))
(++ bi))
result)
(defn phm-to-struct [m]
(var result @{}) (var bi 0)
(while (< bi bucket-count)
(let [bucket (get (m :buckets) bi)]
(when bucket
(var i 0) (var n (length bucket))
(while (< i n) (put result (in bucket i) (in bucket (+ i 1))) (+= i 2))))
(++ bi))
(table/to-struct result))
(defn make-phm [&opt kvs]
(default kvs nil)
(var m @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
:cnt 0 :buckets (array/new bucket-count) :_meta nil})
(when kvs
(var i 0) (var n (length kvs))
(while (< i n) (set m (phm-assoc m (kvs i) (kvs (+ i 1)))) (+= i 2)))
m)

View file

@ -250,14 +250,3 @@
(print " passed") (print " passed")
(print "\nAll Phase 1 tests passed!") (print "\nAll Phase 1 tests passed!")
(print "16: binding macro...")
(let [ctx (init)]
(eval-string ctx "(def ^:dynamic *x* 10)")
(assert (= 10 (eval-string ctx "*x*")) "dynamic var default")
(assert (= 99 (eval-string ctx "(binding [*x* 99] *x*)")) "binding rebinds")
(assert (= 10 (eval-string ctx "*x*")) "binding restored"))
(print " passed")
(print "\nAll Phase 1 tests passed!")

75
test/hash-map-test.janet Normal file
View file

@ -0,0 +1,75 @@
# Phase 2: PersistentHashMap Tests
# Uses Clojure = (core-=) for PHM-aware comparison
(use ../src/jolt/api)
(defn ct-eval [ctx s] (eval-string ctx s))
# Helper: compare via Clojure = which handles PHM
(defn clj= [ctx a b]
(eval-string ctx (string "(= " a " " b ")")))
# ============================================================
# 1. Basic hash-map construction and access
# ============================================================
(print "1: hash-map construction...")
(let [ctx (init)]
(def m1 (ct-eval ctx "(hash-map :a 1)"))
(assert (not (nil? m1)) "hash-map returns non-nil")
(assert (= true (ct-eval ctx "(map? (hash-map :a 1))")) "map? returns true for PHM")
(assert (= true (ct-eval ctx "(= (hash-map :a 1) {:a 1})")) "PHM = struct via Clojure =")
(assert (= 0 (ct-eval ctx "(count (hash-map))")) "count empty")
(assert (= 2 (ct-eval ctx "(count (hash-map :a 1 :b 2))")) "count two")
(assert (= 1 (ct-eval ctx "(get (hash-map :a 1 :b 2) :a)")) "get present")
(assert (= nil (ct-eval ctx "(get (hash-map :a 1) :z)")) "get missing"))
(print " passed")
# ============================================================
# 2. assoc and dissoc
# ============================================================
(print "2: assoc/dissoc...")
(let [ctx (init)]
(assert (= true (ct-eval ctx "(= (assoc (hash-map :a 1) :b 2) (hash-map :a 1 :b 2))")) "assoc add")
(assert (= true (ct-eval ctx "(= (assoc (hash-map :a 1) :a 99) (hash-map :a 99))")) "assoc replace")
(assert (= true (ct-eval ctx "(= (dissoc (hash-map :a 1 :b 2) :a) (hash-map :b 2))")) "dissoc")
(assert (= true (ct-eval ctx "(contains? (hash-map :a 1) :a)")) "contains? true")
(assert (= false (ct-eval ctx "(contains? (hash-map :a 1) :z)")) "contains? false"))
(print " passed")
# ============================================================
# 3. keys, vals, merge
# ============================================================
(print "3: keys/vals/merge...")
(let [ctx (init)]
(assert (= 2 (ct-eval ctx "(count (keys (hash-map :a 1 :b 2)))")) "keys count")
(assert (= 2 (ct-eval ctx "(count (vals (hash-map :a 1 :b 2)))")) "vals count")
(assert (= true (ct-eval ctx "(= (merge (hash-map :a 1) (hash-map :b 2)) (hash-map :a 1 :b 2))")) "merge"))
(print " passed")
# ============================================================
# 4. Empty and seq
# ============================================================
(print "4: empty? and seq...")
(let [ctx (init)]
(assert (= true (ct-eval ctx "(empty? (hash-map))")) "empty? true")
(assert (= false (ct-eval ctx "(empty? (hash-map :a 1))")) "empty? false")
(assert (= 1 (ct-eval ctx "(count (seq (hash-map :a 1)))")) "seq count"))
(print " passed")
# ============================================================
# 5. Larger maps
# ============================================================
(print "5: larger maps...")
(let [ctx (init)]
(eval-string ctx "
(def big-map
(reduce (fn [m i] (assoc m (keyword (str \"k\" i)) i))
(hash-map)
(range 100)))")
(assert (= 100 (ct-eval ctx "(count big-map)")) "count 100")
(assert (= 42 (ct-eval ctx "(get big-map :k42)")) "get k42"))
(print " passed")
(print "\nAll PersistentHashMap tests passed!")