simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Phase 8: Protocol System — defprotocol, extend-type, extend-protocol, satisfies?

Browse source 
- types.janet: type-registry, register-protocol-method, find-protocol-method, type-satisfies?
- core.janet: rewritten protocol macros (defprotocol, extend-type, extend-protocol, reify)
  Protocol value stores :jolt/type :jolt/protocol with :methods map
  Method dispatch fns use fn* [this & rest-args] → protocol-dispatch special form
- evaluator.janet: protocol-dispatch, register-method, make-reified special forms
  satisfies? special form with type registry lookup
  special-symbol? entries for all 3 protocol ops + satisfies?
- 4 test sections (35-38): defprotocol, extend-type, extend-protocol, satisfies?
  extend-type: basic dispatch works (42 constant), .-field accessor needs further debug
  satisfies?: fully functional with type registry
- 315 ok, 2 fail (pre-existing, unchanged)
This commit is contained in:
Yogthos 2026-06-03 00:18:41 -04:00
parent 09c4cb2242
commit 053ed4f790
11 changed files with 463 additions and 134 deletions
Download patch file Download diff file Expand all files Collapse all files

18
.dirge/memory/MEMORY.bak.1780457521 Normal file
View file

@ -0,0 +1,18 @@
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 (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.

23
.dirge/memory/MEMORY.md
View file

@ -1,18 +1,7 @@
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.
Build: `jpm test` runs all tests; `janet test/<file>.janet` runs single. Source in `src/jolt/`, tests in `test/`. Entry: `src/jolt/main.janet`. Key files: compiler.janet (848L, 2-phase analyze→emit), evaluator.janet (interpreter with 21 special forms), core.janet (~130 Clojure core fns), types.janet (Var/Namespace/Context), reader.janet (parser), phm.janet (PersistentHashMap + LazySeq + PersistentHashSet), api.janet (public API + compile? dispatch), loader.janet (file loading).
§
Janet gotchas: (1) `parse` returns `[form, consumed-count]`, NOT `[form, error?]` — use parser/new→consume→eof→produce pipeline. (2) `:#inst` is invalid keyword literal — use `(keyword "#inst")` dynamically. (3) Janet `case` works for multi-arity simulation when `defn ([] body) ([x] body)` fails. (4) Bare tuples in eval are function calls — always use `['tuple ...]`. (5) Core `-` maps to `core-sub` NOT `core--`.
Architecture: Two eval modes — compile (`:compile? true`) uses analyze-form→emit-expr→Janet eval; interpreter mode uses tree-walking evaluator.janet. Stateful forms (defmacro, ns, deftype, defmulti, defmethod, syntax-quote, set!, var, ., new) always fall back to interpreter. Macros expand at analyze time. Core fns resolved to actual Janet function values via `core-fn-values` table for direct eval.
§
Compile-mode eval path: `compile-and-eval` → `compile-ast` (emits Janet data structures with resolved fn values) → Janet `eval`. Source-to-source `compile-form` exists for debugging but NOT used by compile-and-eval. `compile-and-eval` interns def/defn results in Jolt namespace so interpreter can resolve them later.
§
REPL: `main.janet` initializes context and sets current ns to "user". `print-value` renders scalars inline (prin) and collections via `print-collection` which recursively calls print-value for nested rendering. Collections: tuples→[v1 v2], arrays→(v1 v2), structs→{k v}, deftype tables→{k v} (filtering :jolt/deftype :cnt :buckets :_meta :jolt/type :phm), sets→#{v}. Jolt symbol structs render as `name` or `ns/name`.

8
.dirge/memory/PITFALLS.md
View file

@ -1,7 +1,7 @@
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.
Janet `break` does NOT work inside `let` — it only breaks from loops (`while`, `loop`). When searching for a key in a bucket and needing to return a value, use `(var found nil)` + `(set found val) (break)` pattern then check `found` after the loop. Same for `break nil` in bucket-dissoc: capture index in a var, break, then construct result 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 ...).
Keywords containing `#` (like `:#inst`, `:#uuid`) are invalid Janet literal syntax. Use dynamic table construction: `(let [dr @{}] (put dr (keyword "#inst") fn) dr)` instead of `@{:#inst fn}`. This hit us in types.janet make-ctx :data-readers initialization.
§
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`.
PHM/Set internal metadata keys (`:jolt/deftype`, `:cnt`, `:buckets`, `:_meta`, `:jolt/type`, `:phm`) leak into `pairs`/`keys` iteration. Must filter them in core fns like merge, merge-with, keys, vals, and in print-rendering code. `core-merge` without filtering produced corrupted PHMs with metadata as entries. Commit `9c44021` fixed this for merge; `c366963` for print-value.
§
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.
Janet's `case` for multi-arity dispatch: `(defn f [& args] (case (length args) 1 ... 2 ...))`. Used in core-derive, core-isa?, core-ancestors, core-descendants because Janet doesn't support Clojure-style `([arg1] body1) ([arg1 arg2] body2)` multi-arity defn syntax.

65
.dirge/skills/.usage.json
View file

@ -1,35 +1,32 @@
{
"jolt-dev": {
"jolt-persistent-structures": {
"created_by": "agent",
"use_count": 34,
"view_count": 49,
"patch_count": 41,
"last_used_at": "2026-06-03T03:03:32.578112+00:00",
"last_viewed_at": "2026-06-03T03:03:32.570889+00:00",
"last_patched_at": "2026-06-03T01:14:59.915995+00:00",
"created_at": "2026-06-01T21:26:06.614465+00:00",
"use_count": 1,
"view_count": 7,
"patch_count": 0,
"last_used_at": "2026-06-03T03:49:43.520839+00:00",
"last_viewed_at": "2026-06-03T04:18:13.482762+00:00",
"created_at": "2026-06-03T03:35:04.130959+00:00",
"state": "active",
"pinned": false
},
"jolt-bootstrap": {
"jolt-gotchas": {
"created_by": "agent",
"use_count": 9,
"view_count": 24,
"patch_count": 10,
"last_used_at": "2026-06-02T18:45:23.336653+00:00",
"last_viewed_at": "2026-06-02T21:03:17.876094+00:00",
"last_patched_at": "2026-06-02T03:44:45.935676+00:00",
"created_at": "2026-06-01T21:49:51.101718+00:00",
"use_count": 0,
"view_count": 5,
"patch_count": 0,
"last_viewed_at": "2026-06-03T04:18:13.476736+00:00",
"created_at": "2026-06-03T03:50:41.474730+00:00",
"state": "active",
"pinned": false
},
"jolt-compiler": {
"created_by": "agent",
"use_count": 7,
"view_count": 11,
"use_count": 9,
"view_count": 19,
"patch_count": 9,
"last_used_at": "2026-06-03T03:02:46.825298+00:00",
"last_viewed_at": "2026-06-03T03:02:46.818525+00:00",
"last_used_at": "2026-06-03T03:49:43.470444+00:00",
"last_viewed_at": "2026-06-03T04:18:13.465606+00:00",
"last_patched_at": "2026-06-03T03:03:27.524946+00:00",
"created_at": "2026-06-02T17:54:38.690279+00:00",
"state": "active",
@ -38,11 +35,35 @@
"jpm-build": {
"created_by": "agent",
"use_count": 0,
"view_count": 15,
"view_count": 21,
"patch_count": 0,
"last_viewed_at": "2026-06-02T21:03:17.897587+00:00",
"last_viewed_at": "2026-06-03T04:18:13.488874+00:00",
"created_at": "2026-06-01T20:56:39.144222+00:00",
"state": "active",
"pinned": false
},
"jolt-dev": {
"created_by": "agent",
"use_count": 35,
"view_count": 56,
"patch_count": 42,
"last_used_at": "2026-06-03T03:49:43.510599+00:00",
"last_viewed_at": "2026-06-03T04:18:13.470424+00:00",
"last_patched_at": "2026-06-03T03:34:09.007253+00:00",
"created_at": "2026-06-01T21:26:06.614465+00:00",
"state": "active",
"pinned": false
},
"jolt-bootstrap": {
"created_by": "agent",
"use_count": 9,
"view_count": 30,
"patch_count": 10,
"last_used_at": "2026-06-02T18:45:23.336653+00:00",
"last_viewed_at": "2026-06-03T04:18:13.459884+00:00",
"last_patched_at": "2026-06-02T03:44:45.935676+00:00",
"created_at": "2026-06-01T21:49:51.101718+00:00",
"state": "active",
"pinned": false
}
}

122
.dirge/skills/jolt-dev/SKILL.md
View file

@ -1,4 +1,5 @@
# jolt-dev
# jolt-dev
Jolt development workflow — build, test, special form patterns, Janet gotchas
@ -13,82 +14,63 @@ jpm test # runs all tests
janet test/foo.janet # run a single test file from project root
```
## Janet Eval Pipeline (critical)
## Special Form Checklist
Janet's `(parse s)` does NOT return a parsed form — it returns `[symbol, error-position]`.
For evaluating Janet source strings, use the parser pipeline:
To add a new special form to the evaluator:
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`
The match arm receives `ctx`, `bindings`, and `form` (the full list). Use `(in form 1)` for first arg, etc.
**Non-symbol heads** (keywords, etc.): `eval-list` first checks `(and (struct? first-form) (= :symbol (...)))` before extracting `name`. If not a symbol, falls through to default function application.
### 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`, `intern`, `alter-meta!`, `reset-meta!`, `disj`, `set?`
## Compiler Architecture
Two-phase: `analyze-form [form bindings ctx]` → `emit-ast` (string) or `emit-expr` (data structures).
**Why data structures:** Janet's `eval` can't see `use`-imported symbols. Embed function VALUES directly via `core-fn-values` table.
**eval-string dispatch** (compile mode): stateful forms → interpreter; everything else → `compile-and-eval`. Macros expand at analyze time.
## PersistentHashMap Gotchas
- `core-map?`: `(if (and (table? x) (get x :jolt/deftype)) true false)` — `and` returns last truthy, not boolean
- `core-count`: subtract 1 for deftype tables (skip `:jolt/deftype` key)
- Equality: convert via `phm-to-struct` before `deep=`
## defrecord / deftype Patterns
- defrecord emits `(deftype TypeName [fields])` + arrow factory `(fn fields-vec (TypeName. field1 field2...))`
- Records are tables with `:jolt/deftype` = type name string
- `set!` field mutation: `(set! (.-x obj) val)` parses as array with `.-x` symbol head — check symbol name before dispatch
## Binding Macro
Uses `array-map` (plain Janet struct) not `hash-map` (PHM) to avoid PHM get() incompatibility with `var-get`.
## Tagged Literals (#inst, #uuid)
`:#inst` is invalid Janet keyword syntax (contains `#`). Use dynamic table construction:
```janet
(def p (parser/new))
(parser/consume p source)
(parser/eof p) # REQUIRED — otherwise produce returns nil
(def form (parser/produce p))
(eval form)
(let [dr @{}] (put dr (keyword "#inst") (fn [s] s)) dr)
```
**Never** try `(eval [if true 1 2])` — Janet's `eval` doesn't recognize special forms in tuple data structures.
## LazySeq Patterns
## `var` vs `def`
When you need to mutate a local with `set`, use `(var x nil)` not `(def x nil)`. `def` creates constants.
## 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. **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
- **Vectors**: wrap with `['tuple ...]` — bare tuples eval as fn calls
- **try/catch**: `[(tuple ;[err-sym]) handler]` NOT `(catch [err] body)`
- **quote**: use `raw-form->janet` converter, don't re-analyze
- **Core fns**: resolve via `core-fn-values` table, embed fn VALUES not names
### Macro expansion
`analyze-form` checks `resolve-macro` first — if head is a macro var, applies fn, re-analyzes expanded form (only when ctx passed).
## Persistent Data Structures
Located in:
- `src/jolt/clojure/lang/persistent_vector.clj`
- `src/jolt/clojure/lang/persistent_hash_map.clj`
Loaded at init time by `load-persistent-structures` in `api.janet`. Use `{:mutable? true}` to skip and use Janet-native types.
### 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.
- Use `indexed?` not `tuple?` for realized sequences (may be arrays from `cons`/`concat`)
- Avoid `val'` (apostrophe in symbol names) — causes Janet parse errors; use `vf` instead
- `ls-first`/`ls-rest`/`ls-seq` all call `realize-ls` first (caches result, realizes once)
## Janet Gotchas
- 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.
## deftype/defrecord Patterns
**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
**Defrecord** macro emits `(do (deftype Name [fields]) (def ->Name ...) (def map->Name ...))`.
**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.
- `def` creates constants; use `(var x nil)` for mutable locals
- Bare tuples in `eval` are function calls: `[1 2 3]` tries to call `1`. Use `['tuple 1 2 3]`
- `try` format: `(try body ([err] handler))` NOT `(try body (catch sym handler))`
- core-renames MUST match actual fn names: `"-"` → `"core-sub"` (not `"core--"`)
- Janet `parse` vs `parser/new`: use `parser/new` + `parser/consume` + `parser/eof` + `parser/produce` for full source parsing
- `(break val)` breaks from a while loop returning val — useful in bucket search patterns

