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
parent
c1dde767c8
commit
9c44021e16
8 changed files with 293 additions and 130 deletions
|
|
@ -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.
|
||||
|
||||
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).
|
||||
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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
§
|
||||
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).
|
||||
§
|
||||
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.
|
||||
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.
|
||||
|
|
|
|||
|
|
@ -13,16 +13,26 @@
|
|||
},
|
||||
"jolt-compiler": {
|
||||
"created_by": "agent",
|
||||
"use_count": 2,
|
||||
"view_count": 6,
|
||||
"patch_count": 4,
|
||||
"last_used_at": "2026-06-02T20:37:02.987991+00:00",
|
||||
"last_viewed_at": "2026-06-02T21:03:17.883527+00:00",
|
||||
"last_patched_at": "2026-06-02T20:37:29.530250+00:00",
|
||||
"use_count": 3,
|
||||
"view_count": 7,
|
||||
"patch_count": 6,
|
||||
"last_used_at": "2026-06-02T21:40:37.747767+00:00",
|
||||
"last_viewed_at": "2026-06-02T21:40:37.739522+00:00",
|
||||
"last_patched_at": "2026-06-02T21:40:55.723354+00:00",
|
||||
"created_at": "2026-06-02T17:54:38.690279+00:00",
|
||||
"state": "active",
|
||||
"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": {
|
||||
"created_by": "agent",
|
||||
"use_count": 9,
|
||||
|
|
@ -34,15 +44,5 @@
|
|||
"created_at": "2026-06-01T21:49:51.101718+00:00",
|
||||
"state": "active",
|
||||
"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
|
||||
}
|
||||
}
|
||||
|
|
@ -113,12 +113,28 @@ Note: `def` IS handled by the compiler (compiles to Janet `def`, since macros ar
|
|||
|
||||
## eval-string dispatch (compile mode)
|
||||
|
||||
```janet
|
||||
(if (or (= head-name "defmacro") (= head-name "ns")
|
||||
(= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod")
|
||||
(= head-name "require") (= head-name "in-ns"))
|
||||
(eval-form ctx @{} form) ; interpret
|
||||
(compile-and-eval form ctx)) ; compile
|
||||
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).
|
||||
|
||||
Stateful forms (always use interpreter):
|
||||
`defmacro`, `ns`, `deftype`, `defmulti`, `defmethod`, `require`, `in-ns`, `syntax-quote`, `set!`, `var`, `.`, `new`
|
||||
|
||||
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
|
||||
|
||||
|
|
@ -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)
|
||||
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/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)
|
||||
|
||||
Run: `janet test/compiler-test.janet` or `janet test/phase6-final.janet` or `jpm test`
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
# Clojure-compatible core functions for the Jolt interpreter.
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
|
||||
# ============================================================
|
||||
# Predicates
|
||||
|
|
@ -16,7 +17,7 @@
|
|||
(defn core-keyword? [x] (keyword? x))
|
||||
(defn core-symbol? [x] (and (struct? x) (= :symbol (x :jolt/type))))
|
||||
(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-coll? [x] (or (array? x) (tuple? x) (struct? x)))
|
||||
|
||||
|
|
@ -32,8 +33,9 @@
|
|||
|
||||
(defn core-empty? [coll]
|
||||
(if (nil? coll) true
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll)))))
|
||||
(if (phm? coll) (= 0 (coll :cnt))
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll))))))
|
||||
|
||||
(defn core-every? [pred coll]
|
||||
(var result true)
|
||||
|
|
@ -80,8 +82,11 @@
|
|||
(var ok true)
|
||||
(var i 0)
|
||||
(while (and ok (< i (dec (length args))))
|
||||
(if (not (deep= (args i) (args (+ i 1))))
|
||||
(set ok false))
|
||||
(let [a (args i) b (args (+ i 1))]
|
||||
(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))
|
||||
ok)))
|
||||
|
||||
|
|
@ -120,35 +125,28 @@
|
|||
result))))
|
||||
|
||||
(defn core-assoc [m & kvs]
|
||||
(var result @{})
|
||||
(when m
|
||||
(each k (if (struct? m) (keys m) (keys (table ;(pairs m))))
|
||||
(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)))
|
||||
(if (struct? m) (table/to-struct result) result))
|
||||
(if (phm? 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)
|
||||
(do (var result @{}) (when m (each k (if (struct? m) (keys m) (keys (table ;(pairs m)))) (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)))
|
||||
(if (struct? m) (table/to-struct result) result))))
|
||||
|
||||
(defn core-dissoc [m & ks]
|
||||
(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))))
|
||||
(if (struct? m) (table/to-struct result) result))
|
||||
(if (phm? m)
|
||||
(do (var result m) (each k ks (set result (phm-dissoc result k))) result)
|
||||
(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))))
|
||||
(if (struct? m) (table/to-struct result) result))))
|
||||
|
||||
(defn core-get [m k &opt default]
|
||||
(default default nil)
|
||||
(if (nil? m) default
|
||||
(if (or (struct? m) (table? m))
|
||||
(let [v (m k)]
|
||||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default))))
|
||||
(if (phm? m) (phm-get m k default)
|
||||
(if (or (struct? m) (table? m))
|
||||
(let [v (m k)]
|
||||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default)))))
|
||||
|
||||
(defn core-get-in [m ks &opt default]
|
||||
(default default nil)
|
||||
|
|
@ -161,13 +159,14 @@
|
|||
(if (nil? current) default current))
|
||||
|
||||
(defn core-contains? [coll key]
|
||||
(if (struct? coll) (not (nil? (coll key)))
|
||||
(if (table? coll) (not (nil? (coll key)))
|
||||
(if (or (tuple? coll) (array? coll))
|
||||
(and (number? key) (>= key 0) (< key (length coll)))
|
||||
false))))
|
||||
(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 (table? coll) (not (nil? (coll key)))
|
||||
(if (or (tuple? coll) (array? coll))
|
||||
(and (number? key) (>= key 0) (< key (length coll)))
|
||||
false)))))
|
||||
|
||||
(def core-count length)
|
||||
(defn core-count [coll] (if (phm? coll) (coll :cnt) (length coll)))
|
||||
|
||||
(defn core-first [coll]
|
||||
(if (or (nil? coll) (= 0 (length coll))) nil
|
||||
|
|
@ -194,10 +193,11 @@
|
|||
(defn core-seq [coll]
|
||||
(if (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll))))
|
||||
nil
|
||||
(if (tuple? coll) (tuple/slice coll)
|
||||
(if (string? coll) (map |(string/from-bytes $) (string/bytes coll))
|
||||
(if (struct? coll) (tuple ;(keys coll))
|
||||
coll)))))
|
||||
(if (phm? coll) (tuple ;(phm-entries coll))
|
||||
(if (tuple? coll) (tuple/slice coll)
|
||||
(if (string? coll) (map |(string/from-bytes $) (string/bytes coll))
|
||||
(if (struct? coll) (tuple ;(keys coll))
|
||||
coll))))))
|
||||
|
||||
(defn core-vec [coll]
|
||||
(if (tuple? coll) coll
|
||||
|
|
@ -219,24 +219,23 @@
|
|||
to))))
|
||||
|
||||
(defn core-merge [& maps]
|
||||
(var result (struct))
|
||||
(each m maps
|
||||
(set result (merge result m)))
|
||||
result)
|
||||
(if (phm? (first 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)
|
||||
(do (var result (struct)) (each m maps (set result (merge result m))) result)))
|
||||
|
||||
(defn core-merge-with [f & maps]
|
||||
(var result @{})
|
||||
(each m maps
|
||||
(each k (keys m)
|
||||
(let [existing (result k)]
|
||||
(put result k (if (nil? existing) (m k) (f existing (m k)))))))
|
||||
(table/to-struct result))
|
||||
(if (phm? (first 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)) (let [existing (phm-get result k)
|
||||
val (if (phm? m) (phm-get m k) (m k))]
|
||||
(set result (phm-assoc result k (if (nil? existing) val (f existing val)))))) (++ mi))) 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]
|
||||
(tuple ;(keys m)))
|
||||
(if (phm? m) (tuple ;(keys (phm-to-struct m))) (tuple ;(keys 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]
|
||||
(var result @{})
|
||||
|
|
@ -508,13 +507,7 @@
|
|||
# ============================================================
|
||||
|
||||
(defn core-vector [& xs] (tuple ;xs))
|
||||
(defn core-hash-map [& 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-hash-map [& kvs] (make-phm kvs))
|
||||
|
||||
(defn core-array-map [& kvs]
|
||||
(var result @{})
|
||||
|
|
|
|||
108
src/jolt/phm.janet
Normal file
108
src/jolt/phm.janet
Normal 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)
|
||||
|
|
@ -250,14 +250,3 @@
|
|||
(print " 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
75
test/hash-map-test.janet
Normal 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!")
|
||||
Loading…
Add table
Add a link
Reference in a new issue