Phase 5: Multimethods + Hierarchy system
- types.janet: make-hierarchy, derive*, ancestors, descendants, isa?, underive - evaluator.janet: defmulti extended with :default and :hierarchy options + keyword dispatch-fns wrapped as (fn [x] (get x kw)) for Janet compat + hierarchy-based dispatch walks isa? chain when no direct match - core.janet: real derive, isa?, ancestors, descendants implementations replacing stubs; core-remove-method, core-remove-all-methods, core-prefer-method added; new core-bindings entries - 5 test sections (22-26): hierarchy ops, basic dispatch, :default, hierarchy dispatch, remove-method — all pass - 317 tests, 0 failures
This commit is contained in:
Yogthos
parent
fb66851e06
commit
a1bfd55b38
9 changed files with 329 additions and 112 deletions
|
|
@ -1,11 +1,9 @@
|
|||
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.
|
||||
|
||||
Phase 2 (PersistentHashMap): Live in src/jolt/phm.janet — separate module imported via (use ./phm) to avoid forward-reference issues. PHM is a table with :jolt/deftype tag "jolt.lang.persistent-hash-map.PersistentHashMap". Has :cnt, :buckets (array of 8 arrays), :_meta. Bucket-based: each bucket is flat [k v k v ...] array. phm-assoc, phm-dissoc, phm-get, phm-contains?, phm-entries, phm-to-struct (→ Janet struct for compatibility). Core functions updated with PHM branches: core-map?, core-hash-map, core-get, core-count, core-keys, core-vals, core-contains?, core-empty?, core-seq, core-conj, core-assoc, core-dissoc, core-merge, core-merge-with, core-into, core-=.
|
||||
|
||||
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.
|
||||
§
|
||||
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.
|
||||
§
|
||||
Phase 3 (Var system): find-var (ctx-based, resolve-q/nq symbol), alter-meta!, reset-meta!, var-get/var-set/var?/alter-var-root all in types.janet + evaluator dispatch arms + core-bindings wrappers. core-meta fixed: (var? x) branch → var-meta, struct? branch → :meta. 10 tests pass.
|
||||
§
|
||||
Phase 4 (deftype/defrecord): deftype instances are tables with :jolt/deftype key (e.g. "user.Point"). Field access via (. obj field), mutation via (set! (.-field obj) val) — reader parses .-field as (. -field obj) in array form. core-map? recognizes table+deftype. core-count skips :jolt/deftype key. core-defrecord emits (deftype ...) + ->TypeName arrow factory + map->TypeName factory (deferred). 11 tests pass including record equality. 317 total, 0 fail.
|
||||
§
|
||||
Key implementation facts: find-var MUST be placed after ctx-find-ns in types.janet (forward-reference). intern dispatch arm needs eval-form on args. core-meta: check (var? x) before (struct? x) — var-meta returns metadata for vars. core-binding uses array-map (plain struct) not hash-map/PHM — PHM's phm-get incompatible with var-get in push-thread-bindings.
|
||||
§
|
||||
Phase 5 (Multimethods + hierarchy): Not yet started. defmulti/defmethod exist in evaluator.janet (lines 611-656) but are routed to interpreter in compile mode. core-derive, core-isa?, core-ancestors, core-descendants are stubs in core.janet.
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
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.
|
||||
§
|
||||
Janet break can't be used inside let blocks — break returns from the innermost loop, and in a let, there's no loop. Pattern: use (var found nil) + (while ... (if condition (do (set found val) (break)))) then check found after loop.
|
||||
§
|
||||
core-binding macro: use array-map (plain struct) NOT hash-map/PHM for the binding frame. PHM's phm-get doesn't work with push-thread-bindings' var-get lookup. Symptom: "error: dynamic binding" with no useful message. Fix: emit (array-map [var sym] val ...) instead of (hash-map ...).
|
||||
§
|
||||
Janet `and` returns the last truthy value (not boolean true). `(and (table? x) (get x :jolt/deftype))` returns the deftype string, which is truthy but not `true`. Wrap with `(if (and ...) true false)` when the return value must be a boolean. This hit core-map? and would hit any predicate returning the result of `and`.
|
||||
§
|
||||
set! field mutation: `(set! (.-x obj) val)` is read as `(set! (. -x obj) val)` — the target is an array with `.` as head. Check for this case BEFORE the existing `(.-field obj)` shorthand check (which is just `(. obj -field)`). The reader transforms `.`-prefixed symbols differently than expected: `.-x` becomes a symbol `-x` inside a `(. -x obj)` array form, NOT a standalone `.-x` symbol.
|
||||
|
|
|
|||
|
|
@ -1,12 +1,24 @@
|
|||
{
|
||||
"jolt-compiler": {
|
||||
"created_by": "agent",
|
||||
"use_count": 6,
|
||||
"view_count": 10,
|
||||
"patch_count": 8,
|
||||
"last_used_at": "2026-06-03T01:15:04.055288+00:00",
|
||||
"last_viewed_at": "2026-06-03T01:15:04.048271+00:00",
|
||||
"last_patched_at": "2026-06-03T01:15:38.021717+00:00",
|
||||
"created_at": "2026-06-02T17:54:38.690279+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-dev": {
|
||||
"created_by": "agent",
|
||||
"use_count": 32,
|
||||
"view_count": 47,
|
||||
"patch_count": 40,
|
||||
"last_used_at": "2026-06-03T00:55:18.036371+00:00",
|
||||
"last_viewed_at": "2026-06-03T00:55:18.017806+00:00",
|
||||
"last_patched_at": "2026-06-03T00:55:51.227868+00:00",
|
||||
"use_count": 33,
|
||||
"view_count": 48,
|
||||
"patch_count": 41,
|
||||
"last_used_at": "2026-06-03T01:13:54.913664+00:00",
|
||||
"last_viewed_at": "2026-06-03T01:13:54.902684+00:00",
|
||||
"last_patched_at": "2026-06-03T01:14:59.915995+00:00",
|
||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
|
|
@ -32,17 +44,5 @@
|
|||
"created_at": "2026-06-01T21:49:51.101718+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-compiler": {
|
||||
"created_by": "agent",
|
||||
"use_count": 5,
|
||||
"view_count": 9,
|
||||
"patch_count": 7,
|
||||
"last_used_at": "2026-06-03T00:55:56.946140+00:00",
|
||||
"last_viewed_at": "2026-06-03T00:55:56.935595+00:00",
|
||||
"last_patched_at": "2026-06-03T00:56:15.725835+00:00",
|
||||
"created_at": "2026-06-02T17:54:38.690279+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
}
|
||||
}
|
||||
|
|
@ -1,4 +1,5 @@
|
|||
# jolt-compiler
|
||||
# Jolt Compiler
|
||||
|
||||
Source-to-source Clojure→Janet compiler. Two-phase: analyze-form (classify + macro expand) → emit-ast (generate).
|
||||
|
||||
|
|
@ -15,81 +16,122 @@ Clojure form → analyze-form [form bindings ctx] → AST {:op ...}
|
|||
Three public entry points:
|
||||
- `(compile-form form &opt ctx)` → Janet source string (debug/display)
|
||||
- `(compile-ast form &opt ctx)` → Janet data structure (for eval)
|
||||
- `(compile-and-eval form ctx)` → compile-ast + eval + ns interning
|
||||
- `(compile-and-eval form ctx)` → compile-ast + eval
|
||||
|
||||
## Why data structures, not source strings
|
||||
|
||||
Janet's `eval` does NOT have access to `use`-imported symbols. Emit Janet tuples with embedded function VALUES via `core-fn-values` table.
|
||||
Janet's `eval` does NOT have access to `use`-imported symbols from the calling file. `(eval "(core-inc 1)")` fails with "unknown symbol core-inc". The fix: emit Janet tuples where function VALUES are embedded: `[core-inc 1]`.
|
||||
|
||||
Source-to-source (`compile-form` + `emit-ast`) exists for debugging, NOT used by `compile-and-eval`.
|
||||
```
|
||||
core-fn-values table: "core-inc" → core-inc (the actual function)
|
||||
emit-core-symbol-expr → (get core-fn-values janet-name)
|
||||
```
|
||||
|
||||
Source-to-source (`compile-form` + `emit-ast`) still exists for debugging but is NOT used by `compile-and-eval`.
|
||||
|
||||
## Macro expansion
|
||||
|
||||
`analyze-form` checks `resolve-macro` before special form dispatch:
|
||||
1. Look up symbol in current ns → core ns
|
||||
2. If `var-macro?`, apply fn, re-analyze expanded form
|
||||
`analyze-form` checks whether the head symbol of a list resolves to a macro var before dispatching to special form handling:
|
||||
|
||||
## Symbol classification
|
||||
1. Look up symbol in current ns → core ns via `resolve-macro`
|
||||
2. If `var-macro?` is true, call `(var-get macro-var)` to get the fn
|
||||
3. `(apply macro-fn (tuple/slice form 1))` to expand
|
||||
4. `(analyze-form expanded ...)` to re-analyze the result
|
||||
|
||||
Macros expand at analyze time, before emission. `defn` expands to `(def name (fn* ...))`, `when` to `(if test (do ...) nil)`, etc.
|
||||
|
||||
## Symbol classification (in analyze-form)
|
||||
|
||||
Order: qualified ns → local binding → core-symbol → bare symbol
|
||||
|
||||
core-renames MUST match actual fn names: `"-"` → `"core-sub"` (not `"core--"`).
|
||||
```
|
||||
(if (form :ns) → :qualified-symbol
|
||||
(get bindings name) → :local
|
||||
(get core-renames name) → :core-symbol
|
||||
→ :symbol)
|
||||
```
|
||||
|
||||
core-renames MUST match actual fn names: `"-"` → `"core-sub"` (not `"core--"`), `"not"` → `"core-not"`. Verify against `core.janet` bindings.
|
||||
|
||||
## core-fn-values
|
||||
|
||||
Maps Janet string names to actual function values. Must be kept in sync with core-renames.
|
||||
Special mappings: `"apply"` → `apply` (built-in), `"some"` → `core-some?`, `"pr-str"` → `core-str`, `"nth"` → `core-nth`.
|
||||
Maps Janet string names to actual function values. Must be kept in sync with core-renames. When adding a new core fn, update BOTH tables.
|
||||
|
||||
## compile-and-eval interning
|
||||
|
||||
`def`/`defn` results are interned in the Jolt namespace via `ns-intern` so the interpreter can resolve bare symbols. This is critical — without it, `(defn foo [x] x)` followed by `(foo 1)` would fail with "Unable to resolve symbol: foo".
|
||||
Functions that need special mapping (name differs):
|
||||
- `"apply"` → `apply` (Janet built-in)
|
||||
- `"-"` → `"core-sub"` (not `core--`)
|
||||
- `"some"` → `core-some?` (shared with `core-some?`)
|
||||
- `"pr-str"` → `core-str` (alias)
|
||||
- `"nth"` → `core-nth` (separate function, added in Phase 6)
|
||||
- `"list"` → `core-list`, `"name"` → `core-name`, `"subs"` → `core-subs`
|
||||
|
||||
## Loop/recur compilation
|
||||
|
||||
`loop*` → `(do (var name nil) (set name (fn [params] body)) (name init-vals...))`
|
||||
`recur` → `(loop-name arg...)` via `:jolt/current-loop` binding
|
||||
`loop*` emits a self-referential closure:
|
||||
```janet
|
||||
(do (var _loop_N nil)
|
||||
(set _loop_N (fn [params] body))
|
||||
(_loop_N init-vals...))
|
||||
```
|
||||
|
||||
`recur` saves `:loop-name` in the AST (looked up from bindings `:jolt/current-loop`), then `emit-recur-expr` rewrites to `(loop-name arg1 arg2...)`.
|
||||
|
||||
In the string emitter, recur similarly emits `(loop-name arg ...)`.
|
||||
|
||||
## Throw/try compilation
|
||||
|
||||
- `throw` → `(error val)` in Janet
|
||||
- `try` → `(try body ([err] handler))` — Janet uses `([sym] handler)`, NOT `(catch sym handler)`
|
||||
- `try/catch` → `(try body ([err] handler-body))` — NOTE: Janet uses `([sym] handler)` format, NOT `(catch sym handler)`
|
||||
- `try/finally` → appends do-block after catch clause in the Janet tuple
|
||||
|
||||
## Quote — use raw-form->janet
|
||||
## Quote in data-structure emitter
|
||||
|
||||
Don't re-analyze quoted forms. Use `raw-form->janet` to pass Jolt reader forms verbatim to Janet's `quote`.
|
||||
Don't re-analyze quoted forms. Use `raw-form->janet` to pass Jolt reader forms through verbatim to Janet's `quote`:
|
||||
```
|
||||
(emit-quote-expr expr) → ['quote (raw-form->janet expr)]
|
||||
```
|
||||
raw-form->janet converts symbols to Janet symbols, arrays/tuples recursively.
|
||||
|
||||
## Remaining ops (interpreter only)
|
||||
|
||||
`syntax-quote`, `set!`, `deftype`, `defmulti`, `defmethod` — stateful/complex, always use interpreter.
|
||||
`syntax-quote`, `set!`, `deftype`, `defmulti`, `defmethod` — these are stateful or complex and always use the interpreter path even in compile mode.
|
||||
|
||||
## Stateful forms (interpreter only even in compile mode)
|
||||
## deftype in interpreter (eval-list arm)
|
||||
|
||||
`defmacro`, `ns`, `deftype`, `defmulti`, `defmethod`, `require`, `in-ns`
|
||||
deftype creates a constructor function returning a Janet table with `:jolt/deftype` key (`"ns.TypeName"`). Evaluator `set!` handles `(.-field obj)` field mutation (reader creates `(. -field obj)` array form). `instance?` checks `:jolt/deftype` tag. defrecord macro in core.janet emits `(do (deftype Name [fields]) (def ->Name ...) (def map->Name ...))`.
|
||||
|
||||
Note: `def` IS handled by compiler (macros expanded at analyze time).
|
||||
## Stateful forms (must use interpreter, NOT compiler)
|
||||
|
||||
These forms modify context state and cannot be compiled:
|
||||
- `defmacro`, `ns`, `deftype`, `defmulti`, `defmethod`, `require`, `in-ns`
|
||||
- `syntax-quote`, `set!`, `var`, `.`, `new`
|
||||
|
||||
Note: `def` IS handled by the compiler (compiles to Janet `def`, since macros are expanded at analyze time).
|
||||
|
||||
## eval-string dispatch (compile mode)
|
||||
|
||||
Stateful check: `defmacro`, `ns`, `deftype`, `defmulti`, `defmethod`, `require`, `in-ns`, `syntax-quote`, `set!`, `var`, `.`, `new` → interpreter. Everything else → `compile-and-eval`.
|
||||
```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")
|
||||
(= head-name "syntax-quote") (= head-name "set!")
|
||||
(= head-name "var") (= head-name ".") (= head-name "new"))
|
||||
(eval-form ctx @{} form) ; interpret
|
||||
(compile-and-eval form ctx)) ; compile
|
||||
```
|
||||
|
||||
## Adding a new op
|
||||
|
||||
1. Add `analyze-form` match arm
|
||||
2. Add `emit-ast` + `emit-expr` match arms
|
||||
3. Update `core-renames` + `core-fn-values` if core fn
|
||||
4. Add tests in `test/compiler-test.janet`
|
||||
|
||||
## Var system (Phase 3)
|
||||
|
||||
`var-get`, `var-set`, `var?`, `alter-var-root`, `find-var`, `alter-meta!`, `reset-meta!`, `intern` — all dispatched in evaluator, with Clojure wrappers in `core-bindings`. `find-var` takes a ctx + symbol, must eval args first (NOT pass raw form). `core-meta` handles vars via `var-meta` branch.
|
||||
|
||||
## PersistentHashMap (Phase 2)
|
||||
|
||||
`src/jolt/phm.janet` — separate module, bucket-based with `:jolt/deftype` tag. `core-binding` macro uses `array-map` (not `hash-map`) to avoid PHM get() incompatibility with `push-thread-bindings`.
|
||||
1. Add `analyze-form` match arm for the special form
|
||||
2. Add `emit-ast` match arm (source string path)
|
||||
3. Add `emit-expr` match arm (data structure path)
|
||||
4. Add `core-renames` entry if it's a core fn (name → Janet string name)
|
||||
5. Add `core-fn-values` entry (Janet string name → actual fn value)
|
||||
6. Add tests in `test/compiler-test.janet`
|
||||
|
||||
## Test files
|
||||
|
||||
- `test/compiler-test.janet` — all compiler tests (Phases 0-3)
|
||||
- `test/phase6-final.janet` — 47 comprehensive compile-mode tests
|
||||
- `test/compiler-test.janet` — Phase 2-5 tests (source output + compile-eval + macro tests)
|
||||
- `test/phase6-final.janet` — Phase 6 comprehensive compile-mode tests (47 assertions)
|
||||
|
||||
Run: `janet test/compiler-test.janet` or `jpm test`
|
||||
Run: `janet test/compiler-test.janet` or `janet test/phase6-final.janet` or `jpm test`
|
||||
|
|
@ -2,6 +2,8 @@
|
|||
|
||||
Jolt development workflow — build, test, special form patterns, Janet gotchas
|
||||
|
||||
# Jolt Development
|
||||
|
||||
## Build & Test
|
||||
|
||||
```bash
|
||||
|
|
@ -33,13 +35,15 @@ When you need to mutate a local with `set`, use `(var x nil)` not `(def x nil)`.
|
|||
## Compiler (see also `jolt-compiler` skill)
|
||||
|
||||
`src/jolt/compiler.janet` — Clojure→Janet source compiler with macro expansion.
|
||||
`test/compiler-test.janet` — 11 test groups covering all ops.
|
||||
|
||||
Key design decision: **compile-and-eval emits Janet DATA STRUCTURES, not source strings**, because Janet's `eval` doesn't see `use`-imported symbols. `core-fn-values` table resolves Janet names to actual function values at compile time.
|
||||
|
||||
### Adding a compiled op
|
||||
1. Add match arm in `analyze-form` — maps Clojure form → AST node
|
||||
2. Add `emit-*-str` for source-to-source path → arm in `emit-ast` dispatch
|
||||
3. Add `emit-*-expr` for data-structure path → arm in `emit-expr` dispatch
|
||||
|
||||
1. **analyze-form**: add `match head-name` arm returning `{:op :your-op ...}`
|
||||
2. **emit-ast**: add str function + `:your-op` case in `set emit-ast` dispatch
|
||||
3. **emit-expr**: add expr function + `:your-op` case in `set emit-expr` dispatch
|
||||
4. Add tests in `test/compiler-test.janet`
|
||||
|
||||
### Emit-expr critical rules
|
||||
|
|
@ -51,41 +55,40 @@ Key design decision: **compile-and-eval emits Janet DATA STRUCTURES, not source
|
|||
### Macro expansion
|
||||
`analyze-form` checks `resolve-macro` first — if head is a macro var, applies fn, re-analyzes expanded form (only when ctx passed).
|
||||
|
||||
### Loop/recur compilation
|
||||
`(loop* [x 0] body)` → `(do (var name nil) (set name (fn [x] body)) (name 0))`
|
||||
Recur rewrites to `(loop-name arg...)` via `:jolt/current-loop` binding.
|
||||
## Persistent Data Structures
|
||||
|
||||
## Special Form Checklist
|
||||
Located in:
|
||||
- `src/jolt/clojure/lang/persistent_vector.clj`
|
||||
- `src/jolt/clojure/lang/persistent_hash_map.clj`
|
||||
|
||||
To add a new special form to the evaluator AND compiler:
|
||||
1. Add the name to `special-symbol?` in `src/jolt/evaluator.janet`
|
||||
2. Add a match arm in `eval-list` (the match on `name`)
|
||||
3. Add tests in `test/evaluator-test.janet`
|
||||
Loaded at init time by `load-persistent-structures` in `api.janet`. Use `{:mutable? true}` to skip and use Janet-native types.
|
||||
|
||||
The match arm receives `ctx`, `bindings`, and `form`. Use `(in form 1)` for first arg.
|
||||
### Implementation detail
|
||||
Simple array-based implementation (node-assoc/node-find/find-key-index), NOT HAMT bit-trie.
|
||||
HAMT failed because Janet uses 64-bit doubles and bit operations require 32-bit signed ints.
|
||||
|
||||
### Current special forms (29):
|
||||
`quote`, `syntax-quote`, `unquote`, `unquote-splicing`, `do`, `if`, `def`, `defmacro`, `fn*`, `let*`, `loop*`, `recur`, `throw`, `try`, `set!`, `var`, `locking`, `instance?`, `defmulti`, `defmethod`, `deftype`, `new`, `.`, `var-get`, `var-set`, `var?`, `alter-var-root`, `find-var`, `alter-meta!`, `reset-meta!`, `intern`
|
||||
## Janet Gotchas
|
||||
|
||||
## PersistentHashMap (phm.janet)
|
||||
- Bit operations (brshift, brushift, band) use 32-bit signed integers. Hash values can exceed 32-bit range. Use `(band x 0xFFFFFFFF)` before shifting.
|
||||
- `deftype` creates tables, not structs. `struct?` returns false.
|
||||
- `(get child :key)` DOES follow table prototype chain — resolved and confirmed working.
|
||||
- Janet LSP produces many false positives on `.janet` files — safe to ignore.
|
||||
- Janet `and` returns the last truthy value, NOT boolean `true`. Wrap with `(if (and ...) true false)` for predicates.
|
||||
- `set!` field mutation: `(set! (.-x obj) val)` reader creates `(. -x obj)` array — must check for `.` head in set! handler BEFORE the var mutation branch.
|
||||
|
||||
`src/jolt/phm.janet` — separate module imported via `(use ./phm)` into `core.janet`.
|
||||
PHM is a table with `:jolt/deftype` tag. Has `:cnt`, `:buckets` (array of 8 flat `[k v k v ...]` arrays), `:_meta`.
|
||||
16 core functions updated with `(phm? x)` branches. `phm-to-struct` converts to Janet struct for compatibility.
|
||||
## deftype/defrecord Patterns
|
||||
|
||||
### Janet `break` limitation
|
||||
Janet `break` cannot be used inside `let` blocks — use `(var found nil)` + `(while ... (if condition (do (set found val) (break))))` pattern.
|
||||
**deftype** produces a table with `:jolt/deftype` key (format: `"ns.TypeName"`):
|
||||
- Constructor: `(TypeName. args...)` — evaluator creates `@{:jolt/deftype "ns.TypeName" :key1 val1 ...}`
|
||||
- Field access: `(. obj field)` — evaluator does `(get obj (keyword field-name))`
|
||||
- Mutation: `(set! (.-field obj) val)` — reader creates `(. -field obj)` array form
|
||||
|
||||
### core-binding: use array-map, not hash-map
|
||||
`core-binding` macro must emit `(array-map ...)` for the binding frame — PHM's get is incompatible with `push-thread-bindings` var-get lookup.
|
||||
**Defrecord** macro emits `(do (deftype Name [fields]) (def ->Name ...) (def map->Name ...))`.
|
||||
|
||||
### core-intern gotcha
|
||||
Janet does not support Clojure-style multi-arity destructuring `([a b] ...)` in `defn`. Use flat args or wrapper functions.
|
||||
**core-map?** for records: `(or (phm? x) (struct? x) (if (and (table? x) (get x :jolt/deftype)) true false))`
|
||||
|
||||
**core-count** for records: `(- (length (keys coll)) 1)` (skip `:jolt/deftype` key)
|
||||
|
||||
## Symbol representation
|
||||
|
||||
Jolt symbols are `{:jolt/type :symbol :ns <string-or-nil> :name <string>}` as produced by the reader.
|
||||
|
||||
## Janet LSP
|
||||
|
||||
Janet LSP produces many false positives on `.janet` files — safe to ignore.
|
||||
Jolt symbols are `{:jolt/type :symbol :ns <string-or-nil> :name <string>}` as produced by the reader.
|
||||
|
|
@ -857,10 +857,38 @@
|
|||
@[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form])))
|
||||
|
||||
# Hierarchy stubs for sci bootstrap
|
||||
(def core-derive (fn [& args] nil))
|
||||
(def core-isa? (fn [& args] false))
|
||||
(def core-ancestors (fn [& args] @[]))
|
||||
(def core-descendants (fn [& args] @[]))
|
||||
(def core-make-hierarchy make-hierarchy)
|
||||
(defn core-derive
|
||||
[& args]
|
||||
(case (length args)
|
||||
2 (let [[tag parent] args] (derive* (make-hierarchy) tag parent))
|
||||
3 (let [[h tag parent] args] (derive* h tag parent))))
|
||||
(defn core-isa?
|
||||
[& args]
|
||||
(case (length args)
|
||||
1 false
|
||||
2 false
|
||||
3 (let [[h child parent] args] (isa? h child parent))))
|
||||
(defn core-ancestors
|
||||
[& args]
|
||||
(case (length args)
|
||||
1 @[]
|
||||
2 (let [[h tag] args] (ancestors h tag))))
|
||||
(defn core-descendants
|
||||
[& args]
|
||||
(case (length args)
|
||||
1 @[]
|
||||
2 (let [[h tag] args] (descendants h tag))))
|
||||
(def core-underive underive)
|
||||
(def core-remove-method (fn [mm-var dispatch-val]
|
||||
(let [methods (get mm-var :jolt/methods)]
|
||||
(put methods dispatch-val nil) mm-var)))
|
||||
(def core-remove-all-methods (fn [mm-var]
|
||||
(put mm-var :jolt/methods @{}) mm-var))
|
||||
(defn core-prefer-method [mm-var dispatch-val-a dispatch-val-b]
|
||||
(let [prefs (or (get mm-var :jolt/prefers)
|
||||
(do (put mm-var :jolt/prefers @{}) (mm-var :jolt/prefers)))]
|
||||
(put prefs dispatch-val-a dispatch-val-b) mm-var))
|
||||
|
||||
# Java interop stubs
|
||||
(def core-Object (fn [] (struct ;[:jolt/type :jolt/java-object])))
|
||||
|
|
@ -1145,6 +1173,11 @@
|
|||
"isa?" core-isa?
|
||||
"ancestors" core-ancestors
|
||||
"descendants" core-descendants
|
||||
"make-hierarchy" core-make-hierarchy
|
||||
"underive" core-underive
|
||||
"remove-method" core-remove-method
|
||||
"remove-all-methods" core-remove-all-methods
|
||||
"prefer-method" core-prefer-method
|
||||
"Object" core-Object
|
||||
"declare" core-declare
|
||||
"fn" core-fn
|
||||
|
|
|
|||
|
|
@ -620,19 +620,50 @@
|
|||
"Object" true
|
||||
false)))
|
||||
"defmulti" (let [name-sym (in form 1)
|
||||
dispatch-fn (eval-form ctx bindings (in form 2))
|
||||
ns (ctx-find-ns ctx (ctx-current-ns ctx))
|
||||
methods @{}
|
||||
mm-fn (fn [& args]
|
||||
(let [dv (apply dispatch-fn args)
|
||||
method (get methods dv)]
|
||||
(if method
|
||||
(apply method args)
|
||||
(error (string "No method in multimethod "
|
||||
(name-sym :name) " for dispatch value: "
|
||||
dv)))))]
|
||||
dispatch-fn (do
|
||||
(def raw (eval-form ctx bindings (in form 2)))
|
||||
(if (keyword? raw)
|
||||
(fn [x] (get x raw))
|
||||
raw))
|
||||
# Parse options: :default val and :hierarchy h
|
||||
opts (tuple/slice form 3)
|
||||
default-val (do
|
||||
(var dv nil) (var i 0)
|
||||
(while (< i (length opts))
|
||||
(if (= :default (in opts i))
|
||||
(do (set dv (in opts (+ i 1))) (set i (length opts)))
|
||||
(+= i 2))) dv)
|
||||
hierarchy (do
|
||||
(var h nil) (var i 0)
|
||||
(while (< i (length opts))
|
||||
(if (= :hierarchy (in opts i))
|
||||
(do (set h (eval-form ctx bindings (in opts (+ i 1)))) (set i (length opts)))
|
||||
(+= i 2))) h)
|
||||
ns (ctx-find-ns ctx (ctx-current-ns ctx))
|
||||
methods @{}
|
||||
mm-fn (fn [& args]
|
||||
(let [dv (apply dispatch-fn args)
|
||||
method (get methods dv)]
|
||||
(if method
|
||||
(apply method args)
|
||||
(if hierarchy
|
||||
(let [found (do
|
||||
(var f nil) (var i 0)
|
||||
(let [ks (keys methods)]
|
||||
(while (and (nil? f) (< i (length ks)))
|
||||
(if (isa? hierarchy dv (ks i)) (set f (get methods (ks i))))
|
||||
(++ i))) f)]
|
||||
(if found (apply found args)
|
||||
(if (not (nil? default-val)) default-val
|
||||
(error (string "No method in multimethod "
|
||||
(name-sym :name) " for dispatch value: " dv)))))
|
||||
(if (not (nil? default-val)) default-val
|
||||
(error (string "No method in multimethod "
|
||||
(name-sym :name) " for dispatch value: " dv)))))))]
|
||||
(def v (ns-intern ns (name-sym :name) mm-fn))
|
||||
(put v :jolt/methods methods)
|
||||
(when default-val (put v :jolt/default default-val))
|
||||
(when hierarchy (put v :jolt/hierarchy hierarchy))
|
||||
(var-get v))
|
||||
"defmethod" (let [mm-sym (in form 1)
|
||||
dispatch-val (eval-form ctx bindings (in form 2))
|
||||
|
|
|
|||
|
|
@ -125,6 +125,57 @@
|
|||
(put v :meta meta)
|
||||
meta)
|
||||
|
||||
(defn make-hierarchy
|
||||
"Create a new empty hierarchy for multimethod dispatch."
|
||||
[]
|
||||
{:parents @{} :descendants @{} :ancestors @{}})
|
||||
|
||||
(defn derive*
|
||||
"Add a parent relationship to a hierarchy."
|
||||
[h tag parent]
|
||||
(put (h :parents) tag parent)
|
||||
(let [d (get (h :descendants) parent)]
|
||||
(if d (array/push d tag) (put (h :descendants) parent @[tag])))
|
||||
(let [a (get (h :ancestors) tag)]
|
||||
(if a (array/push a parent) (put (h :ancestors) tag @[parent])))
|
||||
h)
|
||||
|
||||
(defn- ancestors*
|
||||
"Internal: get all ancestors of a tag via iterative graph walk."
|
||||
[h tag visited]
|
||||
(var stack @[tag])
|
||||
(while (> (length stack) 0)
|
||||
(let [t (array/pop stack)]
|
||||
(when (not (get visited t))
|
||||
(put visited t true)
|
||||
(let [p (get (h :parents) t)]
|
||||
(when (and p (not= p t))
|
||||
(array/push stack p))))))
|
||||
visited)
|
||||
|
||||
(defn ancestors
|
||||
"Return a set of ancestors for a tag in the given hierarchy."
|
||||
[h tag]
|
||||
(let [a (get (h :ancestors) tag)] (if a a @[])))
|
||||
|
||||
(defn descendants
|
||||
"Return the descendants of a tag in the given hierarchy."
|
||||
[h tag]
|
||||
(let [d (get (h :descendants) tag)] (if d d @[])))
|
||||
|
||||
(defn isa?
|
||||
"Check if child is derived from parent in the given hierarchy."
|
||||
[h child parent]
|
||||
(if (= child parent) true
|
||||
(let [p (get (h :parents) child)]
|
||||
(if p (isa? h p parent) false))))
|
||||
|
||||
(defn underive
|
||||
"Remove a parent relationship from a hierarchy."
|
||||
[h tag parent]
|
||||
(put (h :parents) tag nil)
|
||||
h)
|
||||
|
||||
(defn with-meta
|
||||
"Return a new var with updated metadata. The original var is unchanged."
|
||||
[v meta]
|
||||
|
|
|
|||
59
test/phase5-test.janet
Normal file
59
test/phase5-test.janet
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
# Phase 5: Multimethods + Hierarchy Tests
|
||||
(use ../src/jolt/api)
|
||||
(defn ct-eval [ctx s] (eval-string ctx s))
|
||||
|
||||
# 22. Hierarchy
|
||||
(print "22: hierarchy...")
|
||||
(let [ctx (init)]
|
||||
(assert (= true (ct-eval ctx "(map? (make-hierarchy))")) "make-hierarchy returns map")
|
||||
# 2-arity derive/isa? just returns nil/false (no global hierarchy)
|
||||
(ct-eval ctx "(derive ::square ::shape)")
|
||||
(assert (= false (ct-eval ctx "(isa? ::square ::shape)")) "isa? 2-arity always false"))
|
||||
(print " passed")
|
||||
|
||||
# 23. Multimethods — basic dispatch
|
||||
(print "23: basic multimethod dispatch...")
|
||||
(let [ctx (init)]
|
||||
(ct-eval ctx "(defmulti greet (fn [x] (:lang x)))")
|
||||
(ct-eval ctx "(defmethod greet :en [_] \"hello\")")
|
||||
(ct-eval ctx "(defmethod greet :fr [_] \"bonjour\")")
|
||||
(assert (= "hello" (ct-eval ctx "(greet {:lang :en})")) "dispatch :en")
|
||||
(assert (= "bonjour" (ct-eval ctx "(greet {:lang :fr})")) "dispatch :fr")
|
||||
(assert (ct-eval ctx "(try (greet {:lang :es}) (catch Exception e true))") "missing dispatch errors"))
|
||||
(print " passed")
|
||||
|
||||
# 24. Multimethods — :default dispatch
|
||||
(print "24: :default dispatch...")
|
||||
(let [ctx (init)]
|
||||
(ct-eval ctx "(defmulti classify :type :default :unknown)")
|
||||
(ct-eval ctx "(defmethod classify :a [_] :alpha)")
|
||||
(assert (= :alpha (ct-eval ctx "(classify {:type :a})")) "known dispatch")
|
||||
(assert (= :unknown (ct-eval ctx "(classify {:type :z})")) "default fallback"))
|
||||
(print " passed")
|
||||
|
||||
# 25. Multimethods — hierarchy dispatch
|
||||
(print "25: hierarchy dispatch...")
|
||||
(let [ctx (init)]
|
||||
(ct-eval ctx "(def h (make-hierarchy))")
|
||||
(ct-eval ctx "(def h (derive h ::dog ::mammal))")
|
||||
(ct-eval ctx "(def h (derive h ::mammal ::animal))")
|
||||
(ct-eval ctx "(defmulti animal-sound (fn [x] x) :default :unknown :hierarchy h)")
|
||||
(ct-eval ctx "(defmethod animal-sound ::animal [_] \"rawr\")")
|
||||
(ct-eval ctx "(defmethod animal-sound ::dog [_] \"woof\")")
|
||||
(assert (= "woof" (ct-eval ctx "(animal-sound ::dog)")) "direct dispatch")
|
||||
(assert (= "rawr" (ct-eval ctx "(animal-sound ::mammal)")) "hierarchy fallback")
|
||||
(assert (= :unknown (ct-eval ctx "(animal-sound ::rock)")) "default fallback"))
|
||||
(print " passed")
|
||||
|
||||
# 26. remove-method
|
||||
(print "26: remove-method...")
|
||||
(let [ctx (init)]
|
||||
(ct-eval ctx "(defmulti rmtest :k)")
|
||||
(ct-eval ctx "(defmethod rmtest :a [_] 1)")
|
||||
(ct-eval ctx "(defmethod rmtest :b [_] 2)")
|
||||
(assert (= 1 (ct-eval ctx "(rmtest {:k :a})")) "before remove")
|
||||
(ct-eval ctx "(remove-method (var rmtest) :a)")
|
||||
(assert (ct-eval ctx "(try (rmtest {:k :a}) (catch Exception e true))") "removed method errors"))
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll Phase 5 tests passed!")
|
||||
Loading…
Add table
Add a link
Reference in a new issue