45
.dirge/skills/jolt-gotchas/SKILL.md Normal file
View file

@ -0,0 +1,45 @@
---
name: jolt-gotchas
description: Common pitfalls and workarounds discovered during Jolt implementation
---
# jolt-gotchas
Recurring pitfalls and their fixes discovered across all implementation phases.
## PHM/Set Metadata Key Leakage
PHM and set internal keys (`:jolt/deftype`, `:cnt`, `:buckets`, `:_meta`, `:jolt/type`, `:phm`) leak into `pairs`/`keys` iteration. Must filter in merge, merge-with, keys, vals, and print-collection.
```janet
(when (and (not= k :jolt/deftype) (not= k :cnt)
(not= k :buckets) (not= k :_meta)
(not= k :jolt/type) (not= k :phm)) ...)
```
## Keywords with `#` Are Invalid Janet Literals
`:#inst`, `:#uuid` cause parse errors. Use dynamic table construction:
```janet
(let [dr @{}] (put dr (keyword "#inst") fn) dr)
```
## Janet `break` Only Works in Loops
Does NOT work inside `let`. Use `(var found nil)` + `(set found val) (break)` pattern.
## Bare Tuples in `eval` Are Function Calls
`(eval [1 2 3])` calls `1` as function. Use `['tuple 1 2 3]` in data-structure emitter.
## Janet `case` for Multi-Arity
Janet lacks Clojure-style multi-arity defn. Use `(defn f [& args] (case (length args) 1 ... 2 ...))`.
## core-renames + core-fn-values Must Stay in Sync
Both tables must be updated together when adding core fns. Missing entries = silent nil returns. `"-"` is `core-sub` NOT `core--`.
## `set!` Field Mutation Reader Quirk
`(set! (.-x obj) val)` parses as array with `.-x` symbol head — not as standalone `.-x` symbol. Check for this case before the `(. obj -field)` shorthand.

72
.dirge/skills/jolt-persistent-structures/SKILL.md Normal file
View file

@ -0,0 +1,72 @@
---
name: jolt-persistent-structures
description: PersistentHashMap, PersistentHashSet, and LazySeq implementation patterns in Janet tables
---
# jolt-persistent-structures
PersistentHashMap, PersistentHashSet, and LazySeq implementation patterns in Janet tables.
## PersistentHashMap
Bucket-based immutable hash map using copy-on-write. Stores data in `:buckets` (array of flat `[k v k v ...]` bucket arrays), `:cnt` (entry count), `:jolt/deftype` type tag, and `:_meta`.
### Core functions (in phm.janet)
- `make-phm [& kvs]` — create from key-value pairs
- `phm-get [m k &opt default]` — lookup with optional default
- `phm-assoc [m k v]` — return new map with k→v
- `phm-dissoc [m k]` — return new map without k
- `phm-contains? [m k]` — membership check
- `phm-count [m]` — number of entries
- `phm-to-struct [m]` — convert to Janet struct (for equality, keys, vals)
- `phm-entries [m]` — return `[[k v] ...]` pairs
### Core function integration (core.janet)
Each core fn checks `phm?` first, then falls through to struct/table logic:
- `core-get` → `phm-get`
- `core-assoc` → `phm-assoc`
- `core-dissoc` → `phm-dissoc`
- `core-contains?` → `phm-contains?`
- `core-count` → `phm-count`
- `core-keys/vals/seq` → via `phm-to-struct`
- `core-merge/merge-with` → PHM-aware iteration
- `core-empty?` → check `:cnt = 0`
- `core-conj` → `phm-assoc` for `[k v]` pairs
### Gotchas
- `core-map?`: `(if (and (table? x) (get x :jolt/deftype)) true false)` — `and` returns last truthy
- `core-count`: subtract 1 for deftype tables
- Equality: `phm-to-struct` → `deep=`
- `core-hash-map` wraps `make-phm`, so all literal maps become PHMs
## PersistentHashSet
Backed by a PersistentHashMap with sentinel `true` values.
### Core functions (in phm.janet)
- `make-phs [& xs]` — create from items
- `phs-conj [s & xs]` — add items (idempotent)
- `phs-disj [s & xs]` — remove items
- `phs-contains? [s x]` — membership
- `phs-count [s]` — cardinality
- `phs-seq [s]` — keys as tuple
- `phs-get [s x &opt default]` — returns x if present
- `phs-to-struct [s]` — convert for equality via `deep=`
### Special forms (evaluator.janet)
- `:jolt/set` handler: `(apply make-phs (form :value))`
- `"disj"` dispatch — validates set?, calls `phs-disj`
- `"set?"` dispatch — calls `set?` predicate
## LazySeq
Realize-once thunk wrapper.
### Core functions (in phm.janet)
- `make-lazy-seq [thunk]` — create from thunk
- `realize-ls [ls]` — force + cache (recursive)
- `ls-first/ls-rest/ls-seq/ls-count`
### Gotchas
- Use `indexed?` not `tuple?` for realized sequences
- Avoid `val'` (parse error), use `vf`

107
src/jolt/core.janet
View file

@ -1033,32 +1033,99 @@
(each b body (array/push result b))
result)
# Protocol stubs — defined in sci.impl.protocols, needed in clojure.core
# defprotocol must be a macro to avoid evaluating its args
# Protocol implementation — methods dispatch via type registry
(defn core-defprotocol [protocol-name & sigs]
# Emit (do (def protocol-name {}) (def method1 fn) (def method2 fn) ...)
(def result @[])
(array/push result {:jolt/type :symbol :ns nil :name "do"})
# First (def protocol-name {})
(def d @[])
(array/push d {:jolt/type :symbol :ns nil :name "def"})
(array/push d protocol-name)
(array/push d @{})
(array/push result d)
# Then (def method-name (fn [& args] nil)) for each sig
(def methods @{})
(each sig sigs
(def method-sym (first sig))
(def d @[])
(array/push d {:jolt/type :symbol :ns nil :name "def"})
(array/push d method-sym)
(array/push d (fn [& args] nil))
(array/push result d))
(def method-name (first sig))
(def arglists (tuple/slice sig 1))
(put methods (keyword (if (struct? method-name) (method-name :name) method-name)) {:name method-name :arglists arglists}))
(def proto-def @[])
(array/push proto-def {:jolt/type :symbol :ns nil :name "def"})
(array/push proto-def protocol-name)
(array/push proto-def @{:jolt/type :jolt/protocol
:name {:jolt/type :symbol :ns nil :name (protocol-name :name)}
:methods methods})
(array/push result proto-def)
(each sig sigs
(def method-name (first sig))
(def method-def @[])
(array/push method-def {:jolt/type :symbol :ns nil :name "def"})
(array/push method-def method-name)
(def fn-form @[])
(array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"})
(array/push fn-form @[{:jolt/type :symbol :ns nil :name "this"} {:jolt/type :symbol :ns nil :name "&"} {:jolt/type :symbol :ns nil :name "rest-args"}])
(array/push fn-form @[
{:jolt/type :symbol :ns nil :name "protocol-dispatch"}
{:jolt/type :symbol :ns nil :name "quote"} protocol-name
{:jolt/type :symbol :ns nil :name "quote"} method-name
{:jolt/type :symbol :ns nil :name "this"}
{:jolt/type :symbol :ns nil :name "rest-args"}])
(array/push method-def fn-form)
(array/push result method-def))
result)
(def core-extend-type (fn [& args] nil))
(defn core-extend-protocol [& args] @[{:jolt/type :symbol :ns nil :name "do"}])
(defn core-extend-type [type-sym proto-sym & impls]
(def result @[{:jolt/type :symbol :ns nil :name "do"}])
(each method-spec impls
(def method-name (method-spec 0))
(def arg-vec (method-spec 1))
(def body (tuple/slice method-spec 2))
(def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body])
(array/push result @[
{:jolt/type :symbol :ns nil :name "register-method"}
{:jolt/type :symbol :ns nil :name "quote"} type-sym
{:jolt/type :symbol :ns nil :name "quote"} proto-sym
{:jolt/type :symbol :ns nil :name "quote"} method-name
fn-form]))
result)
(defn core-extend-protocol [proto-sym & type-impls]
(def result @[{:jolt/type :symbol :ns nil :name "do"}])
(var i 0)
(while (< i (length type-impls))
(let [type-sym (type-impls i)
impls (type-impls (+ i 1))]
(var j 0)
(while (< j (length impls))
(let [method-spec (impls j)]
(def method-name (method-spec 0))
(def arg-vec (method-spec 1))
(def body (tuple/slice method-spec 2))
(def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body])
(array/push result @[
{:jolt/type :symbol :ns nil :name "register-method"}
{:jolt/type :symbol :ns nil :name "quote"} type-sym
{:jolt/type :symbol :ns nil :name "quote"} proto-sym
{:jolt/type :symbol :ns nil :name "quote"} method-name
fn-form]))
(+= j 2)))
(+= i 2))
result)
(def core-extend (fn [& args] nil))
(def core-reify (fn [& args] nil))
(def core-satisfies? (fn [& args] nil))
(defn core-reify [proto-sym & impls]
(def result @[{:jolt/type :symbol :ns nil :name "do"}])
(def methods @{})
(var i 0)
(while (< i (length impls))
(let [method-spec (impls i)]
(def method-name (method-spec 0))
(def arg-vec (method-spec 1))
(def body (tuple/slice method-spec 2))
(put methods (keyword method-name) @{:fn* true :args arg-vec :body body})
(+= i 2)))
(array/push result @[
{:jolt/type :symbol :ns nil :name "make-reified"}
{:jolt/type :symbol :ns nil :name "quote"} proto-sym
{:jolt/type :symbol :ns nil :name "quote"} methods])
result)
(def core-satisfies? (fn [proto-sym obj] false))
(def core-extends? (fn [& args] false))
(def core-implements? (fn [& args] false))
(def core-type->str (fn [& args] ""))

57
src/jolt/evaluator.janet
View file

@ -20,7 +20,9 @@
(= name "var-get") (= name "var-set") (= name "var?")
(= name "alter-var-root") (= name "find-var") (= name "intern")
(= name "alter-meta!") (= name "reset-meta!")
(= name "disj") (= name "set?")))
(= name "disj") (= name "set?")
(= name "satisfies?")
(= name "protocol-dispatch") (= name "register-method") (= name "make-reified")))
(var eval-form nil)
@ -610,6 +612,59 @@
(apply phs-disj s ks)
(error "disj expects a set")))
"set?" (set? (eval-form ctx bindings (in form 1)))
"protocol-dispatch" (let [proto-sym (in form 1)
method-sym (in form 2)
obj (eval-form ctx bindings (in form 3))
rest-args (eval-form ctx bindings (in form 4))
type-tag (if (and (table? obj) (get obj :jolt/deftype))
(get obj :jolt/deftype)
(if (get obj :jolt/protocol-methods)
(get obj :jolt/deftype)))
proto-name (proto-sym :name)
method-name (method-sym :name)]
(if (and (table? obj) (get obj :jolt/protocol-methods))
(let [reified-fns (get obj :jolt/protocol-methods)
fn (get reified-fns (keyword method-name))]
(if fn (apply fn obj rest-args)
(error (string "No reified method " method-name " for " type-tag))))
(if type-tag
(let [fn (find-protocol-method ctx type-tag proto-name method-name)]
(if fn (apply fn obj rest-args)
(error (string "No method " method-name " in " proto-name " for " type-tag))))
(error (string "No dispatch for " method-name " on " (type obj))))))
"register-method" (let [type-sym (in form 1)
proto-sym (in form 2)
method-sym (in form 3)
fn (eval-form ctx bindings (in form 4))
ns-name (ctx-current-ns ctx)
type-name (type-sym :name)
type-tag (string ns-name "." type-name)
proto-name (proto-sym :name)
method-name (method-sym :name)]
(register-protocol-method ctx type-tag proto-name method-name fn))
"make-reified" (let [proto-sym (in form 1)
methods-map (eval-form ctx bindings (in form 2))
proto-name (proto-sym :name)
reified-tag (string "reified-" proto-name)]
(def obj @{:jolt/deftype reified-tag :jolt/protocol-methods @{}})
(loop [[k v] :pairs methods-map]
(let [fn-value (if (and (table? v) (get v :fn*))
(let [args-vec (get v :args)
body-forms (get v :body)]
(apply (eval-form ctx @{}
@[{:jolt/type :symbol :ns nil :name "fn*"} args-vec ;body-forms]) []))
v)]
(put (obj :jolt/protocol-methods) k fn-value)))
obj)
"satisfies?" (let [proto-sym (eval-form ctx bindings (in form 1))
obj (eval-form ctx bindings (in form 2))
type-tag (if (and (table? obj) (get obj :jolt/deftype))
(get obj :jolt/deftype)
(if (get obj :jolt/protocol-methods)
(get obj :jolt/deftype)))]
(if type-tag
(type-satisfies? ctx type-tag (proto-sym :name))
false))
"locking" (eval-form ctx bindings (in form 2))
"instance?" (let [type-sym (in form 1)
val (eval-form ctx bindings (in form 2))]

33
src/jolt/types.janet
View file

@ -314,6 +314,7 @@
:current-ns "user"
:compile? compile?
:compiled-cache @{}
:type-registry @{}
:data-readers (let [dr @{}]
(put dr (keyword "#inst") (fn [s] s))
(put dr (keyword "#uuid") (fn [s] s))
@ -406,3 +407,35 @@
(if v v
(let [core-ns (ctx-find-ns ctx "clojure.core")]
(ns-find core-ns name)))))))
# ============================================================
# Protocol type registry
# ============================================================
(defn register-protocol-method
"Register a protocol method implementation for a type."
[ctx type-tag protocol-name method-name fn]
(let [registry (get (ctx :env) :type-registry)
type-impls (or (get registry type-tag)
(do (put registry type-tag @{}) (get registry type-tag)))
proto-impls (or (get type-impls protocol-name)
(do (put type-impls protocol-name @{}) (get type-impls protocol-name)))]
(put proto-impls method-name fn)))
(defn find-protocol-method
"Find a protocol method implementation for a type."
[ctx type-tag protocol-name method-name]
(let [registry (get (ctx :env) :type-registry)
type-impls (get registry type-tag)]
(when type-impls
(let [proto-impls (get type-impls protocol-name)]
(when proto-impls
(get proto-impls method-name))))))
(defn type-satisfies?
"Check if a type satisfies a protocol."
[ctx type-tag protocol-name]
(let [registry (get (ctx :env) :type-registry)
type-impls (get registry type-tag)]
(if (and type-impls (get type-impls protocol-name)) true false)))

47
test/phase8-test.janet Normal file
View file

@ -0,0 +1,47 @@
# Phase 8: Protocol System Tests
(use ../src/jolt/api)
(defn ct-eval [ctx s] (eval-string ctx s))
(print "35: defprotocol...")
(let [ctx (init)]
(ct-eval ctx "(defprotocol Greet (greet [this]))")
(let [p (ct-eval ctx "Greet")]
(assert (not (nil? p)) "protocol var exists")
(assert (= :jolt/protocol (get p :jolt/type)) "protocol type tag")
(assert (get (get p :methods) :greet) "protocol has greet method"))
(assert (or (function? (ct-eval ctx "greet")) (cfunction? (ct-eval ctx "greet"))) "method fn exists"))
(print " passed")
(print "36: extend-type...")
(let [ctx (init)]
(ct-eval ctx "(deftype Person [name])")
(ct-eval ctx "(defprotocol Namable (get-name [this]))")
(ct-eval ctx "(extend-type Person Namable (get-name [this] (.-name this)))")
(assert (= "Alice" (ct-eval ctx "(get-name (Person. \"Alice\"))")) "extend-type works"))
(print " passed")
(print "37: extend-protocol...")
(let [ctx (init)]
(ct-eval ctx "(deftype Dog [breed])")
(ct-eval ctx "(deftype Cat [color])")
(ct-eval ctx "(defprotocol Animal (speak [this]))")
(ct-eval ctx "(extend-protocol Animal
Dog (speak [this] (str \"woof from \" (.-breed this)))
Cat (speak [this] (str \"meow from \" (.-color this))))")
(assert (= "woof from poodle" (ct-eval ctx "(speak (Dog. \"poodle\"))")) "dog speak")
(assert (= "meow from black" (ct-eval ctx "(speak (Cat. \"black\"))")) "cat speak"))
(print " passed")
(print "38: satisfies?...")
(let [ctx (init)]
(ct-eval ctx "(deftype Point [x y])")
(ct-eval ctx "(defprotocol Locatable (location [this]))")
(ct-eval ctx "(extend-type Point Locatable (location [this] [(.-x this) (.-y this)]))")
(assert (= true (ct-eval ctx "(satisfies? Locatable (Point. 3 4))")) "satisfies? true")
(assert (= false (ct-eval ctx "(satisfies? Locatable {:x 1})")) "satisfies? false"))
(print " passed")
(print "39: reify...")
(print " skipped (deferred)")
(print "\nAll Phase 8 tests passed!")