Compiler research (#10)

adds self-hosted compiler is functionally:
 
- The default compile path is the portable pipeline using jolt.analyzer (Clojure) → host-neutral IR → backend.janet.
- The analyzer is itself Clojure, compiled by jolt for true self-hosting.
- bootstrap-fixpoint passes (stage1 == stage2 == stage3): rebuilding the compiler on its own output.
- clojure.core is now self-hosted in the overlay.
- Stateful forms (defmacro/ns/deftype/defmulti/require/in-ns) are interpreted by design.
This commit is contained in:
Dmitri Sotnikov 2026-06-09 07:30:25 +08:00 committed by GitHub
parent 607779866e
commit d3194aae59
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
68 changed files with 6590 additions and 2019 deletions

BIN
.DS_Store vendored Normal file

Binary file not shown.

43
.calva/repl.calva-repl Normal file
View file

@ -0,0 +1,43 @@
(when-let [requires (resolve 'clojure.main/repl-requires)] (clojure.core/apply clojure.core/require @requires))
cljuser> 
(defn read
[reader]
(let [line ((get (dyn :current-env) (symbol "file/read")) reader :line)]
(when line
(read-string line))))
cljuser> 
(defn foo [])
cljuser> 
(foo)
cljuser> 
(defn foo [x]
(into (range 10) [x]))
cljuser> 
(foo)
; expected integer key for tuple in range [0, 0), got 0
cljuser> 
(foo 10)
cljuser> 
(foo "a")
cljuser> 
(foo :a)
cljuser> 
(sh "ls")
; Unable to resolve symbol: sh
cljuser> 
(jolt/sh "ls")
; Unable to resolve symbol: jolt/sh
cljuser> 
(defn sh
[& args]
(let [cmd (apply str (interpose " " args))
result (os/shell cmd)]
{:exit (result 0) :out (result 1) :err (result 2)}))
cljuser> 
(defn shell
[& args]
(:out (apply sh args)))
cljuser> 
(sh "ls")
; Unable to resolve symbol: os/shell
cljuser> 

View file

@ -10,10 +10,17 @@ jobs:
runs-on: ubuntu-latest
env:
JANET_VERSION: v1.41.2 # bump to match the version Jolt is developed against
# Per-file deadline for the clojure-test-suite battery. Finite files finish
# in well under 1s; the genuinely-infinite ones get killed at any deadline.
# A generous value gives slow CI runners headroom so a sub-second file
# spiking doesn't time out and drop total-pass below the baseline.
JOLT_SUITE_TIMEOUT: "20"
steps:
- uses: actions/checkout@v4
with:
# vendor/sci is needed by the SCI bootstrap/runtime integration tests.
# Submodules: vendor/sci (SCI bootstrap/runtime tests) and
# vendor/clojure-test-suite (the cross-dialect conformance battery,
# asserted against a baseline by clojure-test-suite-test.janet).
submodules: recursive
- name: Cache Janet build

3
.gitmodules vendored
View file

@ -1,3 +1,6 @@
[submodule "vendor/sci"]
path = vendor/sci
url = https://github.com/borkdude/sci.git
[submodule "vendor/clojure-test-suite"]
path = vendor/clojure-test-suite
url = https://github.com/jank-lang/clojure-test-suite.git

96
AGENTS.md Normal file
View file

@ -0,0 +1,96 @@
# Agent Instructions
This project uses **bd** (beads) for issue tracking. Run `bd prime` for full workflow context.
> **Architecture in one line:** Issues live in a local Dolt database
> (`.beads/dolt/`); cross-machine sync uses `bd dolt push/pull` (a
> git-compatible protocol), stored under `refs/dolt/data` on your git
> remote — separate from `refs/heads/*` where your code lives.
> `.beads/issues.jsonl` is a passive export, not the wire protocol.
>
> See [SYNC_CONCEPTS.md](https://github.com/gastownhall/beads/blob/main/docs/SYNC_CONCEPTS.md)
> for the one-screen overview and anti-patterns (don't treat JSONL as the
> source of truth; don't `bd import` during normal operation; don't
> reach for third-party Dolt hosting before trying the default).
## Quick Reference
```bash
bd ready # Find available work
bd show <id> # View issue details
bd update <id> --claim # Claim work atomically
bd close <id> # Complete work
bd dolt push # Push beads data to remote
```
## Non-Interactive Shell Commands
**ALWAYS use non-interactive flags** with file operations to avoid hanging on confirmation prompts.
Shell commands like `cp`, `mv`, and `rm` may be aliased to include `-i` (interactive) mode on some systems, causing the agent to hang indefinitely waiting for y/n input.
**Use these forms instead:**
```bash
# Force overwrite without prompting
cp -f source dest # NOT: cp source dest
mv -f source dest # NOT: mv source dest
rm -f file # NOT: rm file
# For recursive operations
rm -rf directory # NOT: rm -r directory
cp -rf source dest # NOT: cp -r source dest
```
**Other commands that may prompt:**
- `scp` - use `-o BatchMode=yes` for non-interactive
- `ssh` - use `-o BatchMode=yes` to fail instead of prompting
- `apt-get` - use `-y` flag
- `brew` - use `HOMEBREW_NO_AUTO_UPDATE=1` env var
<!-- BEGIN BEADS INTEGRATION v:1 profile:minimal hash:7510c1e2 -->
## Beads Issue Tracker
This project uses **bd (beads)** for issue tracking. Run `bd prime` to see full workflow context and commands.
### Quick Reference
```bash
bd ready # Find available work
bd show <id> # View issue details
bd update <id> --claim # Claim work
bd close <id> # Complete work
```
### Rules
- Use `bd` for ALL task tracking — do NOT use TodoWrite, TaskCreate, or markdown TODO lists
- Run `bd prime` for detailed command reference and session close protocol
- Use `bd remember` for persistent knowledge — do NOT use MEMORY.md files
**Architecture in one line:** issues live in a local Dolt DB; sync uses `refs/dolt/data` on your git remote; `.beads/issues.jsonl` is a passive export. See https://github.com/gastownhall/beads/blob/main/docs/SYNC_CONCEPTS.md for details and anti-patterns.
## Session Completion
**When ending a work session**, you MUST complete ALL steps below. Work is NOT complete until `git push` succeeds.
**MANDATORY WORKFLOW:**
1. **File issues for remaining work** - Create issues for anything that needs follow-up
2. **Run quality gates** (if code changed) - Tests, linters, builds
3. **Update issue status** - Close finished work, update in-progress items
4. **PUSH TO REMOTE** - This is MANDATORY:
```bash
git pull --rebase
git push
git status # MUST show "up to date with origin"
```
5. **Clean up** - Clear stashes, prune remote branches
6. **Verify** - All changes committed AND pushed
7. **Hand off** - Provide context for next session
**CRITICAL RULES:**
- Work is NOT complete until `git push` succeeds
- NEVER stop before pushing - that leaves work stranded locally
- NEVER say "ready to push when you are" - YOU must push
- If push fails, resolve and retry until it succeeds
<!-- END BEADS INTEGRATION -->

70
CLAUDE.md Normal file
View file

@ -0,0 +1,70 @@
# Project Instructions for AI Agents
This file provides instructions and context for AI coding agents working on this project.
<!-- BEGIN BEADS INTEGRATION v:1 profile:minimal hash:7510c1e2 -->
## Beads Issue Tracker
This project uses **bd (beads)** for issue tracking. Run `bd prime` to see full workflow context and commands.
### Quick Reference
```bash
bd ready # Find available work
bd show <id> # View issue details
bd update <id> --claim # Claim work
bd close <id> # Complete work
```
### Rules
- Use `bd` for ALL task tracking — do NOT use TodoWrite, TaskCreate, or markdown TODO lists
- Run `bd prime` for detailed command reference and session close protocol
- Use `bd remember` for persistent knowledge — do NOT use MEMORY.md files
**Architecture in one line:** issues live in a local Dolt DB; sync uses `refs/dolt/data` on your git remote; `.beads/issues.jsonl` is a passive export. See https://github.com/gastownhall/beads/blob/main/docs/SYNC_CONCEPTS.md for details and anti-patterns.
## Session Completion
**When ending a work session**, you MUST complete ALL steps below. Work is NOT complete until `git push` succeeds.
**MANDATORY WORKFLOW:**
1. **File issues for remaining work** - Create issues for anything that needs follow-up
2. **Run quality gates** (if code changed) - Tests, linters, builds
3. **Update issue status** - Close finished work, update in-progress items
4. **PUSH TO REMOTE** - This is MANDATORY:
```bash
git pull --rebase
git push
git status # MUST show "up to date with origin"
```
5. **Clean up** - Clear stashes, prune remote branches
6. **Verify** - All changes committed AND pushed
7. **Hand off** - Provide context for next session
**CRITICAL RULES:**
- Work is NOT complete until `git push` succeeds
- NEVER stop before pushing - that leaves work stranded locally
- NEVER say "ready to push when you are" - YOU must push
- If push fails, resolve and retry until it succeeds
<!-- END BEADS INTEGRATION -->
## Build & Test
_Add your build and test commands here_
```bash
# Example:
# npm install
# npm test
```
## Architecture Overview
_Add a brief overview of your project architecture_
## Conventions & Patterns
_Add your project-specific conventions here_

223
HANDOFF.md Normal file
View file

@ -0,0 +1,223 @@
# Jolt — Self-Hosted Clojure on Janet · Handoff
Onboarding for a fresh agent picking up this work. Read this, then
`bd prime` and `bd memories` for the live issue/knowledge state.
---
## 1. What this project is
**Jolt** is a Clojure implementation written in [Janet](https://janet-lang.org).
It has two execution paths and a **self-hosting compiler**:
- **Interpreter**`src/jolt/evaluator.janet`. A tree-walking evaluator over
reader forms. Always correct; the fallback for anything the compiler can't yet
handle. The *live path* for stateful/context-modifying forms.
- **Self-hosted compiler** — the portable front end lives in **Clojure** under
`jolt-core/jolt/` (`analyzer.clj` reader-form → host-neutral IR `ir.clj`), and a
**Janet back end** (`src/jolt/backend.janet`) emits Janet from that IR. This is
the default compile path. It is *self-hosted*: the compiler that compiles
clojure.core is itself (mostly) Clojure compiled by jolt.
- **Bootstrap compiler**`src/jolt/compiler.janet`. A Janet-native compiler used
**only** to bootstrap-compile the kernel tier before the self-hosted analyzer
exists. Not the main path.
- **Hybrid fallback** — the analyzer throws `:jolt/uncompilable` on forms it can't
handle; the loader catches that and interprets instead. Three "uncompilable"
lists are kept in sync (see compile-pipeline notes in the code).
Entry point: `src/jolt/api.janet``(init opts)` builds a context, installs the
host contract, and loads clojure.core (seed + overlay). `:compile? true` enables
the self-hosted pipeline; off = interpret.
---
## 2. The architecture that matters: seed + overlay
clojure.core is split into a shrinking **Janet seed** and a growing **Clojure
overlay**. This split *is* the project's main arc.
### The Janet seed — `src/jolt/core.janet` (~3200 lines, ~365 `core-*` fns)
The irreducible base: the `core-renames` primitives the compiler emits directly
(`first`/`nth`/`conj`/`get`/…) plus genuinely host-coupled fns (atoms, vars,
transients, arrays, futures, meta, print, the persistent-collection kernel). Each
fn is `core-<name>` and interned into the `clojure.core` namespace via the
`core-bindings` table near the bottom of the file.
### The Clojure overlay — `jolt-core/clojure/core/NN-*.clj` (loaded in order)
Plain Clojure expressing the *rest* of clojure.core on top of the seed. Tiers:
| Tier | Role |
|---|---|
| `00-syntax.clj` | control macros (`when`/`cond`/`and`/`or`/`let`/`loop`/`fn`/`for`/…), `destructure`, `when-let`. Interpreted, loaded **first** so macros exist before any code compiles. |
| `00-kernel.clj` | structural fns the analyzer itself needs (`second`/`peek`/`subvec`/`mapv`/`update`). **Bootstrap-compiled** into clojure.core before the analyzer is built. |
| `10-seq.clj` | seq-tier fns |
| `20-coll.clj` | pure collection/misc fns + the Phase-4 host-primitive wrappers |
| `30-macros.clj` | the remaining user-facing macros |
| `40-lazy.clj` | lazy seq transformers (Phase 5) |
Loader: `api.janet``load-core-overlay!` / `core-tiers`. Sources are read **fresh
from disk** at startup when running from the repo (`stdlib_embed.janet` collects
`jolt-core/` and `src/jolt/clojure/`), so editing a `.clj` tier takes effect with
no rebuild. (A `jpm build` bakes them into the image; that can go stale — tests
run from source.)
### The host contract — `src/jolt/host_iface.janet` (ns `jolt.host`)
The portability seam. jolt-core (analyzer/IR/overlay) calls **only** `jolt.host`
fns, never Janet directly. Originally compiler-facing (`form-sym?`, `form-list?`,
`resolve-global`, …). Phase 4 added the first runtime primitive: **`ref-put!`**
(set/remove a key on a mutable reference cell) — the minimal mutation kernel the
overlay uses for atom watches/validators, volatiles, and `aset`. The overlay calls
these qualified, e.g. `(jolt.host/ref-put! ...)`.
---
## 3. The migration epic (`jolt-1j0`) — essentially COMPLETE
**Goal:** shrink the Janet seed to `core-renames` + genuinely host-coupled fns;
express everything else (pure fns, macros, lazy machinery) in the self-hosted
overlay. Started at core.janet = 4145 lines / 421 `core-*` fns.
**Phases (all done):**
- **Phase 1** — compiler-dependency kernel tier. (Was found already essentially
complete — the analyzer needs nothing beyond the kernel tier + atom/swap!/reset!.)
- **Phase 2** — ~193 movable pure-eager fns → overlay.
- **Phase 3** (`jolt-461`, closed) — ~46 core macros → `defmacro` in the overlay.
Last one was `when-let`.
- **Phase 4** (`jolt-ldf`, closed) — host-coupled fns. ~27 moved over the `ref-put!`
primitive + pure composition (vary-meta, reduce-kv, ex-info accessors,
tagged-value predicates, atom peripheral ops, volatiles, future predicates,
ns-name, array reads/aset). The rest stay native by design (atom/swap!/reset!/
deref, transients, var cells, meta tables, namespace, constructors, proxy,
print dispatch).
- **Phase 5** (`jolt-c09`, closed) — true laziness. Lazy seq generators +
transformers, the `40-lazy.clj` tier, realization-boundary discipline. See
`phase-5.md` for the full implementation + testing plan and what landed
(representation decision = **Option B / hybrid**: lazy over lazy input, eager
representation-preserving over concrete finite collections).
The epic issue (`jolt-1j0`) may still read IN_PROGRESS — verify with `bd show
jolt-1j0` and close it if all five phase issues are closed and gates are green.
**Where to confirm current state:** `phase-5.md` (detailed, step-annotated),
`jolt-core/clojure/core/MIGRATION.md` (the worklist + bucket classification), and
the bd memories `phase4-host-primitive-pattern` / `phase4-movable-classification`.
---
## 4. Representation facts you MUST know (the trap floor)
Jolt's value/form representations bite every time. The essentials:
- **Reader forms:** a *call/list* `(f x)` is a Janet **array**; a *vector literal*
`[a b]` is a Janet **tuple**; a *map literal* `{..}` is a Janet **struct** (or a
**phm** when a key/val is nil or a key is a collection). A **symbol** is a struct
`{:jolt/type :symbol :ns _ :name _}`; a **keyword** is a Janet keyword.
- **Runtime values:** vectors are persistent-vectors (`pvec`, tagged tables) or
tuples; lists/seq-results are Janet arrays or `plist`; sets are `phs`; maps are
struct-or-phm. `vector?` is true for tuple **and** pvec. `seq?` is arrays/plists/
lazy-seqs (not vectors). In `JOLT_MUTABLE` builds vectors are plain arrays — so
`vector?`/`array?` collapse (this is why `ifn?` couldn't move — see `jolt-1vx`).
- **Tagged values** carry their kind in `:jolt/type` (atoms, volatiles, delays,
futures, ex-info, reader-conditional, lazy-seq) or `:jolt/deftype` (records). The
overlay can **read** these via `(get x :jolt/type)` / `(get x :field)``get`
returns nil on non-tables, no error. It **cannot construct** them without a host
primitive. This is the Phase-4 movability rule: accessors/predicates move,
constructors stay.
- **`canon-key`** (core.janet ~line 51) is the canonical-hashing kernel of the
whole persistent-collection system — woven into `get`/`count`/`contains?`. This
is why transients are irreducibly host.
- **LazySeq** (`phm.janet`): `@{:jolt/type :jolt/lazy-seq :fn thunk ...}`; thunk →
`nil` or `[first rest-thunk]`; `realize-ls` memoizes with a `:jolt/pending` guard
that makes self-referential seqs (`lazy-cat` fib) work.
### Macro/overlay-authoring gotchas (learned the hard way)
- Build binding/forms via syntax-quote templates `` `[~@xs] `` (a tuple form), not
`conj`/`list` (those make pvecs/plists the analyzer/compiler rejects).
- A fresh symbol inside a macro body: `(symbol (str (gensym)))` — a bare `(gensym)`
returns a *Janet* symbol the destructurer rejects.
- A `.clj` tier is **Clojure** (`;;` comments). A `.janet` test/spec is **Janet**
(`#` comments — `;` is splice!). Mixing them is a frequent self-inflicted error.
- In a tier, a fn must be defined *after* the macro it uses is defined; use `def` +
`fn*` if you need it before `defn` exists (as `destructure` does in 00-syntax).
---
## 5. Build, run, and the test gate
No special build needed to run from source — Janet reads the tiers off disk.
```bash
# Smoke
janet -e '(use ./src/jolt/api) (pp (eval-string (init) "(+ 1 2)"))'
# THE GATE — run all of these green before committing any core change:
janet test/integration/conformance-test.janet # 229 cases × 3 modes (interpret/compile/self-host)
janet test/integration/bootstrap-fixpoint-test.janet # stage1 == stage2 == stage3
janet test/integration/self-host-test.janet
janet test/integration/sci-bootstrap-test.janet # loads vendored SCI through jolt
janet test/integration/clojure-test-suite-test.janet # battery; baseline-pass=3971, clean-files=45
for f in test/spec/*.janet test/unit/*.janet; do janet "$f"; done # all must exit 0
```
- **Specs** (`test/spec/*-spec.janet`) — data-driven `defspec` tables, behavioral.
- **Conformance** — real-Clojure-semantics assertions, run in all 3 execution modes.
- **clojure-test-suite** — runs `lread/clojure-test-suite` (from `~/src/clojure-
test-suite`) via a per-file **subprocess under a 6 s deadline** (infinite seqs are
CPU-bound and uninterruptible in-process — never probe them inline). Skips if the
suite dir is absent. Raise `baseline-pass` as jolt improves; never lower it.
- **Laziness** must be tested via the deadlined subprocess harness, not in-process.
### Per-change workflow (mirror this)
1. Make a small, single-purpose change.
2. Add/extend spec + (for subtle behavior) 3-mode conformance cases.
3. Run the full gate. Commit only if green.
4. `git push` (the project's session-close protocol requires pushed work).
---
## 6. Conventions
- **Issue tracker: beads (`bd`)**, not TodoWrite/markdown. `bd ready`, `bd show
<id>`, `bd create`, `bd update <id> --status=…`, `bd close`. `bd remember
--key … "…"` for durable knowledge; `bd memories` to recall. The `.beads/`
dir is git-ignored and auto-synced — don't `git add` it.
- **Commits/PRs**: terse, factual, human-dev tone. No marketing words, no emoji, no
"This commit…". Say what changed and why it matters.
- **Branch**: work happens on `compiler-research` (main is `main`).
- Don't lower `baseline-pass`. If a moved fn surfaces a latent bug, fix it to match
Clojure and add a regression test rather than preserving the bug (this happened
with `reduce-kv` on vectors and `ifn?` on lists).
---
## 7. Where to pick up
The migration epic is functionally complete; the seed is at its intended floor
(core-renames + genuinely host-coupled). Candidate next work:
- **Close out `jolt-1j0`** if not already closed (verify all phase issues closed,
gates green).
- **`jolt-1vx`** (filed) — `ifn?` is wrongly true for lists; move to overlay but
it's representation-mode-sensitive (`JOLT_MUTABLE`). Needs both-mode verification.
- **Phase-5 loose ends** (see `phase-5.md`): a few transformers were kept eager or
reverted due to compile-mode `~@`/defrecord splice issues (`partition-by`,
`dedupe`, `tree-seq`, lazy `mapcat`). Re-verify the ~9 previously-timing-out suite
files actually stopped timing out. The Step 4 "apply/`~@` over lazy" fix would
unblock the reverted lazy `mapcat`.
- **Bigger lifts not attempted** (deliberately): the `print-method`/`pr-str`
dispatch machinery and the `deftype`/`defrecord`/`defprotocol`/multimethod surface
— both substantial and host-entangled.
- **Open issues**: `bd ready` for the current actionable list (CI, edn/walk/zip
stdlib, `into #{}` bug, recur-into-variadic hang, real futures via ev/thread,
etc. — these predate the migration).
### Map of the territory
- `src/jolt/core.janet` — the Janet seed (`core-*` fns, `core-bindings`, `core-renames`).
- `src/jolt/evaluator.janet` — interpreter. `src/jolt/compiler.janet` — bootstrap compiler.
- `src/jolt/backend.janet` — IR → Janet emitter. `src/jolt/host_iface.janet``jolt.host`.
- `src/jolt/phm.janet` — persistent maps/sets/vectors + LazySeq.
- `src/jolt/api.janet` — context init + tier loading. `src/jolt/reader.janet` — reader.
- `jolt-core/jolt/{analyzer,ir}.clj` — portable self-hosted front end.
- `jolt-core/clojure/core/*.clj` — the overlay tiers + `MIGRATION.md`.
- `phase-5.md` — the laziness plan, annotated with what landed.
- `CLAUDE.md` / `AGENTS.md` — project agent instructions (beads, session-close).

100
README.md
View file

@ -2,14 +2,14 @@
[![tests](https://github.com/jolt-lang/jolt/actions/workflows/tests.yml/badge.svg)](https://github.com/jolt-lang/jolt/actions/workflows/tests.yml)
A Clojure interpreter running on [Janet](https://janet-lang.org). Jolt reads Clojure source, evaluates it with an interpreter written in pure Janet, and ships a Clojure-compatible standard library. The goal is a Janet-hosted [SCI](https://github.com/borkdude/sci) runtime — a minimal bootstrap that loads SCI's Clojure source as its standard library.
A Clojure implementation on top of [Janet](https://janet-lang.org). Jolt reads Clojure source and, by default, compiles each form to native Janet bytecode — falling back to a tree-walking interpreter for forms the compiler doesn't handle, so results always match the interpreter. It ships a Clojure-compatible standard library. The goal is a Janet-hosted [SCI](https://github.com/borkdude/sci)-style runtime with a minimal bootstrap.
## Build
```bash
git clone https://github.com/jolt-lang/jolt.git
cd jolt
git submodule update --init # pulls vendor/sci
git submodule update --init # pulls vendor/sci and vendor/clojure-test-suite
jpm build # builds build/jolt and build/jolt-deps
```
@ -54,58 +54,56 @@ hello 42
(def ctx (init))
(eval-string ctx "(+ 1 2)") # → 3
(eval-string ctx "(map inc [1 2 3])") # → [2 3 4]
(eval-string ctx "(map inc [1 2 3])") # → (2 3 4) ; a lazy seq, like Clojure
```
`(init)` returns a context with `clojure.core` loaded. Each context is isolated; use separate contexts for separate environments.
### Evaluation pipeline: interpreted and compiled
Every form Jolt evaluates passes through one router (`eval-one`), which decides
*per form* whether to tree-walk it or compile it to Janet. There are two modes:
Every form passes through one router (`loader/eval-toplevel`) that decides *per
form* whether to tree-walk it or compile it to Janet bytecode. The shipped
runtime **compiles by default**; set `JOLT_INTERPRET=1` to force the interpreter.
**Interpreted (default).** Without `:compile?`, every form is evaluated by the
tree-walking interpreter (`eval-form`). This is the live, fully-featured path:
all of Clojure's semantics — macros, multimethods, protocols, dynamic vars,
lazy seqs, destructuring — go through here.
**Hybrid, always correct.** The compiler is incomplete by design: a form it can't
compile correctly throws `jolt/uncompilable`, and the router falls back to the
tree-walking interpreter (`eval-form`) for that form. So the result *always*
matches the interpreter — compilation is a transparent speedup, never a semantic
change. Only the compile step is guarded; runtime errors in compiled code
propagate normally (no double-evaluation, no hidden errors).
**Compiled (`:compile? true`).** With compilation enabled, the router splits each
top-level form two ways:
What compiles: `def`/`defn`, multi-arity / named / variadic fns, `recur` (in
`loop` and directly in `fn`), `let`/`if`/`do`/`try`/`throw`/`quote`, map and
vector literals, and calls. What falls back to the interpreter: context-modifying
and definitional forms (`ns`, `defmacro`, `deftype`, `defprotocol`,
`defmulti`/`defmethod`, `reify`, `require`, `binding`, …), destructuring, regex
literals, and the handful of interpreter-only special forms.
- **Context-modifying forms always interpret.** `ns`, `defmacro`, `deftype`,
`defmulti`/`defmethod`, `require`, `in-ns`, `set!`, `var`, `.`, `new`, `eval`,
and syntax-quote mutate the evaluation context (namespaces, the macro table,
type/method registries, dynamic vars), so they are routed to the interpreter
unchanged.
- **Everything else compiles to Janet.** The form is macro-expanded, lowered to
a Janet AST, and `eval`'d in a **per-context Janet environment**. `def`/`defn`
bindings live in that environment so they persist and resolve across forms
(and self-recurse via a named-fn rewrite); hot numeric primitives
(`+ - * < > <= >=`) emit native Janet ops so the JIT-free Janet VM runs them at
full speed; and function calls compile to direct Janet calls (keyword/map/set
in call position still dispatch through the IFn runtime).
The two paths **share one context.** Compiled `def`/`defn` results are both
evaluated into the Janet environment *and* interned into the Jolt namespace, so
an interpreted form can call a compiled function and vice-versa within the same
context — which is what makes the always-interpret carve-out above safe.
**Live redefinition.** Compiled global references deref through Jolt **var cells**
(Janet early-binds plain symbols, which would freeze redefinition), so redefining
a `def`/`defn` at the REPL is visible to already-compiled callers — Clojure's var
model. Hot numeric primitives (`+ - * < > <= >=`) emit native Janet ops, and
calls compile to direct Janet calls.
```janet
(def ctx (init {:compile? true}))
(eval-string ctx "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
(eval-string ctx "(fib 30)") ; → 832040, fast
(eval-string ctx "(fib 30)") ; → 832040, native Janet bytecode
```
For compute-heavy code the compiled path is dramatically faster — recursive
`fib(30)` runs in ~0.08 s compiled vs ~50 s interpreted (≈600×), at native Janet
speed.
For compute-heavy code the compiled path is dramatically faster than tree-walking,
at native Janet speed.
Compile mode is opt-in and still maturing. The numeric-op inlining relaxes the
strict non-number checks (e.g. `(< nil 1)` doesn't throw), and constructs the
compiler doesn't yet handle currently **error** rather than transparently
falling back to the interpreter — a per-form hybrid fallback (compile what we
can, interpret the rest) is the next step toward making compilation safe to
turn on by default.
**Validated at parity.** The conformance suite passes 258/258 under *all three*
execution paths — interpreter, compiler, and the self-hosted compiler
(`conformance-test.janet` runs all three in CI) — and the full clojure-test-suite
matches its baseline across ~4.6k assertions — evidence the hybrid path doesn't
diverge.
**AOT.** `aot.janet` marshals a compiled namespace to a Janet bytecode image
(`save-ns`) and loads it back into a fresh context (`load-ns-image`), skipping
parse/analyze/emit/compile on reload. Core fns are referenced by name against the
baked-in runtime; only user bytecode and var cells are serialized.
## Host interop
@ -214,11 +212,12 @@ Tests are organized in three layers:
per public API area) that collectively pin down Jolt's defined behavior. This
is the authoritative description of what Jolt promises.
- **`test/integration/`** — cross-cutting and regression batteries: the Clojure
conformance suite, SCI bootstrap/runtime loading, jank conformance, the
cross-dialect [clojure-test-suite](https://github.com/jank-lang/clojure-test-suite)
(run via a minimal `clojure.test` shim against `~/src/clojure-test-suite`, if
present, and baseline-guarded), compile-mode tests, the library API, and a
broad systematic-coverage net.
conformance suite (run in all three execution modes), SCI bootstrap/runtime
loading, jank conformance, the cross-dialect
[clojure-test-suite](https://github.com/jank-lang/clojure-test-suite) (a git
submodule at `vendor/clojure-test-suite`, run via a minimal `clojure.test` shim
and baseline-guarded), compile-mode tests, the library API, and a broad
systematic-coverage net.
- **`test/unit/`** — white-box tests for individual components (reader,
evaluator, types, persistent collections, regex, compiler).
@ -234,11 +233,14 @@ exercises it.
### clojure-test-suite conformance
The [clojure-test-suite](https://github.com/jank-lang/clojure-test-suite) battery
runs ~3900 assertions green. Jolt validates its arguments like Clojure —
arithmetic on non-numbers, comparisons against `nil`, out-of-range indices,
malformed `conj!`/`assoc!`/`merge`, and non-seqable `first`/`seq`/`vec` all
throw. The assertions that remain failing are accounted for by the
platform/design differences above, not by missing behavior:
(vendored as a git submodule) runs ~3980 assertions green. Jolt validates its
arguments like Clojure — arithmetic on non-numbers, comparisons against `nil`,
out-of-range indices, malformed `conj!`/`assoc!`/`merge`, non-seqable
`first`/`seq`/`vec`, and lazy transformers (`map`/`filter`/…) realized over a
non-seqable all throw. The lazy seq fns return seqs (not vectors), so
`seq?`/`vector?`/`sequential?` of their results match Clojure. The assertions
that remain failing are accounted for by the platform/design differences above,
not by missing behavior:
- **No bignum/ratio/BigDecimal**`bigint`/`numerator`/`denominator`/`bigdec`,
the `big-int?`/auto-promotion checks, and the `2N`/`1/2`/`1.0M` literals read
@ -248,8 +250,6 @@ platform/design differences above, not by missing behavior:
`float?`/`double?` cases can't distinguish them (`(str 0.0)` is `"0"`).
- **64-bit integers / Unicode**`bit-and` etc. on full-width 64-bit constants
lose precision (doubles), and `subs`/`count` work on bytes, not code points.
- **Eager seqs**`map`/`filter`/`range` return vectors, so `seq?`/`vector?`/
`sequential?` of their results differ, and sorts aren't guaranteed stable.
## License

View file

@ -0,0 +1,138 @@
# Self-hosting architecture: portable jolt-core over a host runtime
Design for splitting Jolt into a **portable Clojure-in-Clojure core** and a
**host runtime** (Janet today, another runtime tomorrow), so the language is
truly self-hosted and `jolt-core` can be lifted out and re-hosted.
This is the design that must be right *before* writing the compiler in Clojure —
see [[self-hosting-compiler]] for the staged plan it plugs into.
## What "truly self-hosted + portable" requires
Two independent properties:
1. **Self-hosted** — the compiler and most of `clojure.core` are written in
Clojure and compiled by Jolt itself.
2. **Portable** — that Clojure code (`jolt-core`) depends only on a small,
explicit **host contract**, never on Janet directly. Re-hosting means
implementing the contract for a new runtime; `jolt-core` is reused verbatim.
The enemy is `jolt-core` calling `janet/tuple`, `make-vec`, `ns-find`, etc.
directly — that welds it to Janet. Every host dependency must go through the
contract.
## Prior art (the seam everyone uses)
- **Clojure (JVM).** `clojure.lang.*` (Java) is the host: `RT`/`Numbers` runtime
helpers, the `Compiler` (form → JVM bytecode), persistent data structures,
`Var`/`Namespace`, the reader. `clojure/core.clj` is the language, in Clojure.
Seam: ~20 primitive special forms + `RT` static methods. Everything else is
Clojure.
- **ClojureScript (self-hosted).** Two portable passes — `cljs.analyzer`
(form → AST **as data**, reading a **compiler-state map** of
namespaces/defs/macros, *not* host objects) and `cljs.compiler` (AST → JS, the
host-specific back end). `cljs.core` is Clojure compiled to JS. Platform splits
live in `.cljc` reader conditionals. This is the closest model to what we want:
**the analyzer is host-agnostic; only the back end and the runtime are
host-specific.**
- **Nanopass / Guile Tree-IL.** A high-level IR is the portability seam; multiple
back ends consume it.
- **ClojureCLR / ClojureDart / jank.** Same shape every time: portable analyzer +
host back end + host runtime.
The invariant across all of them: **the IR (analyzer output) and a small runtime
protocol are the contract; the front end is portable, the back end and runtime
are per-host.**
## Decisions (locked)
- **Seam = a minimal host protocol.** `jolt-core` calls a small documented set of
host fns (in ns `jolt.host`): `resolve-sym`, `macro?`, `macroexpand-1`,
`current-ns`, `intern!`, plus the `RT` primitives. Each host provides `jolt.host`
(+ RT). Re-hosting = reimplement that handful of fns. The protocol *is* the
boundary; `jolt-core` never touches Janet directly.
- **Physical split now.** Portable Clojure lives under `jolt-core/` (a new source
root, embedded into the binary like the rest of the stdlib); host Janet code for
the new pipeline under `host/janet/`. Legacy host modules under `src/jolt/*.janet`
are the existing Janet host and get relocated under `host/janet/` in a later
mechanical pass (tracked) — not moved big-bang now, to keep the suite green.
## The Jolt split
```
jolt-core/ PORTABLE Clojure — no Janet. Depends only on the contract.
ir the IR spec (data shapes the analyzer emits)
analyzer form -> IR (macroexpands; resolves via host protocol)
macros when/cond/->/defn/... (the macro library, in Clojure)
core clojure.core fns expressible in Clojure, over RT primitives
host/janet/ THE HOST — Janet. Implements the contract.
reader text -> jolt forms
rt data structures + RT primitive fns (cons/first/+/get/apply…)
backend IR -> Janet forms -> Janet compile -> bytecode (the emitter)
cenv the compile-time host protocol impl (resolve/macro?/intern)
bootstrap load jolt-core, wire analyzer+backend into the loader
interop janet.* bridge
```
Two contracts cross the seam:
### 1. The IR (analyzer → back end)
The existing `:op`-tagged AST, made **host-neutral**:
- `{:op :const :val v}`, `:if`, `:do`, `:let`, `:fn` (arities), `:invoke`,
`:vector`/`:map`/`:set`, `:quote`, `:throw`/`:try`, `:loop`/`:recur`.
- **Globals reference vars by NAME, not by host cell:**
`{:op :var :ns "clojure.core" :name "map"}`. (compiler.janet today embeds the
Janet var cell as a constant — that's a host leak and breaks AOT. Name-based
refs are both portable and AOT-friendly; the back end resolves the cell.)
- No embedded host function values. Calls to runtime primitives are
`{:op :rt :name "cons"}` resolved by the back end to the host's RT fn.
### 2. The host contract (two protocols)
- **Compile-time (`cenv`)** — what the analyzer needs from the host while
analyzing: `(current-ns)`, `(resolve-sym sym) -> {:kind :var|:macro|:local|:special|:host, :ns, :name}`,
`(macroexpand-1 form)`, `(intern! ns sym meta)`. The analyzer calls only these;
it never touches Janet ns/var tables. (CLJS keeps this as pure data; we use a
small protocol — a minimal, documented boundary — because Jolt already has live
ns/var objects. The protocol *is* the seam.)
- **Runtime (`RT`)** — the primitive fns emitted code and `jolt-core` call by
stable name: arithmetic/compare, `cons/first/rest/seq/conj/get/assoc/count`,
`apply`, `=`, vector/map/set constructors, var deref/bind, keyword/symbol
construction. The back end maps each to the host (on Janet, mostly the existing
`core-*`). To re-host, implement this set.
## Why name-based vars (not embedded cells)
`compiler.janet` compiles a global ref to a closure over the Janet var cell. That
(a) is a Janet value baked into the IR — not portable, and (b) can't be marshaled
for AOT without the runtime-dict trick. Compiling instead to *resolve var by
(ns,name) at call time* through an RT primitive keeps redefinition live, makes the
IR host-neutral, and makes images trivially portable. The per-call lookup is the
cost; it can be cached/direct-linked later as an opt-in optimization.
## Bootstrap & staging (keeps the suite green throughout)
`compiler.janet` stays as the **bootstrap back end** until the Clojure pipeline is
proven. Order:
1. **Freeze the IR** spec and refactor `compiler.janet`'s emit to consume
name-based `:var` (no behavior change; bootstrap still works).
2. **Define the host contract** (`cenv` + `RT`) and implement it on Janet,
exposed under a stable namespace the Clojure core can call.
3. **Write `jolt.analyzer` in Clojure** producing IR, against `cenv`. Diff its IR
against the Janet analyzer on the conformance corpus until identical.
4. **Janet back end consumes IR** from the Clojure analyzer; wire into the loader
behind a flag. Validate at parity (dual-mode conformance + clojure-test-suite).
5. **Flip** the loader to the Clojure analyzer + Janet back end; `compiler.janet`
shrinks to the back end only.
6. **Move `clojure.core`** macros then fns into `jolt-core` incrementally, each
compiled by the prior stage, isolating host bits behind `RT`.
Guards at every step: the dual-mode conformance harness (interpret vs compile)
and the clojure-test-suite baseline.
## The portability test
When done, re-hosting Jolt to runtime X means writing only: `host/X/{reader, rt,
backend, cenv, bootstrap}`. `jolt-core/{ir, analyzer, macros, core}` is reused
unchanged. That is the concrete bar for "truly self-hosted and portable."

View file

@ -0,0 +1,170 @@
# Toward a self-hosting Jolt compiler
Research and design notes for evolving Jolt from "interpreter + opt-in ad-hoc
compiler" toward a self-hosting Clojure-in-Clojure compiler that emits Janet
bytecode, keeps full REPL live-redefinition, and rests on a minimal Janet
bootstrap. This is a design doc, not a changelog — it describes where we are, the
prior art, the constraints we verified, and a recommended path.
## The goal
- **Self-hosting, Clojure-in-Clojure.** A small kernel in the host (Janet) is
enough to start; the rest of Clojure — including the compiler — is written in
Clojure and compiled by Jolt itself, growing the language as it compiles more
of itself.
- **Janet bytecode out.** Compiled code runs as native Janet bytecode (fast),
not tree-walking.
- **Full runtime flexibility.** `def`/`defn` redefinition, vars, protocols,
multimethods, and everything else stay live and redefinable at the REPL even
for compiled code.
- **Minimal host requirement.** Shrink what must exist in Janet to the
irreducible base.
## Where Jolt is today
- ~5,500 lines of **Janet** implement `clojure.core` (`core.janet`) and a
tree-walking interpreter (`evaluator.janet`); ~1k lines of **Clojure** are the
stdlib (`clojure.string/set/walk/…`, `jolt.*`). So the language is mostly in
the host, inverted from the Clojure-in-Clojure ideal.
- The interpreter (`eval-form`) is the complete reference path.
- The compiler (`compiler.janet`) — `analyze-form` (reader form → `:op` AST) →
`emit` (AST → Janet form) → Janet `compile`/`eval` — is now **on by default**
in the shipped runtime (`JOLT_INTERPRET=1` opts out). It is a *hybrid*: forms
it can't compile correctly throw `jolt/uncompilable` and fall back to the
interpreter (`loader/eval-toplevel`), so results always match the interpreter.
Validated at parity — conformance 218/218 under both interpret and compile, and
the clojure-test-suite under compile passes 3932 (vs the 3913 interpreter
baseline) across ~4.6k assertions.
- Done so far: var-indirection (globals deref through var cells, so compiled code
is REPL-redefinable); hybrid fallback; compilation of multi-arity / named /
variadic fns and `recur` inside `fn`; map and vector literal compilation
(mode-correct via `make-vec` / `build-map-literal`); resolution that mirrors
the interpreter (current ns → `clojure.core` → Janet-env fallback); and AOT
(`aot.janet`) that marshals a compiled namespace to a Janet bytecode image
against the baked-in runtime dictionary and loads it back.
- Still open — the actual self-hosting: the compiler and most of `clojure.core`
are still Janet. Rewriting them in Clojure (compiled by Jolt) is the remaining
Clojure-in-Clojure work.
## What the host gives us (verified)
Janet already is the backend and the AOT story — we don't need a custom bytecode
emitter:
- `(compile form env source)` → a **function** (compiled bytecode). Jolt's job is
Clojure form → correct Janet form → `compile`.
- `marshal`/`unmarshal`, `make-image`/`load-image` → serialize a compiled
environment to a **bytecode image** and load it back: this is Phase 4 AOT.
- `asm`/`disasm` → bytecode assembler/disassembler if we ever want to bypass the
form layer (we shouldn't need to).
**The catch we verified:** Janet *early-binds* top-level references. Compile
`(defn caller [] foo)`, then redefine `foo` — the compiled `caller` still returns
the old value. So emitting Jolt globals as plain Janet symbols (what the current
compiler largely does) is fundamentally incompatible with REPL redefinition. This
is the single most important design constraint below.
## Prior art
- **Clojure (JVM).** A Java runtime + compiler bootstraps `clojure.core`, which is
written in Clojure; thereafter Clojure compiles Clojure to JVM bytecode. Only
~20 special forms are primitive; everything else is macros/functions. Crucially,
compiled call sites go **through Var objects** (a deref), so redefining a var is
visible to existing compiled callers — that's how speed and live redefinition
coexist. Clojure 1.8 added opt-in **direct linking** (inline the call, drop the
var indirection) for speed where you don't need redefinition (used for core in
production). AOT compiles namespaces to `.class` files.
- **ClojureScript self-hosting.** Two stages: an **analyzer** (source → AST plus
a "compiler state" map of namespaces/defs/macros) and a **compiler** (AST → JS).
`cljs.js` exposes compile/eval at runtime; bootstrapped CLJS compiles CLJS at
~2× the JVM compiler. The host VM (JS engine) is the backend — the same shape we
want with Janet as the backend.
- **Nanopass (Chez Scheme).** A compiler as *many small passes* over *formally
specified* intermediate languages, with autogenerated boilerplate to recur
through unchanged forms and checks that each pass's output matches its grammar.
The lesson for "grow the language as it compiles itself": keep passes small and
IRs explicit so adding a form is local and verifiable.
- **Guile.** A Lisp on a bytecode VM: source → Tree-IL (high-level IR) → CPS
(optimization IR) → VM bytecode, with several front-end languages targeting
Tree-IL. The closest analog to "Lisp → bytecode on a VM."
## Assessment: is the current approach the right one?
The overall *shape* is right and matches ClojureScript: front-end (analyze →
emit) with the host VM as the backend, emitting host forms that the host compiles
to bytecode. Two things need to change to reach the goal:
1. **Late binding for globals.** Compile a reference to a Jolt var as a **deref
through the var cell**, not as a Janet symbol. Jolt vars are already cells
(`{:jolt/type :jolt/var :root …}`); a compiled global call becomes roughly
`((var-root cell) args…)` instead of `(janet-symbol args…)`. Redefinition
updates the cell's root, so compiled callers see it — exactly Clojure's model.
One indirection per global call; locals and control flow stay direct and fast.
Offer opt-in **direct linking** for hot/AOT code that doesn't need redefinition.
2. **Move the compiler and core into Clojure.** Today both are Janet. Self-hosting
means the compiler is Clojure compiled by Jolt, and most of `clojure.core` is
Clojure. That's the bulk of the work and where the "language builds itself"
payoff lives.
So: keep the emit-to-Janet target (it's correct and gives us bytecode + AOT for
free), fix global binding, and progressively self-host.
## Recommended architecture
**Pipeline (nanopass-lite).** Keep the data-driven `:op` AST and grow it as small,
named passes rather than one big walker:
1. *read* — reader → forms (already have it).
2. *macroexpand* — fully expand to special forms + calls (the interpreter already
expands; share one expander).
3. *analyze* — forms → AST, resolving locals vs vars and tagging ops.
4. *(optional) optimize* — constant-fold, direct-link hot calls, etc.
5. *emit* — AST → Janet form, with globals as var-cell derefs.
6. *compile* — Janet `compile` → bytecode; `make-image` for AOT.
Make each pass total over the IR so an unhandled node is an explicit gap, not a
silent miss.
**The kernel (minimal Janet bootstrap).** The irreducible base that must exist in
the host before any Clojure can run: the reader; the value/representation layer
(vars, namespaces, symbols, keywords, persistent collections, chars); host
interop (the `janet.*` bridge); `fn`/`if`/`do`/`let`/`quote`/`def`/`loop`/`recur`
evaluation; and `compile`/`eval`. Everything else — the rest of `clojure.core`,
the macros, and the compiler — is Clojure loaded and (eventually) compiled by the
kernel. Today the kernel is far larger than this; shrinking it is a long game.
**Hybrid interpret/compile (Phase 3, and a bootstrap safety net).** When a pass
can't yet compile a sub-form, emit a call back into the interpreter (`eval-form`)
for that sub-form instead of erroring. This lets the compiler be incomplete and
still correct (hot paths compile, cold/unsupported paths interpret), lets us grow
coverage incrementally, and de-risks the self-hosting bootstrap.
**Live flexibility.** Vars stay first-class cells; compiled code derefs them;
`def` updates the root; protocol/multimethod dispatch stays dynamic. Direct
linking is opt-in, never the default, so the REPL is always live.
## A staged path
1. **Var-indirection in the emitter***done*. Global refs compile as var-cell
derefs, so a compiled `defn` is redefinable at the REPL.
2. **Hybrid fallback + coverage** (`jolt-1bj`) — *done*. Forms the compiler can't
compile throw `jolt/uncompilable` and fall back to the interpreter, so compile
mode is always correct. Covered: multi-arity/named/variadic fns, `recur` in
`fn`, map/vector literals, and resolution matching the interpreter. (One
optimization left: compile destructuring via a shared `destructure` expander
instead of falling back — `jolt-7dl`.)
5. **Compile-by-default + AOT** (`jolt-7j9`) — *done, done out of order*. Once the
hybrid path was validated at parity, compilation was flipped on by default and
AOT images (`aot.janet`) landed. Done before 34 because it's the runtime
payoff and only needed the hybrid path to be correct, not self-hosting.
3. **Self-host the compiler** (`jolt-lcn`) — *open*. Rewrite `compiler.janet` as
Clojure (`jolt.compiler`) that Jolt compiles. Now the compiler is part of the
language it compiles.
4. **Shrink the kernel / core-in-Clojure** (`jolt-uqi`) — *open*. Move
`clojure.core` from Janet to Clojure incrementally, each piece compiled by the
previous stage — the language building itself — leaving a minimal Janet kernel.
What remains (3 and 4) is the actual Clojure-in-Clojure rewrite: the largest part
of the work and where the "language builds itself" payoff lives. The correctness
and runtime foundations it needs — redefinable compiled code, an always-correct
hybrid path, compile-by-default, and AOT — are now in place.

View file

@ -0,0 +1,46 @@
;; clojure.core — kernel tier (stage just above the Janet seed).
;;
;; These are the structural fns the self-hosted compiler itself uses
;; (jolt.analyzer): second/peek/subvec/mapv/update. Because the compiler must be
;; able to compile the *rest* of clojure.core, anything it calls has to exist
;; before it is built. So this tier is loaded FIRST and, in compile mode, is
;; bootstrap-compiled directly into clojure.core (not routed through the
;; self-hosted pipeline, which would need these to already exist — the
;; circularity that previously forced `second` to stay in Janet). With this tier
;; in place the analyzer is built against the Clojure definitions and the Janet
;; primitives are gone.
;;
;; Constraint: depend only on core-renames primitives (first/next/nth/count/conj/
;; vec/map/apply/assoc/get/…, all hardwired to the Janet seed) and on each other.
(defn second [coll] (first (next coll)))
(defn peek [coll]
(cond
(nil? coll) nil
;; vectors (incl. jolt's eager seq results): last element; lists/seqs: first.
(vector? coll) (if (zero? (count coll)) nil (nth coll (dec (count coll))))
(seq? coll) (first coll)
:else (throw (str "peek not supported on: " coll))))
(defn subvec
([v start] (subvec v start (count v)))
([v start end]
(when (not (vector? v)) (throw (str "subvec requires a vector")))
;; Clojure coerces indices with (int ...): NaN -> 0, floats/ratios truncate
;; toward zero ((quot x 1)); non-numbers throw. Only then range-check.
(let [coerce (fn [x]
(cond
(not (number? x)) (throw (str "subvec index must be a number"))
(not= x x) 0
:else (quot x 1)))
s (coerce start)
e (coerce end)]
(when (or (< s 0) (< e s) (< (count v) e))
(throw (str "subvec index out of range: " s " " e)))
(loop [i s acc []]
(if (< i e) (recur (inc i) (conj acc (nth v i))) acc)))))
(defn mapv [f & colls] (vec (apply map f colls)))
(defn update [m k f & args] (assoc m k (apply f (get m k) args)))

View file

@ -0,0 +1,345 @@
;; clojure.core — syntax tier. The control macros the compiler and every later
;; tier depend on (when/cond/and/or/...), expressed as defmacro. Loaded FIRST
;; (before 00-kernel), interpreted, so the macros exist before any code that uses
;; them is compiled — including the kernel tier, the self-hosted analyzer, and the
;; seq/coll tiers.
;;
;; CONSTRAINT: a macro here may use ONLY special forms (if/do/let*/fn*/not) and
;; core-renames SEED primitives (first/next/rest/nth/count/empty?/...). It must
;; NOT use kernel-tier fns (second/peek/subvec/...) or anything defined later —
;; those don't exist yet when this tier loads.
(defmacro when [test & body]
`(if ~test (do ~@body)))
(defmacro when-not [test & body]
`(if (not ~test) (do ~@body)))
(defmacro and [& exprs]
(if (empty? exprs)
true
(if (empty? (rest exprs))
(first exprs)
`(let* [and# ~(first exprs)] (if and# (and ~@(rest exprs)) and#)))))
(defmacro or [& exprs]
(if (empty? exprs)
nil
(if (empty? (rest exprs))
(first exprs)
`(let* [or# ~(first exprs)] (if or# or# (or ~@(rest exprs)))))))
;; :else (any truthy value) is just a test, so no special case — (if :else e ...)
;; takes e.
(defmacro cond [& clauses]
(if (empty? clauses)
nil
`(if ~(first clauses) ~(nth clauses 1) (cond ~@(drop 2 clauses)))))
;; Threading: a list form threads x in as the first (->) or last (->>) arg; a bare
;; symbol becomes (form x). Recursive; the expand-once cache makes that free.
(defmacro -> [x & forms]
(if (empty? forms)
x
(let [form (first forms)
threaded (if (seq? form)
`(~(first form) ~x ~@(rest form))
`(~form ~x))]
`(-> ~threaded ~@(rest forms)))))
(defmacro ->> [x & forms]
(if (empty? forms)
x
(let [form (first forms)
threaded (if (seq? form)
`(~(first form) ~@(rest form) ~x)
`(~form ~x))]
`(->> ~threaded ~@(rest forms)))))
;; Forward declaration is a no-op on Jolt — the compiler resolves forward refs via
;; pending cells (matching the prior Janet macro).
(defmacro declare [& syms] `(do))
;; destructure — Clojure's binding-vector expander, ported from the Janet seed
;; (was core-destructure). Turns a binding vector that may contain destructuring
;; patterns into a plain binding vector (alternating symbol / init-form) built from
;; nth/nthnext/get, so the COMPILER only ever sees plain symbols (analyze-bindings
;; rejects patterns). `let` consumes it directly; `loop`/`fn` reuse it transitively
;; through `let`. Written with let*/fn* and seed primitives only — it never uses
;; let/loop/fn, so expanding its own body can't recurse back into destructure.
;; Note map? is true for symbol structs too, so the symbol? clause must come first.
;; def+fn* (not defn) because the defn macro is not defined until later in the tier.
(def destructure
(fn* destructure [bindings]
(let* [find-or
(fn* [or-map nm]
(reduce (fn* [acc k]
(if (and (symbol? k) (= nm (name k)))
[true (get or-map k)]
acc))
[false nil]
(if or-map (keys or-map) [])))
amp? (fn* [x] (and (symbol? x) (= "&" (name x))))
proc
(fn* proc [pat init acc]
(cond
(symbol? pat) (conj (conj acc pat) init)
(vector? pat)
(let* [g (symbol (str (gensym)))
n (count pat)
vloop
(fn* vloop [i idx a]
(if (< i n)
(let* [elem (nth pat i)]
(cond
(amp? elem)
(vloop (+ i 2) idx (proc (nth pat (inc i)) `(nthnext ~g ~idx) a))
(= elem :as)
(vloop (+ i 2) idx (proc (nth pat (inc i)) g a))
:else
(vloop (inc i) (inc idx) (proc elem `(nth ~g ~idx nil) a))))
a))]
(vloop 0 0 (conj (conj acc g) init)))
(map? pat)
(let* [g (symbol (str (gensym)))
or-map (get pat :or)
as-sym (get pat :as)
base (if as-sym
(conj (conj (conj (conj acc g) init) as-sym) g)
(conj (conj acc g) init))
group
(fn* [a kw kind]
(let* [names (get pat kw)]
(if names
(reduce
;; s is a symbol (a b) or a keyword (:a :b); name/
;; namespace handle both, so :keys [:major] binds
;; `major` looking up :major (str would keep the colon).
(fn* [aa s]
(let* [local (name s)
nsp (namespace s)
keyform (cond
(= kind :kw) (keyword (if nsp (str nsp "/" local) local))
(= kind :str) local
:else `(quote ~(symbol nsp local)))
fo (find-or or-map local)]
(conj (conj aa (symbol local))
(if (nth fo 0)
`(get ~g ~keyform ~(nth fo 1))
`(get ~g ~keyform)))))
a names)
a)))
g1 (group base :keys :kw)
g2 (group g1 :strs :str)
g3 (group g2 :syms :sym)]
(reduce (fn* [a k]
(if (keyword? k)
a
(proc k `(get ~g ~(get pat k)) a)))
g3 (keys pat)))
:else (throw (str "unsupported destructuring pattern"))))
ploop
(fn* ploop [i acc]
(if (< i (count bindings))
(ploop (+ i 2) (proc (nth bindings i) (nth bindings (inc i)) acc))
acc))]
(ploop 0 []))))
;; let desugars destructuring patterns to plain bindings (via destructure) so the
;; COMPILER sees only plain symbols — analyze-bindings rejects patterns as
;; uncompilable, relying on this macro to have expanded them. (The interpreter
;; could destructure let* directly, but the compiler can't.) let* is sequential, so
;; a later init can reference an earlier destructured name. Splice via [~@..] so the
;; binding vector is a tuple form (destructure returns a pvec), not a pvec literal.
(defmacro let [bindings & body]
`(let* [~@(destructure bindings)] ~@body))
;; loop binds destructuring forms like let, but recur must target the loop* vars,
;; whose count can't change. So (matching Clojure): gensym one loop var per binding,
;; loop* over those, and destructure them via an inner let each iteration; an outer
;; let establishes the destructured names so later inits can see them. Plain loops
;; (no patterns) pass straight through to loop*.
(defmacro loop [bindings & body]
(let [d (destructure bindings)]
(if (= d bindings)
`(loop* ~bindings ~@body)
(let [bs (take-nth 2 bindings)
vs (take-nth 2 (drop 1 bindings))
gs (map (fn [b] (if (symbol? b) b (symbol (str (gensym))))) bs)
outer (reduce (fn [acc t]
(let [b (nth t 0) v (nth t 1) g (nth t 2)]
(if (symbol? b) (conj (conj acc g) v)
(conj (conj (conj (conj acc g) v) b) g))))
[] (map vector bs vs gs))
inner (reduce (fn [acc t] (conj (conj acc (nth t 0)) (nth t 1)))
[] (map vector bs gs))
loopv (reduce (fn [acc g] (conj (conj acc g) g)) [] gs)]
;; splice via [~@..] so the binding vectors are tuple forms, not pvecs.
`(let [~@outer] (loop* [~@loopv] (let [~@inner] ~@body)))))))
;; fn: desugar destructuring params to plain symbols + a body let (matching
;; Clojure's maybe-destructured), so fn* only ever sees plain params (the compiler's
;; analyze-fn requires that). Plain params pass through untouched. Handles an
;; optional name and single- or multi-arity. md/mk are fn* (not fn) to avoid a cycle.
;; md walks a param seq, replacing non-symbol patterns with gensyms and recording
;; [pattern gensym] let-bindings; mk turns one arity (params . body) into a rewritten
;; arity. Output: single arity splices the arity's elements straight into fn*; multi
;; arity splices the rewritten clauses.
(defmacro fn [& raw]
(let [nm (if (symbol? (first raw)) (first raw) nil)
aftn (if nm (next raw) raw)
md (fn* go [ps nps lets]
(if (seq ps)
(if (symbol? (first ps))
(go (next ps) (conj nps (first ps)) lets)
;; bare (gensym) here is Janet's (a Janet symbol the destructurer
;; rejects); round-trip through str for a jolt symbol.
(let [g (symbol (str (gensym)))]
(go (next ps) (conj nps g) (conj (conj lets (first ps)) g))))
[nps lets]))
mk (fn* [sig]
(let [r (md (seq (first sig)) [] [])]
(if (empty? (nth r 1))
sig
;; build the params/let vectors via [~@..] so they are tuple forms
;; (the accumulators are plain seqs, the wrong representation).
(let [pv `[~@(nth r 0)]
lv `[~@(nth r 1)]]
`(~pv (let ~lv ~@(rest sig)))))))]
(if (vector? (first aftn))
(let [a (mk aftn)]
(if nm `(fn* ~nm ~@a) `(fn* ~@a)))
(let [as (vec (map mk aftn))]
(if nm `(fn* ~nm ~@as) `(fn* ~@as))))))
;; defn: drop an optional leading docstring and attr-map, then (def name (fn* ...)).
;; Both single- and multi-arity reduce to (fn* ~@body) — fn* takes either a params
;; vector + body or a sequence of ([params] body) clauses, so no arity branching is
;; needed. (map? is true for symbol forms too, so guard the attr-map with symbol?.)
;; Defined before fresh-sym below, which is a defn-.
(defmacro defn [fn-name & body]
(let [body (if (and (seq body) (string? (first body))) (rest body) body)
body (if (and (seq body) (map? (first body)) (not (symbol? (first body))))
(rest body) body)]
`(def ~fn-name (fn* ~@body))))
;; Jolt doesn't enforce privacy, so defn- is just defn (matching how Clojure's own
;; defn- delegates to defn with :private metadata).
(defmacro defn- [fn-name & body] `(defn ~fn-name ~@body))
;; A fresh jolt symbol inside a macro body (a bare (gensym) returns a Janet symbol
;; the destructurer rejects). This defn compiles fine: by the time a tier triggers
;; the analyzer build the kernel is in place (the build is gated until then).
(defn- fresh-sym [] (symbol (str (gensym))))
;; cond->: thread expr through each (test form) pair, only when the test is truthy.
;; Linear nested let*, a distinct fresh symbol per step.
(defmacro cond-> [expr & clauses]
(let [step (fn step [prev cls]
(if (empty? cls)
prev
(let [t (first cls)
f (nth cls 1)
gn (fresh-sym)
call (if (seq? f) `(~(first f) ~prev ~@(rest f)) `(~f ~prev))]
`(let* [~gn (if ~t ~call ~prev)] ~(step gn (drop 2 cls))))))
g0 (fresh-sym)]
`(let* [~g0 ~expr] ~(step g0 clauses))))
;; case: nested =/or tests (no jump table). Test constants are NOT evaluated —
;; symbols and list constants are quoted; a list in test position is a set (or).
(defmacro case [expr & clauses]
(let [g (fresh-sym)
mk-const (fn [c] (if (or (symbol? c) (seq? c)) `(quote ~c) c))
mk-test (fn [c]
(if (seq? c)
`(or ~@(map (fn [v] `(= ~g ~(mk-const v))) c))
`(= ~g ~(mk-const c))))
build (fn build [cls]
(if (empty? cls)
nil
(if (empty? (rest cls))
(first cls)
`(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))]
`(let* [~g ~expr] ~(build clauses))))
;; for: list comprehension, desugared to nested map/mapcat over the binding colls.
;; Per binding group: :when wraps the inner form in (if test (list inner) []) so
;; mapcat drops it when false; :let wraps it in a let*; :while wraps the coll in
;; take-while. The last group with no modifiers is a plain map (no flatten needed).
;; Faithful port of the prior Janet macro (single body expr). The body uses only
;; kernel/seed fns so it runs at analyzer-build time. `fn` (not fn*) carries the
;; binding so destructuring forms work.
(defmacro for [bindings body]
(let [scan (fn scan [bvec i bind coll mods]
(if (and (< i (count bvec)) (keyword? (nth bvec i)))
(let [k (nth bvec i)
v (nth bvec (inc i))]
(cond
(= k :when) (scan bvec (+ i 2) bind coll (conj mods [:when v]))
(= k :let) (scan bvec (+ i 2) bind coll (conj mods [:let v]))
(= k :while) (scan bvec (+ i 2) bind `(take-while (fn [~bind] ~v) ~coll) mods)
:else (scan bvec (inc i) bind coll mods)))
[i bind coll mods]))
parse-groups (fn parse-groups [bvec i groups]
(if (>= i (count bvec))
groups
(let [r (scan bvec (+ i 2) (nth bvec i) (nth bvec (inc i)) [])]
(parse-groups bvec (nth r 0)
(conj groups [(nth r 1) (nth r 2) (nth r 3)])))))
;; Apply the group's modifiers around a contribution that is ALREADY a seq
;; (a (list body) for the last group, an inner comprehension otherwise), so
;; :when just returns it or [] — no extra (list ...) that mapcat couldn't
;; flatten. :let binds around it; mods apply outer-to-inner (left to right).
wrap-mods (fn wrap-mods [mods inner]
(if (empty? mods)
inner
(let [m (first mods)
sub (wrap-mods (rest mods) inner)]
(if (= (first m) :when)
`(if ~(nth m 1) ~sub [])
`(let* ~(nth m 1) ~sub)))))
build (fn build [idx groups]
(let [g (nth groups idx)
my-bind (nth g 0)
my-coll (nth g 1)
my-mods (nth g 2)
is-last (= idx (dec (count groups)))]
(if (and is-last (empty? my-mods))
;; fast path: last group, no modifiers -> a plain map of body
`(map (fn [~my-bind] ~body) ~my-coll)
;; general: mapcat over a seq contribution (wrap a last-group
;; body in a one-element list so mapcat yields the bodies).
(let [base (if is-last `(list ~body) (build (inc idx) groups))]
`(mapcat (fn [~my-bind] ~(wrap-mods my-mods base)) ~my-coll)))))]
(if (>= (count bindings) 2)
(build 0 (parse-groups bindings 0 []))
body)))
;; doseq runs body for side effects across the bindings, returning nil. Same
;; shortcut as the prior Janet macro: realize a `for` comprehension with count
;; (for handles :when/:let/:while and multiple bindings).
(defmacro doseq [bindings & body]
`(do (count (for ~bindings (do ~@body nil))) nil))
;; when-let must live in this (early) tier, not 30-macros with its if-let/if-some/
;; when-some siblings: 20-coll uses it (not-empty), and 20-coll loads before 30. The
;; name binds only in the taken branch (temp# tests the value); via `let` so the
;; binding form may itself destructure, matching Clojure.
(defmacro when-let [bindings & body]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if temp# (let [~form temp#] ~@body) nil))))
;; lazy-seq / lazy-cat live here (not 30-macros) because the seq/coll tiers use
;; them and compile-as-they-load: the macro must be registered before those tiers
;; or (lazy-seq …) compiles to a call of the macro-as-function and leaks its
;; expansion at runtime (jolt-r81). They use only seed fns (make-lazy-seq/
;; coll->cells/concat) + map, all available from the start.
;; lazy-seq defers its body: make-lazy-seq holds a thunk that realizes the body
;; to cells when forced. lazy-cat wraps each coll in a lazy-seq and concats.
(defmacro lazy-seq [& body]
`(make-lazy-seq (fn* [] (coll->cells (do ~@body)))))
(defmacro lazy-cat [& colls]
`(concat ~@(map (fn [c] `(lazy-seq ~c)) colls)))

View file

@ -0,0 +1,61 @@
;; clojure.core — seq tier. Pure-Clojure leaf sequence fns on top of the kernel
;; tier (00-kernel) and the Janet seed. Loaded after the kernel tier; in compile
;; mode these self-host through the now-built analyzer (interpreted otherwise).
;;
;; Migration rule for adding fns here: the fn must (1) NOT be in
;; compiler/core-renames (that map emits core-X Janet symbols directly), (2) have
;; no internal Janet callers of its core-X binding, and (3) NOT be used by the
;; self-hosted compiler (jolt-core/jolt/*.clj). Compiler-facing structural fns go
;; in the kernel tier (00-kernel) instead — see its header.
(defn ffirst [coll] (first (first coll)))
(defn nfirst [coll] (next (first coll)))
(defn fnext [coll] (first (next coll)))
(defn nnext [coll] (next (next coll)))
;; Canonical Clojure defs: pure first/next/loop/recur, no Janet realize-for-iteration.
(defn last [s]
(if (next s) (recur (next s)) (first s)))
(defn butlast [s]
(loop [ret [] s s]
(if (next s)
(recur (conj ret (first s)) (next s))
(seq ret))))
;; partition-by: (partition-by f) is a stateful transducer (buffer a run, emit on
;; key change, flush on completion — via volatiles, matching Clojure); (partition-by
;; f coll) is the lazy collection arity.
(defn partition-by
([f]
(fn [rf]
(let [buf (volatile! [])
pv (volatile! nil)
started (volatile! false)]
(fn
([] (rf))
([result]
(let [b @buf
result (if (zero? (count b))
result
(do (vreset! buf []) (unreduced (rf result b))))]
(rf result)))
([result input]
(let [val (f input)]
(if (or (not @started) (= val @pv))
(do (vreset! started true) (vreset! pv val) (vswap! buf conj input) result)
(let [b @buf]
(vreset! buf []) (vreset! pv val)
(let [ret (rf result b)]
(when-not (reduced? ret) (vswap! buf conj input))
ret)))))))))
([f coll]
(let [step (fn step [s]
(lazy-seq
(let [s (seq s)]
(when s
(let [fst (first s)
fv (f fst)
run (cons fst (take-while (fn [x] (= fv (f x))) (rest s)))]
(cons run (step (lazy-seq (drop (count run) s)))))))))]
(step coll))))

View file

@ -0,0 +1,345 @@
;; clojure.core — collection tier. Pure, eager fns expressed as compositions of
;; already-frozen core primitives (reduce/assoc/get/conj/filter/vec/count/>=).
;; No host internals, no laziness, no macros — so they compile cleanly and stay
;; redefinable. Loaded after the seq tier; self-hosted in compile mode.
;;
;; Same migration rule as the seq tier (see 10-seq.clj): not in core-renames, no
;; internal Janet callers, not used by the self-hosted compiler.
;; Base is (hash-map), not the {} literal: a literal map is a struct that doesn't
;; canonicalize collection keys across representations (a {:a 1} literal vs
;; (hash-map :a 1) key), whereas a PHM does — so counting/grouping by collection
;; value needs the PHM base (the prior Janet impl used make-phm for this reason).
(defn frequencies [coll]
(reduce (fn [counts x] (assoc counts x (inc (get counts x 0)))) (hash-map) coll))
(defn group-by [f coll]
(reduce (fn [ret x] (let [k (f x)] (assoc ret k (conj (get ret k []) x)))) (hash-map) coll))
(defn not-empty [coll]
(if (or (nil? coll) (zero? (count coll))) nil coll))
(defn filterv [pred coll]
(vec (filter pred coll)))
;; Greatest/least x by (k x). Canonical Clojure multi-arity: the first pair uses
;; strict < / > and the fold uses <= / >= — this exact ordering reproduces the
;; JVM IEEE-754 NaN behavior (e.g. (min-key identity 1 ##NaN) => ##NaN). > / <
;; throw on non-numbers, as Clojure does.
(defn max-key
([k x] x)
([k x y] (if (> (k x) (k y)) x y))
([k x y & more]
(let [kx (k x) ky (k y)
v (if (> kx ky) x y)
kv (if (> kx ky) kx ky)]
(loop [v v kv kv more more]
(if (seq more)
(let [w (first more) kw (k w)]
(if (>= kw kv) (recur w kw (next more)) (recur v kv (next more))))
v)))))
(defn min-key
([k x] x)
([k x y] (if (< (k x) (k y)) x y))
([k x y & more]
(let [kx (k x) ky (k y)
v (if (< kx ky) x y)
kv (if (< kx ky) kx ky)]
(loop [v v kv kv more more]
(if (seq more)
(let [w (first more) kw (k w)]
(if (<= kw kv) (recur w kw (next more)) (recur v kv (next more))))
v)))))
;; Function combinators (pure HOFs).
(defn juxt [& fs]
(fn [& args] (mapv (fn [f] (apply f args)) fs)))
(defn every-pred [& preds]
(fn [& xs] (every? (fn [p] (every? p xs)) preds)))
(defn some [pred coll]
(when-let [s (seq coll)]
(or (pred (first s)) (recur pred (next s)))))
(defn some-fn [& preds]
(fn [& xs] (some (fn [p] (some p xs)) preds)))
(defn not-any? [pred coll] (not (some pred coll)))
(defn not-every? [pred coll] (not (every? pred coll)))
(defn split-at [n coll] [(take n coll) (drop n coll)])
(defn split-with [pred coll] [(take-while pred coll) (drop-while pred coll)])
(defn ident? [x] (or (keyword? x) (symbol? x)))
(defn qualified-ident? [x] (or (qualified-symbol? x) (qualified-keyword? x)))
(defn simple-ident? [x] (or (simple-symbol? x) (simple-keyword? x)))
;; Jolt has no ratio or bigdecimal types, so these are constants / reduce to int?.
(defn ratio? [x] false)
(defn decimal? [x] false)
(defn rational? [x] (int? x))
(defn nat-int? [x] (and (int? x) (>= x 0)))
(defn neg-int? [x] (and (int? x) (neg? x)))
(defn pos-int? [x] (and (int? x) (pos? x)))
(defn replicate [n x] (map (fn [_] x) (range n)))
(defn take-last [n coll]
(let [c (vec coll) len (count c)]
(when (pos? len) (subvec c (max 0 (- len n))))))
(defn drop-last
([coll] (drop-last 1 coll))
([n coll] (let [c (vec coll)] (subvec c 0 (max 0 (- (count c) n))))))
(defn distinct?
([x] true)
([x y] (not (= x y)))
([x y & more]
(if (not (= x y))
(loop [s #{x y} xs more]
(if xs
(let [x (first xs)]
(if (contains? s x) false (recur (conj s x) (next xs))))
true))
false)))
(defn replace [smap coll] (mapv (fn [x] (get smap x x)) coll))
(defn nthnext [coll n]
(loop [n n xs (seq coll)]
(if (and xs (pos? n))
(recur (dec n) (next xs))
xs)))
(defn bounded-count [n coll] (min n (count coll)))
(defn run! [proc coll] (reduce (fn [_ x] (proc x) nil) nil coll) nil)
(defn completing
([f] (completing f identity))
([f cf] (fn ([] (f)) ([x] (cf x)) ([x y] (f x y)))))
;; Matches Clojure exactly: n<=0 returns coll unchanged; for n>0 the walk yields
;; (seq xs), and an exhausted/nil walk falls back to () via (or ... ()) — so
;; (nthrest nil 100) is () (not nil), while (nthrest nil 0) is nil.
(defn nthrest [coll n]
(if (pos? n)
(or (loop [n n xs coll]
(let [s (and (pos? n) (seq xs))]
(if s (recur (dec n) (rest s)) (seq xs))))
(list))
coll))
(defn abs [x] (if (neg? x) (- 0 x) x))
(defn NaN? [x]
(if (number? x) (not (= x x)) (throw (str "NaN? requires a number"))))
;; No distinct host object / undefined types on Jolt.
(defn object? [x] false)
(defn undefined? [x] false)
(defn keyword-identical? [a b] (= a b))
(defn comparator [pred]
(fn [a b] (cond (pred a b) -1 (pred b a) 1 :else 0)))
;; Lazy: the running accumulators, one at a time (matches Clojure).
(defn reductions
([f coll]
(lazy-seq
(let [s (seq coll)]
(if s
(reductions f (first s) (rest s))
(list (f))))))
([f init coll]
(cons init
(lazy-seq
(when-let [s (seq coll)]
(reductions f (f init (first s)) (rest s)))))))
;; Lazy pre-order DFS (matches Clojure): node, then its children's walks spliced
;; via the (now lazy) mapcat.
(defn tree-seq [branch? children root]
(let [walk (fn walk [node]
(lazy-seq
(cons node
(when (branch? node)
(mapcat walk (children node))))))]
(walk root)))
;; Canonical flatten via tree-seq: the leaves (non-sequential nodes) in order.
;; Flattens lists too (sequential?), matching Clojure/CLJS.
(defn flatten [coll]
(filter (complement sequential?) (rest (tree-seq sequential? seq coll))))
;; xml-seq: tree-seq over XML element trees. Elements are maps with :content.
(defn xml-seq [root]
(tree-seq (complement string?) (comp seq :content) root))
;; Lazy interleave: round-robin one element from each coll until any exhausts.
(defn interleave
([] ())
([c1] (lazy-seq c1))
([c1 c2]
(lazy-seq
(let [s1 (seq c1) s2 (seq c2)]
(when (and s1 s2)
(cons (first s1)
(cons (first s2)
(interleave (rest s1) (rest s2))))))))
([c1 c2 & cs]
(lazy-seq
(let [ss (map seq (list* c1 c2 cs))]
(when (every? identity ss)
(concat (map first ss)
(apply interleave (map rest ss))))))))
;; No ratio type on Jolt, so rationalize is identity.
(defn rationalize [x] x)
;; trampoline: repeatedly calls f with args until a non-function result.
;; rand-int: random integer in [0, n). Uses Janet math/random.
;; Eager dedupe of consecutive equal elements (Jolt has no transducer arity yet).
(defn dedupe [coll]
(let [step (fn step [s prev]
(make-lazy-seq
(fn* []
(let [s (seq s)]
(if s
(let [x (first s)]
(if (= x prev)
(coll->cells (step (rest s) prev))
(coll->cells (cons x (step (rest s) x)))))
nil)))))]
(let [s (seq coll)]
(if s
(make-lazy-seq
(fn* [] (coll->cells (cons (first s) (step (rest s) (first s))))))
()))))
;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs:
;; builds a map from consecutive pairs, dropping a trailing unpaired element.
(defn seq-to-map-for-destructuring [s]
(if (sequential? s)
(loop [m {} xs (seq s)]
(if (and xs (next xs))
(recur (assoc m (first xs) (second xs)) (next (next xs)))
m))
s))
;; Phase 4 (jolt-1j0): host-coupled fns that are pure logic over existing core
;; primitives, so they need no new jolt.host surface.
;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and
;; with-meta are the irreducible host primitives; vary-meta is just their compose.
(defn vary-meta [obj f & args]
(with-meta obj (apply f (meta obj) args)))
;; namespace-munge: Clojure namespace name -> legal Java package name (- -> _).
(defn namespace-munge [s]
(apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s)))))
;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce,
;; so reduced short-circuits — and the vector path indexes correctly. (The prior
;; Janet version saw a pvec as a table and folded over its internal keys; it also
;; ignored reduced.) nil folds to init, matching Clojure.
(defn reduce-kv [f init coll]
(cond
(vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll)))
(map? coll) (reduce (fn [acc k] (f acc k (get coll k))) init (keys coll))
(nil? coll) init
:else (throw (str "reduce-kv not supported on: " coll))))
;; ex-info accessors. The Janet constructor (ex-info) stays — it builds the tagged
;; value and wires into throw — but the value exposes :jolt/type/:message/:data/
;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives
;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first.
(defn- ex-info-val? [x] (= (get x :jolt/type) :jolt/ex-info))
(defn- ex-unwrap [e]
(if (= (get e :jolt/type) :jolt/exception) (get e :value) e))
(defn ex-data [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :data) nil)))
(defn ex-message [e]
(let [e (ex-unwrap e)]
(cond (ex-info-val? e) (get e :message)
(string? e) e
:else nil)))
(defn ex-cause [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
;; Tagged-value predicates. The constructors (atom/volatile!/...) stay in Janet,
;; but every tagged value carries its kind under :jolt/type (records under
;; :jolt/deftype), reachable via get — which is nil on non-tables — so the
;; predicates are pure over get and move out of the seed.
(defn atom? [x] (= (get x :jolt/type) :jolt/atom))
(defn volatile? [x] (= (get x :jolt/type) :jolt/volatile))
(defn reader-conditional? [x] (= (get x :jolt/type) :jolt/reader-conditional))
(defn tagged-literal? [x] (= (get x :jolt/type) :jolt/tagged-literal))
(defn record? [x] (some? (get x :jolt/deftype)))
;; Jolt has no chunked seqs (Phase 5 territory), so this is always false.
(defn chunked-seq? [x] false)
;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler
;; depends on them and they're hot. swap-vals!/reset-vals!/compare-and-set! compose
;; the native ops (which already validate and notify watches); get-validator reads a
;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches
;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal
;; mutation kernel the overlay can't express over core fns (a nil value removes the
;; key). compare-and-set! compares by value, matching the prior Janet behavior.
(defn swap-vals! [a f & args]
(let [old (deref a)] [old (apply swap! a f args)]))
(defn reset-vals! [a newval]
(let [old (deref a)] (reset! a newval) [old newval]))
(defn compare-and-set! [a oldval newval]
(if (= oldval (deref a)) (do (reset! a newval) true) false))
(defn get-validator [a] (get a :validator))
(defn add-watch [a key f]
(jolt.host/ref-put! (get a :watches) key f) a)
(defn remove-watch [a key]
(jolt.host/ref-put! (get a :watches) key nil) a)
(defn set-validator! [a f]
(jolt.host/ref-put! a :validator f) nil)
;; Volatiles. The constructor (volatile!) stays native — it builds the mutable box —
;; but vreset! sets the box's slot through ref-put! and vswap! is pure over it + get.
(defn vreset! [vol newval]
(jolt.host/ref-put! vol :val newval) newval)
(defn vswap! [vol f & args]
(vreset! vol (apply f (get vol :val) args)))
;; Future status predicates — pure reads of the future's :cached/:cancelled slots.
;; future? stays native (deref/future-cancel/realized? call it); future-call and
;; future-cancel stay native too (OS threads).
(defn future-done? [x]
(if (future? x) (boolean (get x :cached)) (throw "future-done? requires a future")))
(defn future-cancelled? [x]
(and (future? x) (boolean (get x :cancelled))))
;; ns-name: a namespace object's :name as a symbol. Pure over get + symbol.
(defn ns-name [ns]
(let [nm (get ns :name)] (if nm (symbol (str nm)) nil)))
;; Java-array element access. Jolt arrays are mutable backing arrays; aget/alength
;; read them (nth/count) and aset writes a slot through ref-put!. Both handle the
;; multi-dimensional form (aget a i j ... / aset a i j ... v) by walking. The array
;; constructors (object-array/make-array/to-array/...) stay native — they build the
;; mutable backing.
(defn aget [arr & idxs]
(reduce (fn [v i] (nth v i)) arr idxs))
(defn alength [arr] (count arr))
(defn aset [arr & idxs+val]
(let [n (count idxs+val)
val (nth idxs+val (dec n))
target (reduce (fn [t k] (nth t k)) arr (take (- n 2) idxs+val))]
(jolt.host/ref-put! target (nth idxs+val (- n 2)) val)
val))

View file

@ -0,0 +1,226 @@
;; clojure.core — macro tier. Macros expressed in Clojure (defmacro + syntax-quote)
;; rather than as hand-built Janet form-transformers. Loaded after the fn tiers,
;; so a macro here may use any already-frozen core fn/macro.
;;
;; IMPORTANT — only macros NOT used by the self-hosted compiler (jolt-core/jolt/*)
;; or by the earlier overlay tiers belong here; those (and/or/when/when-not/
;; when-let/cond/case/doseq/declare/cond->/->) must stay available before this
;; tier loads, so they remain in Janet for now. Everything here is user-facing.
;;
;; Migration: remove the Janet core-X macro fn AND its core-macro-names entry when
;; moving a macro here (defmacro installs the :macro flag itself).
(defmacro comment [& body] nil)
;; Single arglist (Jolt defmacro is single-arity); the optional else defaults nil
;; via rest-destructuring.
(defmacro if-not [test then & [else]]
`(if (not ~test) ~then ~else))
;; Conditional binding macros: the name is bound ONLY in the taken branch (the
;; auto-gensym temp# tests the value; the else/empty branch sees the surrounding
;; scope). temp# is a single template-local gensym — referenced twice, same symbol.
(defmacro if-let [bindings then & [else]]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if temp# (let [~form temp#] ~then) ~else))))
;; when-let lives in 00-syntax (not here): 20-coll uses it, which loads before this tier.
(defmacro if-some [bindings then & [else]]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if (some? temp#) (let [~form temp#] ~then) ~else))))
(defmacro when-some [bindings & body]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if (some? temp#) (let [~form temp#] ~@body) nil))))
(defmacro while [test & body]
`(loop [] (when ~test ~@body (recur))))
(defmacro dotimes [bindings & body]
(let [i (bindings 0) n (bindings 1)]
`(let [n# ~n]
(loop [~i 0]
(when (< ~i n#) ~@body (recur (inc ~i)))))))
;; A fresh jolt symbol inside a macro body: (gensym) here resolves to Janet's
;; builtin (a Janet symbol the destructurer rejects), so round-trip through str.
(defn- fresh-sym [] (symbol (str (gensym))))
;; Lazy-safe: take only the head via first (Clojure uses (seq coll), but Jolt's
;; eager seq would realize an infinite coll like (repeat nil) and hang). Matches
;; the prior Janet behavior; the nil/false-head distinction waits on Phase 5
;; laziness.
(defmacro when-first [bindings & body]
(let [x (bindings 0) coll (bindings 1)]
`(when-let [~x (first ~coll)] ~@body)))
;; doto threads a single fresh-bound value as the first arg of each form (side
;; effects), returning the value. A shared explicit gensym is needed because the
;; forms are built outside the let's template.
(defmacro doto [x & forms]
(let [g (fresh-sym)
steps (map (fn [f] (if (seq? f) (apply list (first f) g (rest f)) (list f g))) forms)]
`(let [~g ~x] ~@steps ~g)))
;; Threading-with-rebinding macros. The binding pairs are spliced into a TEMPLATE
;; vector (so core-let sees a tuple form, not a runtime pvec value).
(defn- thread-binds [g steps]
(reduce (fn [acc s] (conj (conj acc g) s)) [] (butlast steps)))
(defmacro as-> [expr name & forms]
(let [pairs (reduce (fn [acc f] (conj (conj acc name) f)) [] (butlast forms))]
`(let [~name ~expr ~@pairs] ~(if (empty? forms) name (last forms)))))
(defmacro some-> [expr & forms]
(let [g (fresh-sym)
steps (map (fn [f] `(if (nil? ~g) nil (-> ~g ~f))) forms)]
`(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps)))))
(defmacro some->> [expr & forms]
(let [g (fresh-sym)
steps (map (fn [f] `(if (nil? ~g) nil (->> ~g ~f))) forms)]
`(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps)))))
(defmacro cond->> [expr & clauses]
(let [g (fresh-sym)
steps (map (fn [pair] `(if ~(first pair) (->> ~g ~(second pair)) ~g))
(partition 2 clauses))]
`(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps)))))
(defmacro assert [x & [message]]
(let [msg (if message message (str "Assert failed: " (pr-str x)))]
`(when-not ~x (throw (ex-info ~msg {})))))
(defmacro delay [& body]
`(make-delay (fn [] ~@body)))
(defmacro future [& body]
`(future-call (fn [] ~@body)))
;; Build the fn* form via a template (a reader-list array): cons/list in a macro
;; body produce a plist the evaluator can't call as a form.
(defmacro letfn [fnspecs & body]
(let [binds (reduce (fn [acc spec] (conj (conj acc (first spec)) `(fn* ~@(rest spec))))
[] fnspecs)]
`(let* [~@binds] ~@body)))
;; Dynamic binding: install a thread-binding frame of var->value (array-map keeps
;; var-get happy, unlike a phm), restore on exit.
(defmacro binding [bindings & body]
(let [pairs (reduce (fn [acc p] (conj (conj acc `(var ~(first p))) (second p)))
[] (partition 2 bindings))]
`(let* [frame# (array-map ~@pairs)]
(push-thread-bindings frame#)
(try (do ~@body) (finally (pop-thread-bindings))))))
;; condp: clauses are test-expr result-expr, or test-expr :>> result-fn (calls
;; result-fn on the truthy (pred test-expr value)); a lone trailing expr is the
;; default. The recursive emit builds a nested if chain.
(defmacro condp [pred expr & clauses]
(let [gp (fresh-sym) ge (fresh-sym)
emit (fn emit [args]
(let [n (if (= :>> (second args)) 3 2)
clause (take n args)
more (drop n args)
cn (count clause)]
(cond
(= 0 cn) `(throw (ex-info (str "No matching clause: " ~ge) {}))
(= 1 cn) (first clause)
(= 2 cn) `(if (~gp ~(first clause) ~ge) ~(second clause) ~(emit more))
:else `(if-let [p# (~gp ~(first clause) ~ge)]
(~(nth clause 2) p#)
~(emit more)))))]
`(let [~gp ~pred ~ge ~expr] ~(emit clauses))))
;; --- protocols, records, types ---------------------------------------------
;; These emit Jolt's protocol/type special forms (protocol-dispatch,
;; register-method, make-reified, deftype).
;; Group a flat seq that starts with a head symbol followed by its list specs
;; into [[head spec spec ...] ...] runs. Used by extend-protocol and defrecord.
(defn- group-by-head [items]
(reduce (fn [acc x]
(if (symbol? x)
(conj acc [x])
(conj (pop acc) (conj (peek acc) x))))
[] items))
;; The protocol value is built by make-protocol (a fn call) rather than an embedded
;; tagged map literal: the interpreter would otherwise self-evaluate such a struct
;; instead of evaluating its fields. methods is a {kw {:name str}} map (only :name
;; is consulted). Each method is a thin dispatch fn over protocol-dispatch.
(defmacro defprotocol [pname & sigs]
(let [methods (reduce (fn [m sig]
(assoc m (keyword (name (first sig))) {:name (name (first sig))}))
{} sigs)]
`(do
(def ~pname (make-protocol ~(name pname) ~methods))
~@(map (fn [sig]
`(def ~(first sig)
(fn* [this# & rest#] (protocol-dispatch ~pname ~(first sig) this# rest#))))
sigs))))
(defmacro extend-type [tsym psym & impls]
`(do ~@(map (fn [spec]
`(register-method ~tsym ~psym ~(first spec)
(fn* ~(nth spec 1) ~@(drop 2 spec))))
impls)))
(defmacro extend-protocol [psym & type-impls]
`(do ~@(map (fn [g] `(extend-type ~(first g) ~psym ~@(rest g)))
(group-by-head type-impls))))
;; extend (the fn form) is not supported — stub to nil, as before.
(defmacro extend [& args] nil)
;; JVM proxies are unsupported.
(defmacro proxy [& args] nil)
;; definterface is JVM-only; bind the name to an empty marker.
(defmacro definterface [name-sym & body] `(def ~name-sym {}))
;; Build a method map {kw (fn* ...)} as an embedded map literal — make-reified
;; evaluates it (the fn* forms become fns) via build-eval-map, which yields a
;; struct it can iterate; a (hash-map ...) call would instead yield a phm it can't.
(defmacro reify [& forms]
(loop [items (seq forms) proto nil methods {}]
(if (empty? items)
`(make-reified ~proto ~methods)
(let [x (first items)]
(if (symbol? x)
(recur (rest items) (if proto proto x) methods)
(recur (rest items) proto
(assoc methods (keyword (name (first x)))
`(fn* ~(nth x 1) ~@(drop 2 x)))))))))
(defmacro defrecord [name-sym fields & body]
(let [tn (name name-sym)
dot (symbol (str tn "."))
arrow (symbol (str "->" tn))
mapf (symbol (str "map->" tn))
m (fresh-sym)
;; each method body sees the record fields, bound from the instance (the
;; method's first param), matching Clojure's defrecord method scope. vec the
;; spliced binding seq so ~@ splices its elements, not the lazy-seq itself.
impl (fn [proto specs]
`(extend-type ~name-sym ~proto
~@(map (fn [spec]
(let [argv (nth spec 1)
inst (first argv)
binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
`(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec)))))
specs)))]
`(do
(deftype ~name-sym ~fields)
(def ~arrow (fn* ~fields (~dot ~@fields)))
(def ~mapf (fn* [~m] (~arrow ~@(map (fn [f] `(get ~m ~(keyword (name f)))) fields))))
~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body)))))
;; --- laziness --------------------------------------------------------------
;; lazy-seq / lazy-cat moved to the 00-syntax tier: the seq/coll tiers (10-seq,
;; 20-coll) use lazy-seq, and in compile mode a tier's forms are compiled as it
;; loads — so the macro must be registered BEFORE those tiers, else (lazy-seq …)
;; compiles as a call to the macro-as-function and leaks its expansion at runtime
;; (jolt-r81). They only need seed fns (make-lazy-seq/coll->cells/concat).

View file

@ -0,0 +1,100 @@
;; clojure.core — lazy tier. Canonical CLJS-based lazy seq fns.
;; Loaded after 30-macros.clj, so lazy-seq macro is available.
;;
;; Each fn ported from CLJS core.cljs, stripped of chunked-seq branches.
;; --- distinct ---
(defn distinct [coll]
(let [step (fn step [xs seen]
(lazy-seq
((fn [[f :as xs] seen]
(when-let [s (seq xs)]
(if (contains? seen f)
(recur (rest s) seen)
(cons f (step (rest s) (conj seen f))))))
xs seen)))]
(step coll #{})))
;; --- keep ---
(defn keep
([f]
(fn [rf]
(fn ([] (rf)) ([result] (rf result))
([result input]
(let [v (f input)]
(if (nil? v) result (rf result v)))))))
([f coll]
(lazy-seq
(when-let [s (seq coll)]
(let [x (f (first s))]
(if (nil? x)
(keep f (rest s))
(cons x (keep f (rest s)))))))))
;; --- keep-indexed ---
(defn keep-indexed
([f]
(fn [rf]
(let [ia (volatile! -1)]
(fn ([] (rf)) ([result] (rf result))
([result input]
(let [i (vswap! ia inc)
v (f i input)]
(if (nil? v) result (rf result v))))))))
([f coll]
(letfn [(keepi [idx coll]
(lazy-seq
(when-let [s (seq coll)]
(let [x (f idx (first s))]
(if (nil? x)
(keepi (inc idx) (rest s))
(cons x (keepi (inc idx) (rest s))))))))]
(keepi 0 coll))))
;; --- map-indexed ---
(defn map-indexed
([f]
(fn [rf]
(let [i (volatile! -1)]
(fn ([] (rf)) ([result] (rf result))
([result input] (rf result (f (vswap! i inc) input)))))))
([f coll]
(letfn [(mapi [idx coll]
(lazy-seq
(when-let [s (seq coll)]
(cons (f idx (first s)) (mapi (inc idx) (rest s))))))]
(mapi 0 coll))))
;; --- cycle ---
(defn cycle [coll]
(if-let [vals (seq coll)]
(let [n (count vals)]
(letfn [(cstep [i]
(lazy-seq
(cons (nth vals (mod i n)) (cstep (inc i)))))]
(cstep 0)))
()))
;; --- repeatedly ---
(defn repeatedly
([f] (lazy-seq (cons (f) (repeatedly f))))
([n f] (take n (repeatedly f))))
;; --- repeat ---
(defn repeat
([x] (lazy-seq (cons x (repeat x))))
([n x] (take n (repeat x))))
;; --- iterate ---
(defn iterate [f x]
(lazy-seq (cons x (iterate f (f x)))))
;; --- partition-all ---
(defn partition-all
([n coll] (partition-all n n coll))
([n step coll]
(lazy-seq
(when-let [s (seq coll)]
(cons (take n s) (partition-all n step (nthrest coll step)))))))

View file

@ -0,0 +1,96 @@
# clojure.core migration worklist (jolt-1j0)
Tracking the move of clojure.core from native Janet (`src/jolt/core.janet`,
4145 lines / 421 `core-*` fns) into the self-hosted Clojure overlay
(`jolt-core/clojure/core/`). Goal: shrink the Janet seed to `core-renames` +
genuinely host-coupled fns.
## Phase 0 classification (heuristic — validate per batch)
| Bucket | Count | Disposition |
|---|---|---|
| SEED (in `compiler/core-renames`) | 73 | stay in Janet (compiler emits `core-X` directly) |
| MACRO (in `core-macro-names`) | 44 | Phase 3 |
| HOST-coupled (atoms/vars/meta/proxy/transient/arrays/futures/ns/io) | 80 | Phase 4 (where feasible) / stay |
| LAZY-coupled | 28 | Phase 5 |
| MOVABLE pure-eager (candidates) | 193 | **Phase 2** |
Counts are heuristic (name + body markers); the MOVABLE list still has some
host/lazy leakage (e.g. transient `assoc!`/`conj!`, `doall`/`dorun`,
`chunk-*`, `deliver`) to filter out as each batch is actually moved.
**Key finding:** after removing SEED + HOST, the self-hosted compiler
(`jolt-core/jolt/{ir,analyzer}.clj`) uses **no** additional clojure.core fns
beyond the kernel tier (`second`/`peek`/`subvec`/`mapv`/`update`) plus host
primitives (`atom`/`swap!`/`reset!`). So **Phase 1 (compiler-dep kernel tier)
is essentially already complete** — to verify, not build.
## Performance baseline (test/bench/core-bench.janet, compile mode, min of 5, ms)
| bench | ms |
|---|---|
| fib | 128 |
| seq-pipe | 88 |
| reduce | 391 |
| into-vec | 194 |
| map-build | 681 |
| map-read | 6 |
| str-join | 244 |
| hof | 604 |
| **TOTAL** | **2336** |
Re-run after each phase; watch for regressions as fns move from native Janet to
self-hosted Clojure (interpreted/compiled, slower than native primitives).
## Per-batch workflow + gate (every migration step)
1. Canonical Clojure def in the overlay tier; remove the Janet `core-X` defn +
its `core-bindings` entry (confirm leaf first: only defn+binding refs).
2. **Add regression tests** for each moved fn — spec cases (test/spec/*-spec.janet,
interpret) and, for any fn whose behavior is subtle or was buggy, a case in the
3-mode conformance set (test/integration/conformance-test.janet).
3. Gate: conformance ×3 modes · clojure-test-suite ≥ baseline · stage2==stage3
fixpoint · fib compiled-fast · core-bench A/B under identical load (the
absolute number is load-sensitive — compare batch-vs-prior back to back).
If a moved fn surfaces a latent bug (e.g. nthrest's nil-vs-() result, the
if-let/when-let else-scope leak), fix it to match Clojure and add a regression
test, rather than preserving the bug.
## MOVABLE candidates (Phase 2 worklist, 193)
>Eduction NaN? abs aclone alength ancestors array-map array-seq assoc! associative? bean bigdec bigint biginteger boolean boolean? booleans byte bytes bytes? cat char char-escape-string char-name-string char? chars chunk chunk-append chunk-buffer chunk-cons chunk-first chunk-next chunk-rest chunked-seq? class clojure-version comparator compare-and-set! completing conj! counted? decimal? deliver denominator derive descendants destructure disj disj! dissoc! distinct? doall dorun double? doubles drop-last eduction empty ensure-reduced enumeration-seq ex-cause ex-data ex-info ex-info? ex-message find float? floats force halt-when hash-combine hash-map hash-ordered-coll hash-set hash-unordered-coll ident? ifn? indexed? infinite? inst-ms inst? integer? ints isa? iterator-seq key keyword keyword-identical? list* list? longs macrofy map-entry? memfn munge nat-int? neg-int? not-any? not-every? nthnext nthrest numerator numeric= object? parents persistent! pop pop! pos-int? pr prefers println-str prn-str promise qualified-ident? qualified-keyword? qualified-symbol? rand rand-nth random-sample ratio? rational? rationalize re-groups re-matcher record? reduce-kv reduced reduced? reductions replace replicate resolve reversible? rseq rsubseq run! seq-to-map-for-destructuring seque set set? short shorts shuffle simple-ident? simple-keyword? simple-symbol? some-search sort sort-by sorted-map sorted-map-by sorted-map? sorted-set sorted-set-by sorted-set? special-symbol? split-at split-with str-join str-replace-all str-replace-first str-split subseq supers symbol tagged-literal tagged-literal? take-last test transduce unchecked-add unchecked-byte unchecked-char unchecked-dec unchecked-divide-int unchecked-double unchecked-float unchecked-inc unchecked-int unchecked-multiply unchecked-negate unchecked-remainder-int unchecked-short unchecked-subtract undefined? underive uri? uuid? val vector volatile! volatile? xml-seq
## HOST-coupled (Phase 4 / stay, 80)
add-watch aget alter-meta! alter-var-root aset aset-boolean aset-byte aset-char aset-double aset-float aset-int aset-long aset-short atom atom? avoid-method-too-large boolean-array bounded-count byte-array char-array construct-proxy copy-core-var copy-var delay? deref double-array float-array future-call future-cancel future-cancelled? future-done? future? get-proxy-class get-validator init-proxy int-array intern into-array long-array make-array make-delay meta namespace namespace-munge new-var ns-name object-array pop-thread-bindings prefer-method print-dup print-method print-str proxy-call-with-super proxy-mappings proxy-super push-thread-bindings reader-conditional reader-conditional? remove-watch reset! reset-meta! reset-vals! set-validator! short-array swap! swap-vals! thread-first thread-last to-array to-array-2d transient transient? update-proxy var-dynamic? var-get var-set var? vary-meta vreset! vswap! with-meta
## LAZY-coupled (Phase 5, 28)
concat cycle dedupe distinct flatten interleave interpose iterate keep keep-indexed line-seq macro-names map-indexed mapcat partition partition-all partition-by rand-int random-uuid realized? repeat repeatedly seqable? sequence sequential? take-nth trampoline tree-seq unreduced
## Phase 3 (macros) — status & findings
20 macros moved to the overlay: 19 user-facing in `30-macros.clj`, plus `when`
in a new `00-syntax.clj` tier loaded **before** the kernel (interpreted defmacros,
so the macros exist before any code that uses them compiles).
Macro-authoring toolkit for jolt (learned the hard way):
- single-template hygiene: auto-gensym `foo#`
- shared explicit fresh symbol: `(symbol (str (gensym)))` — a bare `(gensym)` in a
macro body returns a *Janet* symbol the destructurer rejects
- let-rebinding: splice binding *pairs* into a TEMPLATE vector (`[~a ~b ~@pairs]`),
not a pre-built pvec value — `core-let` wants a tuple form
- build sub-forms via templates, never `cons`/`list` (those make plists the
evaluator can't run as a form)
- Jolt `defmacro` is **single-arity** — use `& rest`/destructuring
- syntax-tier macros may use only special forms + core-renames seed primitives
**Performance wall (the hot macros stay in Janet for now):** the load-order story
works, but moving the *hot* fundamental control macros (`and`/`or`/`cond`/
`when-not`) regressed the battery — as interpreted overlay defmacros they expand
slower than native Janet, and since they appear in nearly every form the
cumulative overhead tipped a heavy suite file over the 6 s per-file timeout
(3930 -> 3911, +1 timeout). They are correct (conformance 228×3, all edge cases),
but reverted. Moving `and/or/cond/when-not/case/doseq/declare/cond->/->/->>`
needs a **fast (compiled) macro-expansion path**, not interpreted defmacros.
Deferred: `defn/defn-/fn/let/loop` (fundamental + same speed concern), the type
machinery (`defrecord/defprotocol/extend-*/reify/proxy/definterface` → Phase 4),
`lazy-seq/lazy-cat` (→ Phase 5).

212
jolt-core/jolt/analyzer.clj Normal file
View file

@ -0,0 +1,212 @@
(ns jolt.analyzer
"Portable Clojure analyzer: reader form -> host-neutral IR (see jolt.ir).
Pure jolt-core depends only on the host contract (jolt.host) and IR
constructors (jolt.ir), never on Janet. The contract fns are referred unqualified
(host form predicates are `form-*` to avoid colliding with clojure.core), so the
bootstrap can compile this namespace via its plain :var path. ctx is an opaque
host handle threaded to the contract fns; the analyzer never inspects it.
Coverage grows toward compiler.janet; unsupported forms throw :jolt/uncompilable
so the caller falls back to the interpreter (the hybrid contract).
`env` carries lexical state: {:locals #{names} :recur recur-target-name|nil}.
Definitions are ordered so only `analyze` (mutually recursive) is forward
declared the bootstrap compiles forward refs through var cells, but keeping
them to one keeps the compiled namespace simple."
(:require [jolt.ir :refer [const local var-ref host-ref if-node do-node invoke
def-node let-node fn-node vector-node map-node
quote-node throw-node]]
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list?
form-vec? form-map? form-set? form-char?
form-literal? form-elements form-vec-items
form-map-pairs form-special? compile-ns
form-macro? form-expand-1 resolve-global
form-sym-meta host-intern! form-syntax-quote-lower]]))
(declare analyze)
(def ^:private handled
#{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try"
"syntax-quote"})
(defn- uncompilable [why]
(throw (str "jolt/uncompilable: " why)))
(def ^:private gensym-counter (atom 0))
(defn- gen-name [prefix]
(let [n @gensym-counter]
(swap! gensym-counter inc)
(str "_r$" prefix n)))
(defn- empty-env [] {:locals #{}})
(defn- local? [env nm] (contains? (:locals env) nm))
(defn- add-locals [env names] (update env :locals #(reduce conj % names)))
(defn- with-recur [env name] (assoc env :recur name))
(defn- analyze-seq [ctx forms env]
(let [v (mapv #(analyze ctx % env) forms)
n (count v)]
(cond
(zero? n) (const nil)
(= 1 n) (first v)
:else (do-node (subvec v 0 (dec n)) (peek v)))))
(defn- analyze-bindings [ctx bvec env]
(loop [i 0 env env pairs []]
(if (< i (count bvec))
(let [bsym (nth bvec i)]
(when-not (form-sym? bsym) (uncompilable "destructuring binding"))
(let [nm (form-sym-name bsym)
init (analyze ctx (nth bvec (inc i)) env)]
(recur (+ i 2) (add-locals env [nm]) (conj pairs [nm init]))))
[pairs env])))
(defn- parse-params [pvec]
(loop [i 0 fixed [] rest-name nil]
(if (< i (count pvec))
(let [p (nth pvec i)]
(when-not (form-sym? p) (uncompilable "destructuring fn param"))
(if (= "&" (form-sym-name p))
(let [r (nth pvec (inc i))]
(when-not (form-sym? r) (uncompilable "destructuring fn rest"))
(recur (+ i 2) fixed (form-sym-name r)))
(recur (inc i) (conj fixed (form-sym-name p)) rest-name)))
{:fixed fixed :rest rest-name})))
(defn- analyze-arity [ctx pvec body env fn-name]
(let [pp (parse-params (vec (form-vec-items pvec)))
fixed (:fixed pp)
rst (:rest pp)
;; Always a recur target, variadic included: the back end gives the rest
;; param an ordinary positional slot (holding the collected seq), so recur
;; is a self-call carrying the rest seq directly — Clojure semantics.
rname (gen-name "arity")
names (cond-> (vec fixed) rst (conj rst) fn-name (conj fn-name))
env* (-> (add-locals env names) (with-recur rname))
arity {:params fixed :recur-name rname
:body (analyze-seq ctx body env*)}]
;; :rest only when variadic — an absent :rest reads back nil, same as before,
;; but keeps a fixed arity a nil-free struct rather than a phm.
(if rst (assoc arity :rest rst) arity)))
(defn- analyze-fn [ctx items env]
(let [named (form-sym? (nth items 1))
fn-name (when named (form-sym-name (nth items 1)))
rest-items (if named (drop 2 items) (drop 1 items))
first* (first rest-items)]
(cond
(form-vec? first*)
(fn-node fn-name [(analyze-arity ctx first* (rest rest-items) env fn-name)])
(form-list? first*)
(fn-node fn-name
(mapv (fn [clause]
(let [cl (vec (form-elements clause))]
(analyze-arity ctx (first cl) (rest cl) env fn-name)))
rest-items))
:else (uncompilable "fn: bad params"))))
(defn- analyze-try [ctx items env]
(let [clauses (rest items)
body (atom [])
catch-sym (atom nil)
catch-body (atom nil)
finally-body (atom nil)]
(doseq [c clauses]
(let [head (when (form-list? c) (first (vec (form-elements c))))
hname (when (and head (form-sym? head)) (form-sym-name head))]
(cond
(= hname "catch")
(let [cl (vec (form-elements c))]
(reset! catch-sym (form-sym-name (nth cl 2)))
(reset! catch-body (drop 3 cl)))
(= hname "finally")
(reset! finally-body (rest (vec (form-elements c))))
:else (swap! body conj c))))
{:op :try
:body (analyze-seq ctx @body env)
:catch-sym @catch-sym
:catch-body (when @catch-body
(analyze-seq ctx @catch-body (add-locals env [@catch-sym])))
:finally (when @finally-body (analyze-seq ctx @finally-body env))}))
(defn- analyze-special [ctx op items env]
(case op
"quote" (quote-node (second items))
"if" (if-node (analyze ctx (nth items 1) env)
(analyze ctx (nth items 2) env)
(if (> (count items) 3)
(analyze ctx (nth items 3) env)
(const nil)))
"do" (analyze-seq ctx (rest items) env)
"throw" (throw-node (analyze ctx (nth items 1) env))
"def" (let [name-sym (nth items 1)
nm (form-sym-name name-sym)
cur (compile-ns ctx)]
(host-intern! ctx cur nm)
(def-node cur nm (analyze ctx (nth items 2) env) (form-sym-meta name-sym)))
"let*" (let [bvec (vec (form-vec-items (nth items 1)))
r (analyze-bindings ctx bvec env)]
(let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))
"loop*" (let [bvec (vec (form-vec-items (nth items 1)))
rname (gen-name "loop")
r (analyze-bindings ctx bvec env)
env** (with-recur (second r) rname)]
{:op :loop :recur-name rname :bindings (first r)
:body (analyze-seq ctx (drop 2 items) env**)})
"recur" (let [rt (:recur env)]
(when-not rt (uncompilable "recur outside loop/fn"))
{:op :recur :recur-name rt
:args (mapv #(analyze ctx % env) (rest items))})
"try" (analyze-try ctx items env)
"fn*" (analyze-fn ctx items env)
;; Lower the backtick to construction code (zero runtime cost), then analyze
;; it — the macroexpand/compile-time step, per read -> macroexpand -> compile.
"syntax-quote" (analyze ctx (form-syntax-quote-lower ctx (second items)) env)
(uncompilable (str "special form " op))))
(defn- analyze-symbol [ctx form env]
(let [nm (form-sym-name form) ns (form-sym-ns form)]
(cond
(and (nil? ns) (local? env nm)) (local nm)
ns (let [r (resolve-global ctx form)]
(if (= :var (:kind r))
(var-ref (:ns r) (:name r))
(uncompilable (str "qualified ref " ns "/" nm))))
:else (let [r (resolve-global ctx form)]
(case (:kind r)
:var (var-ref (:ns r) (:name r))
:host (host-ref (:name r))
(var-ref (compile-ns ctx) nm))))))
(defn- analyze-list [ctx form env]
(let [items (vec (form-elements form))]
(if (zero? (count items))
(quote-node form)
(let [head (first items)
hname (when (and (form-sym? head) (nil? (form-sym-ns head))) (form-sym-name head))
shadowed (and hname (local? env hname))]
(cond
(and hname (not shadowed) (contains? handled hname))
(analyze-special ctx hname items env)
(and hname (not shadowed) (form-special? hname))
(uncompilable (str "special form " hname))
(and (form-sym? head) (not shadowed) (form-macro? ctx head))
(analyze ctx (form-expand-1 ctx form) env)
:else
(invoke (analyze ctx head env)
(mapv #(analyze ctx % env) (rest items))))))))
(defn analyze
([ctx form] (analyze ctx form (empty-env)))
([ctx form env]
(cond
(form-literal? form) (const form)
(form-sym? form) (analyze-symbol ctx form env)
(form-vec? form) (vector-node (mapv #(analyze ctx % env) (form-vec-items form)))
(form-map? form) (map-node (mapv (fn [p] [(analyze ctx (first p) env)
(analyze ctx (second p) env)])
(form-map-pairs form)))
(form-set? form) (uncompilable "set literal")
(form-list? form) (analyze-list ctx form env)
:else (uncompilable "unsupported form"))))

57
jolt-core/jolt/ir.clj Normal file
View file

@ -0,0 +1,57 @@
(ns jolt.ir
"Host-neutral intermediate representation for the Jolt compiler.
The analyzer (jolt.analyzer) produces IR; a host back end consumes it. IR nodes
are plain maps tagged with :op no host values embedded. Globals reference vars
by name (:ns/:name), never by a host var cell, so the IR is portable and
AOT-safe. This namespace is pure Clojure (portable jolt-core): it depends on
nothing host-specific.")
;; Node constructors. Kept as data so any back end can pattern-match on :op.
(defn const [v] {:op :const :val v})
(defn local [name] {:op :local :name name})
;; A global var reference, by name. The back end resolves it to a host var.
(defn var-ref [ns name] {:op :var :ns ns :name name})
;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT.
(defn rt [name] {:op :rt :name name})
;; A name that resolves only via the host's own environment (e.g. + or int? on
;; Janet) — the back end emits a host-appropriate reference.
(defn host-ref [name] {:op :host :name name})
(defn if-node [test then else] {:op :if :test test :then then :else else})
(defn do-node [statements ret] {:op :do :statements statements :ret ret})
(defn invoke [f args] {:op :invoke :fn f :args args})
;; meta is the var metadata (e.g. {:dynamic true} / {:redef true}) the back end
;; applies to the cell; absent when the def name carried none.
(defn def-node
([ns name init] {:op :def :ns ns :name name :init init})
([ns name init meta]
(if meta
{:op :def :ns ns :name name :init init :meta meta}
{:op :def :ns ns :name name :init init})))
(defn let-node [bindings body] {:op :let :bindings bindings :body body})
;; A fn is one or more arities. Each arity: {:params [..] :body ir}, plus :rest
;; name when variadic. :name is absent for an anonymous fn.
(defn fn-node [name arities]
(if name
{:op :fn :name name :arities arities}
{:op :fn :arities arities}))
(defn vector-node [items] {:op :vector :items items})
(defn map-node [pairs] {:op :map :pairs pairs})
(defn set-node [items] {:op :set :items items})
(defn quote-node [form] {:op :quote :form form})
(defn throw-node [expr] {:op :throw :expr expr})
(defn op [node] (:op node))

439
phase-5.md Normal file
View file

@ -0,0 +1,439 @@
# Phase 5 — True Laziness (jolt-c09)
Final phase of the `jolt-1j0` clojure.core migration epic. Make jolt's sequence
generators and transformers genuinely lazy, so infinite seqs and lazy
compositions work and stop hanging the evaluator. This is the deepest and
riskiest phase — sub-stage it and gate every step.
> Issue: `bd show jolt-c09`. Depends on Phase 4 (`jolt-ldf`, done). Blocks nothing
> — it's the last phase.
---
## 1. Current state (what already works, what doesn't)
**The LazySeq machinery exists and is sound.** (`src/jolt/phm.janet`)
- A LazySeq is `@{:jolt/type :jolt/lazy-seq :fn thunk :realized false :val nil}`.
- A thunk returns `nil` (empty) or a cons cell `[first-val rest-thunk]`.
- `realize-ls` forces one cell (memoized via `:realized`), with a `:jolt/pending`
sentinel that makes **self-referential** seqs work (`(def ones (lazy-seq (cons 1 ones)))`).
- `ls-first` / `ls-rest` / `ls-seq` / `ls-count` walk it. `lazy-seq?` detects it.
**Already lazy (keep):**
- Infinite generators: `(range)`, `(repeat x)`, `(iterate f x)`, `(cycle ...)`,
`repeatedly` return LazySeq. Bounded forms (`(range n)`, `(repeat n x)`) are
eager tuples/arrays — correct, they're finite.
- `map`/`filter` are **hybrid**: lazy when the input is a LazySeq, eager (and
representation-preserving) when the input is a concrete collection.
- `take`/`drop`/`take-while` pull lazily from a LazySeq input but **return an eager
array** (fine for bounded `take`, wrong for the others on infinite tails).
- Conformance already covers the working cases (self-ref fib, `iterate`, `count`
of `take`, `filter`/`take-while`/`remove` over `(range)`): see
`test/integration/conformance-test.janet` lines ~21143.
**The gaps (what hangs):**
1. **Eager transformers that force their input** even when it's infinite. Confirmed
callers of `realize-for-iteration` in their bodies: `remove`, `interpose`,
`distinct`, `take-nth`, `map-indexed`, `keep-indexed`, `partition-all`,
`partition-by`, `drop-while`. Plus `partition`, `interleave`, `concat`,
`dedupe`, `flatten`, `tree-seq`, `mapcat`, `keep`, `sequence` need an
infinite-input audit.
2. **`map`/`filter` over a *concrete vector* return an eager array**, not a lazy
seq. Clojure returns a lazy seq. This is a **representation decision** (§3 Step 6).
3. **`realize-for-iteration` is the universal forcing point** (57 call sites). Many
are legitimate realization boundaries (`count`, `into`, `reduce`, `vec`, `pr`),
but any transformer that calls it on a lazy input loses laziness.
4. **Evaluator eager assumptions** — the interpreter/compiler may realize seqs in
places (apply arg spreading, `doseq`, destructuring a seq). Audit needed.
5. **CPU-bound hangs are uninterruptible.** An infinite realization is a tight
Janet loop with no yield points, so `ev/with-deadline` cannot truncate it
in-process — it pins the core. This is why the suite runs each file in a
**subprocess** (`os/spawn` + 6 s `ev/with-deadline`, then `os/proc-kill`). Phase
5 testing must do the same (see §7).
---
## 2. Design principles (the cardinal rules)
1. **A transformer never forces its input.** It returns a LazySeq whose thunk pulls
one element at a time via `core-first`/`core-rest`/`seq-done?`. No
`realize-for-iteration` inside a transformer.
2. **Force only at realization boundaries.** Exactly the operations that *must* see
all elements: `pr`/`print`/`str` rendering, `=`, `count`, `reduce`, `into`,
`vec`/`seq`/`doall`, `doseq`, `nth`/`last` (these pull only as far as needed),
`apply` (spreads finitely). These are allowed to loop; on a genuinely infinite
seq they hang — matching Clojure.
3. **One-element-at-a-time, memoized.** Reuse `make-lazy-seq`/`realize-ls`; never
re-walk. `realize-ls`'s `:jolt/pending` guard preserves self-reference.
4. **Stack safety.** A chain of N lazy wrappers must not consume N stack frames per
element. Realize iteratively (a `while` over `realize-ls`), not by deep
recursion through `ls-rest`. Watch `concat`/`mapcat`/`lazy-cat` especially.
5. **Multi-arity stays correct.** `map`/`mapcat` over multiple colls advance each
input one step per output element and stop at the shortest.
---
## 3. Step-by-step implementation
Order matters: build the helper layer, then convert transformers leaf-first, then
fix boundaries, then the evaluator. Gate (§6) after **every** numbered step.
### Step 0 — Safety net ✓ (commit e2e189a)
- Record the baseline: conformance 229×3, clojure-test-suite `baseline-pass=3926`,
fixpoint stage1==2==3, self-host, all specs+unit, `lazy-seqs-spec` /
`sequences-spec` / `transducers-spec` green. ✓
- Build the **infinite-seq harness** first (see §6.2, "Deadlined infinite-seq
spec") so every subsequent step is verified against hangs, not just values. ✓
`test/support/lazy-eval.janet` (subprocess worker) +
`test/integration/lazy-infinite-test.janet` (os/spawn + 5s deadline)
- Snapshot which clojure-test-suite files currently time out (the ~9). Save the
list — it's the acceptance target. ⚠ 9 files recorded but not yet re-verified post-conversion.
### Step 1 — Lazy combinator layer ✓ (commit e2e189a)
Add a small set of internal lazy builders so transformers compose uniformly,
rather than each re-implementing the thunk dance:
- `lazy-cons val thunk` → a LazySeq cell of `val` + a deferred rest. ✓
`src/jolt/phm.janet` line 208; registered in core-bindings as `"lazy-cons"`.
- `lazy-from coll` → coerce any seqable to a uniform lazy view *without forcing*
(vector/list/set/map/string/LazySeq → a LazySeq that pulls element by element).
This is the lazy analogue of `realize-for-iteration` and the key primitive: every
transformer takes `(lazy-from input)` and walks it with `core-first`/`core-rest`. ✓
`src/jolt/core.janet` line 1112; registered in core-bindings as `"lazy-from"`.
- `seq-done?` already exists — confirm it short-circuits without forcing the tail. ✓
- Decide placement: the lazy machinery is host-coupled (Janet thunks) so it stays
in `phm.janet`/`core.janet`; transformers that are already in the overlay tiers
call these as primitives. ✓
### Step 2 — Convert the core transformers (leaf-first) ✓ (commits e2e189a, d16e1f4, 97781b3, ff8ffb8)
Make each return a LazySeq over `lazy-from input`. Do them in dependency order, one
small batch per commit, each gated:
- **2a. Single-input maps/filters:** `map` (1-coll) ✓ (already lazy), `filter` ✓ (already lazy),
`remove` ✓ (delegates to filter), `keep` ✓, `map-indexed` ✓, `keep-indexed` ✓,
`take-while` ✓ (already lazy), `drop-while` ✓, `take-nth` ✓.
- **2b. Structural:** `cons` ✓ (already O(1) lazy cell), `rest`/`next` over lazy ✓,
`concat` ✓ + zero-arg returns @[], `lazy-cat` ✓ (verify), `mapcat` ✓ (standard
`(apply concat (apply map f colls))` + transducer arity. Lazy step-based overlay
attempted but **reverted** — compile-mode splice errors when used by defrecord's
`~@` syntax-quote. Needs Step 4 apply fix or defrecord rewrite),
`cycle` ✓ (already lazy), `interleave` ✓ (lazy multi-arity in overlay),
`interpose` ✓.
- **2c. Windowing:** `partition` ✓, `partition-all` ✓, `partition-by` ⚠ (still eager),
`dedupe` ⚠ (still eager in overlay), `distinct` ✓, `take`/`drop` ⚠ (return
eager array, not LazySeq — representation decision, §3 Step 6).
- **2d. Multi-input `map`/`mapcat`** over several colls (shortest-stops). ✓
→ 9 new tests added to `sequences-spec.janet`, verified against Clojure & CLJS
reference implementations. Multi-input `map` already correct; `mapcat` uses
the standard overlay impl. No code changes needed.
- **2e. Tree/seq:** `tree-seq` ⚠ (kept eager; lazy via mapcat triggers compile-mode
splice errors — documented with lazy version in comments), `flatten` ✓ (already
correct in overlay), `xml-seq` ✓ (added to overlay, matches Clojure),
`line-seq` ✓ (Janet stub — Java-specific API), `sequence` ✓ (Janet stub),
`iterator-seq` ✓ (Janet stub — Java-specific API),
`enumeration-seq` ✓ (Janet stub — Java-specific API).
- For each: a transducer arity may exist (`td-*`) — leave it; only the
collection arity changes. ✓
### Step 3 — Realization boundaries ✔ audit complete (documented in phase-5.md)
Audit of 56 `realize-for-iteration` call sites in `src/jolt/core.janet` (excludes the definition at line 96). Each site classified below.
#### Boundary (must force — correct)
These functions require seeing all elements by contract.
| Function | Line(s) | Why |
|---|---|---|
| `core-sqcat` | 136 | syntax-quote `~@` splicing — must flatten all parts |
| `core-sqvec` | 141 | syntax-quote `[~@...]` — must flatten all parts |
| `core-every?` | 205 | short-circuits on falsy but must iterate |
| `eq-seqable` (part of `=`) | 258 | equality of lazy-seqs: must realize to compare elements |
| `core-apply` | 506 | arg spread — forces final collection, matching Clojure |
| `core-cons` | 626 | only reached for concrete non-lazy input; lazy already cell-based |
| `core-vec` | 650 | builds a vector — must see all elements |
| `core-select-keys` | 736 | filters keys from a collection |
| `core-zipmap` | 742×2 | needs both key and value collections fully |
| `reduce-with-reduced` | 821 | reduce must see all elements (set guard: concrete collections only) |
| `core-into` | 847 | consumes entire collection into target |
| `core-reduce` (3-arg) | 974 | must see all elements (set guard) |
| `core-nth` (concrete) | 1199 | finite pull: must walk to index |
| `core-take` (concrete) | 994 | finite prefix pull; could be element-at-a-time, but bounded |
| `core-reverse` (concrete) | 1164 | reorder: must see all elements |
| `core-sort` | 1212 | sorting: must see all elements |
| `core-sort-by` | 1225 | sorting: must see all elements |
| `core-set` | 1543 | builds a set — must see all elements |
| `core-str-join` | 1670 | rendering: must see all elements |
| `pr-render-seq` (in `str-render-one`) | 1626 | rendering lazy-seqs to strings |
| `core-shuffle` | 2395 | reorder: must see all elements |
| `core-doall` | 2540 | intentional realization — that's its purpose |
| `core-dorun` | 2543 | intentional realization — that's its purpose |
| `core-rand-nth` | 2558 | O(1) index into realized array |
| `core-list*` | 2584 | splices final arg into preceding elements |
| `core-transient` | 2631 | builds mutable copy from collection entries |
| `core-hash-ordered-coll` | 2738 | hash computation: must see all elements |
| `core-hash-unordered-coll` | 2740 | hash computation: must see all elements |
| `core-chunk-cons` | 1841 | chunk helper — realizes chunk to concat |
| `core-cat` | 1849 | transducer — must eat entire input element |
| `core-mapcat` (transducer) | 1134 | transducer arity — internal to reducing fn |
#### Conditional boundary (forces for concrete, lazy handled separately)
These have a `(if (lazy-seq? coll) ...)` guard. The `realize-for-iteration` is only reached for concrete collections. Correct pattern.
| Function | Line(s) | What happens for lazy input |
|---|---|---|
| `core-filter` | 951 | lazy branch: `fstep` walks lazily via `ls-first`/`ls-rest` |
| `core-take-while` | 1037 | lazy branch: walks until pred fails |
| `core-distinct` | 1254 | lazy branch: `dstep` yields one unique at a time |
| `core-keep` | 2366 | lazy branch: `kstep` skips nils one element at a time |
| `core-keep-indexed` | 1351 | lazy branch: `kstep` with index tracking |
| `core-map-indexed` | 1366 | lazy branch: `mstep` pairs idx+val lazily |
| `core-take-nth` | 2314 | lazy branch: `tstep` skips N elements at a time |
| `core-interpose` | 2340 | lazy branch: `istep` alternates sep + element |
| `core-partition-all` | 1324 | lazy branch: `pstep` pulls N elements at a time |
| `core-partition` | 1285 | lazy branch: `pstep` with optional step parameter |
| `core-drop` | 1013 | lazy branch: walks past N elements lazily |
| `core-drop-while` | 1053 | lazy branch: `dwstep` skips past pred-matched elements |
| `core-map` (single) | 880 | lazy branch: `mstep` maps one element at a time |
#### Transformer leak (needs work — still forces)
These functions call `realize-for-iteration` unconditionally on their input, breaking laziness. Each has a target Step for resolution.
| Function | Line(s) | Severity | Target Step |
|---|---|---|---|
| `core-mapcat` (collection) | 1141 | HIGH | Step 4 — `apply` fix needed to avoid forcing `core-map` result. Currently `(apply concat ...)` forces via `realize-for-iteration`. Lazy overlay exists in `10-seq.clj` but reverted (compile-mode splice errors). |
| `core-cycle` | 1372 | MED | Must snapshot input to cycle — would need a lazy cycling buffer. Low priority (cycle of finite coll). |
| `core-partition-by` | 1299 | MED | Has no lazy branch yet. Needs Step 2c completion. |
| `core-xml-seq` (Janet) | 2464 | LOW | **Overridden** by Clojure overlay `xml-seq` in `20-coll.clj` (uses `tree-seq`). The Janet stub remains for direct Janet-level callers but is rarely hit. Counted in Internal helpers below. |
#### Interop helpers (context-dependent, keep)
Array/byte conversion helpers that naturally force input.
| Function | Line(s) | Why |
|---|---|---|
| `make-num-array` | 1769 | (T-array seq) — realizes seq to build native array |
| `core-bytes` | 1784 | byte conversion — forces to encode bytes |
| `core-into-array` | 1802 | realizes seq to build Java array |
| `core-to-array` | 1805 | realizes seq to mutable array |
| `core-to-array-2d` | 1807 | realizes 2-level seq to 2d array |
#### Internal helpers (keep, context-dependent)
| Function | Line(s) | Why |
|---|---|---|
| `core-map` multi-coll init | 894 | Pre-realizes concrete colls only; lazy colls go through step fn |
| `core-map` multi-coll step | 919 | On-demand lazy pull: realizes concrete coll only when cursor exhausted |
| `sorted-entries` | 2515 | Helper for `subseq`/`rsubseq`; forces sorted-coll items |
| `core-xml-seq` (Janet, walk) | 2464 | Interim Janet impl — overridden by Clojure overlay xml-seq in 20-coll.clj |
#### Summary
| Category | Count |
|---|---|
| Boundary (correct) | 31 |
| Conditional boundary (lazy branch exists) | 13 |
| Transformer leak (needs work) | 3 |
| Interop helper (keep) | 5 |
| Internal helper (keep) | 4 |
| **Total verified** | **56** |
| **Leaks remaining** | **3 (mapcat, cycle, partition-by)** |
Of the 3 leaks:
- `mapcat` is the **critical remaining leak** — blocked on Step 4 `apply` fix.
- `partition-by` and `cycle` are low-to-medium priority.
- `xml-seq` Janet is **overridden** by the Clojure overlay — effectively resolved; counted in Internal helpers.
### Step 4 — Evaluator / compiler eager assumptions
Grep the interpreter (`src/jolt/evaluator.janet`) and back end
(`src/jolt/backend.janet`, `compiler.janet`) for places that realize seqs:
- `apply` / variadic arg spreading — must finitely spread, not realize an infinite
tail beyond the call.
- `&`-rest binding in `fn*`/`let*`/`loop*` and `destructure` — a rest param over a
lazy seq should stay lazy, not eagerly slurp.
- `doseq`/`for` desugaring (they go through `count`/`mapcat` — verify the `for`
comprehension stays lazy where Clojure's is).
- Any `(each x (realize ...))` in hot paths that assumes finiteness.
### Step 5 — Laziness-coupled stragglers (the deferred Phase-5 list)
From `jolt-c09` notes / MIGRATION.md: `sequence`, `sequential?`, `seqable?`,
`realized?`, `line-seq`, `rand-int`, `random-uuid`, `trampoline`, `unreduced`,
`ensure-reduced`, the transducer machinery (`cat`, `eduction`, `transduce`,
`sequence`, `halt-when`, `dedupe`/`interpose`/`keep` transducer arities). Move the
now-lazy ones to the overlay where feasible (Phase-4 style), keeping the
`Reduced`/thunk kernels native.
### Step 6 — Representation decision ✅ Decided: Option A (full Clojure laziness)
**Decision: Option A.** Lazy transformers always return a LazySeq, even over a
concrete vector — matching Clojure: `(seq? (map inc [1 2 3]))` is **true**,
`(vector? (map inc [1 2 3]))` is **false**.
History: an earlier Option A attempt (commit a11535c, reverted) crashed
(0/21 lazy-infinite, conformance crash) because flipping `map` to always-lazy
without the supporting boundary fixes broke the `lazy-from → seq-done? →
ls-first` chain. That measurement led to Option B (hybrid) and Phase 5 being
declared complete.
Option A was then re-attempted **with the boundary fixes the first attempt
lacked**, and it works — all gates green (conformance 246×3, lazy-infinite
40/40). The fixes that made it viable:
- `cons` over a lazy-seq returns a LazySeq, not a raw `@[val thunk]` cell (a
cons-of-a-cons no longer leaks the rest-thunk as a list element).
- `coll->cells` disambiguates cons cells (mutable arrays) from user vectors
whose 2nd element is a function (`[first last]`), and coerces set/map/string/
buffer via `core-seq`.
- `core-nth`/`core-next`/`core-rest` walk lazy seqs via `seq-done?` (not element
truthiness or `length` on the lazy table), so a `false`/`nil` element isn't
mistaken for end-of-seq and `rest` never returns nil.
- `~@` splice (interpreter `syntax-quote*`) and the test helper `normalize-pvecs`
realize lazy-seqs.
- Transformers always route concrete input through `lazy-from` + the lazy step
machinery (dropping the eager `(if (jvec? coll) (make-vec …))` branch).
All transformers are lazy in interpret/compile/self-host, using canonical
recursive Clojure forms. (jolt-r81 — a compile-mode leak where lazy overlay fns
returned the `lazy-seq` macro expansion as data — was root-fixed by moving
`lazy-seq`/`lazy-cat` to the 00-syntax tier so they're registered before the
seq/coll tiers that use them compile.)
---
## 3b. Implementation notes (discovered during Phase 5)
### mapcat + compile mode
A lazy step-based `mapcat` (using `cons` + `lazy-seq` + recursive `fn` in the
overlay) causes splice errors in self-hosted compilation. The `defrecord` macro
in `30-macros.clj` uses `(vec (mapcat …))` inside syntax-quote, and `~@` cannot
splice lazy-seqs. Reverted to the standard `(apply concat (apply map f colls))`
implementation. Two possible fixes for the future:
1. **Fix `apply` to spread lazy-seqs without forcing** (Step 4 proper) — the root cause.
2. **Rewrite `defrecord`'s bind-generation to avoid `mapcat`** — replace
`(vec (mapcat (fn [f] …) fields))` with an eager `loop` accumulator.
### tree-seq + compile mode
Same root cause as mapcat: lazy `tree-seq` requires `mapcat` for
`(when (branch? node) (mapcat walk (children node)))`. Kept eager; lazy version
documented in `20-coll.clj` comments. Will switch when mapcat is resolved.
### pre-existing: protocol-on-record compile-mode failure
`(defprotocol P (m [_])) (defrecord R [side] P (m [_] (* side side))) (m (->R 4))`
errors with "Unable to resolve symbol: side" in compile mode. This is a pre-existing
issue unrelated to Phase 5 changes — `register-method` stores the method body as
a raw `fn*` form, and the self-hosted compiler cannot resolve let-bound field
access symbols at definition time (bindings only exist at call time).
Conformance wraps this in `(= expected (do …))` so it's never triggered; only
direct `eval-string` with `:compile? true` hits it. Not blocking — the
self-host path (JOLT_SELFHOST=1) and interpret path both pass.
---
## 4. Suggested commit cadence
One transformer family (a §3 sub-step) per commit. Each commit:
1. Convert the fns (overlay or core as appropriate).
2. Add infinite-seq spec cases (§6.2) + value cases.
3. Run the full gate (§6.1). Commit only if green. Push.
Mirror the Phase 4 discipline: small, gated, reversible batches.
---
## 5. Risks & gotchas
- **Uninterruptible hangs:** never probe an infinite case in-process — it pins a
core and can't be killed by a deadline. Always go through the subprocess harness.
- **Self-reference:** `(def s (lazy-seq (cons 1 s)))` and `lazy-cat` fib rely on
`realize-ls`'s `:jolt/pending` guard — don't bypass `realize-ls` with a
hand-rolled force.
- **Stack overflow** from deep wrapper chains (`concat`/`mapcat`/`iterate` of
`iterate`) — realize iteratively.
- **Double realization / side effects:** a lazy `map` fn with side effects must run
**once per element, in order, only when forced** — assert with a counter (§7).
- **Performance:** LazySeq has per-element allocation + thunk-call overhead. Watch
`core-bench` (`test/bench/core-bench.janet`) — the eager fast paths exist partly
for speed. A heavy suite file slipping past the 6 s deadline = a regression
(this already bit Phase 3's macro move).
- **Compile/self-host parity:** every behavior must hold in interpret, compile, and
self-host (conformance runs all three). Lazy thunks are closures — verify the
back end compiles them.
- **`chunked` seqs are out of scope** — `chunked-seq?` stays `false`. Don't emulate
chunking; one-at-a-time is fine.
---
## 6. Testing strategy
### 6.1 Per-step gate (every commit) — same as Phase 4
```
janet test/integration/conformance-test.janet # 229×3 (interpret/compile/self-host)
janet test/integration/bootstrap-fixpoint-test.janet # stage1==2==3
janet test/integration/self-host-test.janet
janet test/integration/sci-bootstrap-test.janet
janet test/integration/clojure-test-suite-test.janet # >= baseline (raise as it improves)
for f in test/spec/*.janet test/unit/*.janet; do janet "$f"; done
```
### 6.2 Deadlined infinite-seq spec (the Phase-5-specific harness)
Build this in Step 0. Plain in-process specs **cannot** test laziness — a wrong
answer hangs instead of failing. Mirror `clojure-test-suite-test.janet`'s pattern:
- A new `test/integration/lazy-infinite-test.janet` that, for each case, spawns a
worker (`os/spawn ["janet" "test/support/lazy-eval.janet" expr]`) and waits under
`(ev/with-deadline 5 (os/proc-wait proc))`, killing on timeout.
- A timed-out or crashed case = **FAIL** (it should have produced a value).
- Cases = the compositions that currently hang. Minimum set:
```
(nth (map inc (range)) 1000) => 1001
(first (filter even? (drop 3 (range)))) => 4
(take 3 (remove odd? (range))) => (0 2 4)
(take 3 (drop-while #(< % 5) (range))) => (5 6 7)
(take 4 (interleave (range) (iterate inc 10)))
(take 3 (partition 2 (range))) => ((0 1) (2 3) (4 5))
(take 3 (partition-all 2 (range)))
(take 3 (map-indexed vector (range)))
(take 5 (distinct (cycle [1 2 1 3 1])))
(take 3 (mapcat (fn [x] [x x]) (range)))
(take 3 (take-nth 2 (range)))
(take 3 (interpose :x (range)))
(take 3 (map vector (range) (iterate inc 100)))
(second (cons :a (range)))
```
Add one row per transformer converted in Step 2.
### 6.3 Laziness assertions (side-effect counting)
For each lazy transformer, assert it realizes **only what's demanded** — values
alone don't prove laziness. Use a counter:
```clojure
(let [n (atom 0)]
(take 3 (map (fn [x] (swap! n inc) x) (range)))
@n) ; => 3 (not "hang", not 1000)
```
Add these to `test/spec/lazy-seqs-spec.janet`. They run in-process safely because
they only ever force a bounded prefix.
### 6.4 Conformance extension
Add infinite-composition rows to `conformance-test.janet` (runs ×3 modes) — the
subset of §6.2 that returns a small concrete value, e.g.
`["lazy compose" "(quote (1 3 5))" "(take 3 (filter odd? (map inc (range))))"]`.
These guard interpret/compile/self-host parity.
### 6.5 Acceptance target — the timed-out suite files
The 9 files that currently time out (snapshot in Step 0:
`cycle`/`range`/transducers-over-infinite tests) should stop timing out and start
contributing passes. Each phase-5 step should monotonically reduce the timed-out
count and **raise `baseline-pass`** in `clojure-test-suite-test.janet:35`. Final
target: 0 (or near-0) timeouts and a meaningfully higher baseline.
### 6.6 Regression guards
- `core-bench` before/after (back-to-back, load-sensitive) — no large slowdown on
the eager-collection paths.
- `lazy-seqs-spec`, `sequences-spec`, `transducers-spec` stay green every step.
---
## 7. Done criteria
- All §6.2 infinite-seq cases return correct values under the deadline (0 hangs). ✅ Done — 21/21
- §6.3 laziness counters prove minimal realization for every converted transformer. ✅ Done — 16 counter tests added, all pass
- Conformance 229+×3, fixpoint, self-host, sci-bootstrap all green. ✅ Done — 246/246 all three modes (Option A added cases)
- clojure-test-suite: the ~9 infinite-seq files no longer time out; `baseline-pass`
raised to the new steady-state; no per-file 6 s timeouts introduced. ✅ Done — 3971 pass
(up from 3926), 6 timeouts (down from 9), 4628 assertions.
- Representation decision (§3 Step 6, option A or B) documented and applied consistently. ✅ **Option A (full laziness)** — re-attempted with boundary fixes the first attempt lacked; all transformers lazy in 3 modes, conformance 246×3, lazy-infinite 40/40. (Earlier Option B was superseded.)
- `core-bench` within noise of the Phase-4 baseline. ✅ Captured: TOTAL 2531 ms (fib 131, seq-pipe 97, reduce 414, into-vec 218, map-build 745, map-read 6, str-join 263, hof 657)
- `bd close jolt-c09` → closes the `jolt-1j0` epic. ⚠ blocked on above

47
src/jolt/aot.janet Normal file
View file

@ -0,0 +1,47 @@
# Ahead-of-time images for compiled namespaces.
#
# Compile-by-default turns each form into Janet bytecode at load time. AOT skips
# that work on subsequent runs by serializing a namespace's compiled vars to a
# bytecode image and loading them back.
#
# The trick is the marshal dictionary. A compiled jolt function closes over core
# fns (core-map, +, …) and var cells; those core fns are Janet cfunctions/closures
# that can't be marshaled by value. But the runtime env that holds them is baked
# into the binary and is byte-for-byte identical at save and load time, so we
# marshal *against* it: core fns are referenced by name, and only the user's
# bytecode plus its var cells are actually serialized.
(use ./compiler) # jolt-runtime-env
(use ./types)
# Forward dict (key -> value) for unmarshal; reverse (value -> key) for marshal.
# Built from the runtime env, which chains to the Janet boot env, so both core fns
# and Janet builtins resolve by name.
(defn- fwd-dict [] (env-lookup jolt-runtime-env))
(defn- rev-dict [] (invert (env-lookup jolt-runtime-env)))
(defn marshal-ns
"Marshal namespace `ns-name`'s var mappings to a byte buffer. The whole mappings
table is marshaled in one call so var cells shared between defs stay shared."
[ctx ns-name]
(marshal ((ctx-find-ns ctx ns-name) :mappings) (rev-dict)))
(defn unmarshal-ns!
"Install mappings produced by marshal-ns into `ns-name` in ctx, overwriting
same-named vars. Returns ns-name."
[ctx ns-name bytes]
(let [mappings (unmarshal bytes (fwd-dict))
ns (ctx-find-ns ctx ns-name)]
(each [sym v] (pairs mappings) (put (ns :mappings) sym v))
ns-name))
(defn save-ns
"Write an AOT image of compiled namespace `ns-name` to `path`."
[ctx ns-name path]
(spit path (marshal-ns ctx ns-name)))
(defn load-ns-image
"Read an AOT image written by save-ns back into ctx under `ns-name`. Skips
parse/analyze/emit/compile entirely — the bytecode is already built."
[ctx ns-name path]
(unmarshal-ns! ctx ns-name (slurp path)))

View file

@ -10,7 +10,18 @@
(use ./compiler)
(use ./loader)
(use ./async)
(import ./backend :as backend)
(import ./stdlib_embed :as stdlib-embed)
(import ./host_iface :as host)
# A defmacro expander compiles to a native fn (built as (fn* args body...) and run
# through the self-hosted pipeline) so macro expansion is compiled, zero runtime
# cost — instead of an interpreted closure. Returns nil (interpreted fallback) when
# the analyzer isn't built yet or the body isn't compilable.
(set macro-compile-hook
(fn [ctx args-form body]
(backend/try-compile-fn ctx
(array/concat @[{:jolt/type :symbol :ns nil :name "fn*"} args-form] body))))
(defn normalize-pvecs
"Deep-convert any sequential (pvec/tuple/array) to a Janet tuple. Test helper
@ -19,6 +30,9 @@
and lists with the same elements are equal."
[x]
(cond
# lazy-seq: realize to a tuple (map/filter/take now return lazy seqs).
(and (table? x) (= (get x :jolt/type) :jolt/lazy-seq))
(tuple ;(map normalize-pvecs (realize-for-iteration x)))
(pvec? x) (tuple ;(map normalize-pvecs (pv->array x)))
(plist? x) (tuple ;(map normalize-pvecs (pl->array x)))
(tuple? x) (tuple ;(map normalize-pvecs x))
@ -26,12 +40,66 @@
x))
# Ordered clojure.core tiers (embedded jolt-core/clojure/core/NN-*.clj). Each tier
# may reference only the Janet seed + earlier tiers. A :kernel tier holds the
# structural fns the self-hosted compiler itself uses (second/peek/subvec/mapv/
# update); in compile mode it must be bootstrap-compiled into clojure.core BEFORE
# the analyzer is built (the analyzer depends on it), so it bypasses the
# self-hosted pipeline. Non-kernel tiers route through eval-toplevel like any
# source (compiled when :compile?, interpreted otherwise — the analyzer, built
# lazily on the first such form, sees the kernel tier already in place).
(def- core-tiers
[{:ns "clojure.core.00-syntax" :kernel false}
{:ns "clojure.core.00-kernel" :kernel true}
{:ns "clojure.core.10-seq" :kernel false}
{:ns "clojure.core.20-coll" :kernel false}
{:ns "clojure.core.30-macros" :kernel false}])
(defn- eval-overlay-source [ctx src]
(var s src)
(while (> (length (string/trim s)) 0)
(def [form rest] (parse-next s))
(set s rest)
(when (not (nil? form)) (eval-toplevel ctx form))))
(defn- load-core-overlay!
"Load the Clojure portion of clojure.core in dependency-ordered tiers. See
core-tiers and jolt-core/clojure/core/."
[ctx]
(def env (ctx :env))
(def compile? (get env :compile?))
# Core compiles with direct-linking on when :aot-core? (so core->core calls
# are direct). The flag is restored to the user-code default afterward, so
# user/REPL code stays indirect and fully redefinable.
(def user-dl (get env :direct-linking?))
(def core-dl (get env :aot-core?))
(def saved (ctx-current-ns ctx))
(ctx-set-current-ns ctx "clojure.core")
# Gate the analyzer build until the kernel tier loads (see ensure-analyzer):
# present-and-false here means pre-kernel compiles fall back to the interpreter.
(put env :kernel-ready? false)
(each tier core-tiers
(when-let [src (get stdlib-embed/sources (tier :ns))]
(put env :direct-linking? core-dl)
(if (and compile? (tier :kernel))
(backend/bootstrap-load-source ctx "clojure.core" src)
(eval-overlay-source ctx src))
# The self-hosted compiler depends on the kernel tier (second/peek/mapv/...).
# Mark it ready once that tier is in place so the analyzer can be built; a
# pre-kernel tier that triggers a compile (e.g. a defn in 00-syntax) instead
# falls back to the interpreter rather than building the analyzer against a
# half-loaded core (which would forward-ref the missing kernel fns to nil).
(when (tier :kernel) (put env :kernel-ready? true))))
(put env :direct-linking? user-dl)
(ctx-set-current-ns ctx saved))
(defn init
"Create a new Jolt evaluation context.
opts may contain:
:namespaces — map of {ns-name → {sym → value, ...}, ...}
:mutable? — use Janet mutable data structures instead of persistent
:compile? — enable compilation of Clojure forms to Janet
:compile? — compile Clojure forms via the self-hosted pipeline (analyzer ->
IR -> Janet back end), falling back to the interpreter as needed
:paths — extra source roots to search for namespaces (after the stdlib)"
[&opt opts]
(default opts {})
@ -53,34 +121,21 @@
# clojure.core.async (channels + go blocks on Janet fibers); pre-populated
# so (require '[clojure.core.async ...]) finds it and applies :as/:refer.
(install-async! ctx)
# Host contract (ns jolt.host): the seam the portable jolt-core compiler calls.
(host/install! ctx)
# Clojure portion of clojure.core (jolt-core/clojure/core.clj): fns expressed
# in plain Clojure on top of the Janet primitives interned above. Loaded into
# clojure.core and compiled by the self-hosted pipeline (or interpreted when
# :compile? is off). Phase 4 kernel-shrink seam — see that file.
(load-core-overlay! ctx)
ctx))
# Stateful / context-modifying forms always use the interpreter (they mutate
# the context: namespaces, macros, types, multimethods, dynamic vars, …).
(defn- stateful-head? [head-name]
(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")
(= head-name "eval")))
(defn eval-one
"Evaluate a single already-parsed form, routing to the compiler when the
context has :compile? enabled (stateful forms always interpret)."
"Evaluate a single already-parsed form. Routing (compile when :compile? is set,
stateful forms interpret, interpreter fallback for forms the compiler can't
handle) lives in loader/eval-toplevel so load-ns and eval-one stay in sync."
[ctx form]
(if (get (ctx :env) :compile?)
(if (array? form)
(let [first-form (first form)
head-name (if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
(first-form :name) nil)]
(if (stateful-head? head-name)
(eval-form ctx @{} form)
(compile-and-eval form ctx)))
(if (or (and (struct? form) (= :symbol (form :jolt/type))) (tuple? form))
(compile-and-eval form ctx)
(eval-form ctx @{} form)))
(eval-form ctx @{} form)))
(eval-toplevel ctx form))
(defn eval-string
"Evaluate a Clojure source string in a Jolt context.

367
src/jolt/backend.janet Normal file
View file

@ -0,0 +1,367 @@
# Janet back end: host-neutral IR (from jolt.analyzer) -> Janet form -> bytecode.
#
# Host-specific by definition (it targets Janet). It resolves name-based :var
# nodes to Janet var cells and reuses runtime helpers (jolt-call, make-vec,
# build-map-literal). The portable front end (jolt.analyzer) never sees any of
# this; a different runtime provides its own back end against the same IR.
#
# In src/jolt/ (not host/janet/) for the same module-resolution reason as
# host_iface — see that file's header.
(use ./types)
(use ./core)
(import ./compiler :as comp)
(use ./evaluator)
(import ./reader :as r)
(import ./phm :as phm)
# The IR is portable data; reading its representation is a host-layer concern.
# Most nodes are Janet structs (raw-readable), but a node carrying a nil-valued
# field — an anonymous fn's :name, a nil const's :val, a def with no :meta, an
# arity with no :rest — is a phm, whose fields live under :buckets, not as direct
# keys. Densify such a node to a struct: phm-to-struct drops exactly those
# nil-valued fields, which is what the back end wants (it already treats an absent
# field as nil). Structs (the common case) pass through untouched. Applied at the
# few points where a node first reaches the emitter, so the rest of the back end
# keeps using plain (node :key) access and the portable front end never sees this.
(defn- norm-node [n]
(if (phm/phm? n) (phm/phm-to-struct n) n))
# Var late-binding: reads go through `(var-get cell)` with the cell embedded as a
# constant, so compiled code sees redefinition (Janet early-binds plain symbols)
# — var-get reads the cell's root live. Writes go through a memoized setter.
(defn- var-setter [cell]
(or (get cell :jolt/setter)
(let [s (fn [v] (bind-root cell v) cell)] (put cell :jolt/setter s) s)))
# Setter that also applies def metadata to the var (so ^:dynamic / ^:redef /
# ^:private survive compilation, matching the interpreter's def). Not memoized:
# the meta is specific to this def site.
(defn- var-setter-meta [cell meta]
(fn [v]
(bind-root cell v)
(put cell :meta (merge (or (cell :meta) {}) meta))
(when (get meta :dynamic) (put cell :dynamic true))
cell))
(defn- cell-for [ctx ns-name nm]
(ns-intern (ctx-find-ns ctx ns-name) nm))
# Direct-linking decision (call-site/unit property, Clojure-style). A var
# reference compiles to its embedded value (direct) iff:
# - the compiling unit has direct-linking on (env :direct-linking?),
# - the target opts in (NOT ^:redef / ^:dynamic — those force indirect),
# - the target is already defined AND its root is a Janet function.
# The function? guard is essential: embedding a non-function value (a jolt
# collection/symbol) into the emitted form would make Janet evaluate it AS code.
# So we direct-link exactly the call-optimization case; everything else stays
# indirect (live var deref → redefinable). Default user/REPL units: flag off,
# so all user calls are indirect and redefinable with no annotation.
(defn- direct-var? [ctx cell]
(and (get (ctx :env) :direct-linking?)
(not (cell :dynamic))
(not (let [m (cell :meta)] (and m (get m :redef))))
(function? (cell :root))))
# Fresh Janet symbol for back-end-introduced bindings (arity dispatch). NOT
# Janet's `gensym` — `(use ./core)` shadows it with Jolt's, which returns a jolt
# symbol struct (invalid in a Janet param position).
(var- gsym-counter 0)
(defn- gsym [] (def s (symbol "_be$" gsym-counter)) (++ gsym-counter) s)
(var emit nil)
(defn- emit-seq [ctx node]
(def out @['do])
(each s (vview (node :statements)) (array/push out (emit ctx s)))
(array/push out (emit ctx (node :ret)))
(tuple/slice out))
(defn- emit-let [ctx node]
(def binds @[])
(each pair (vview (node :bindings))
(def p (vview pair))
(array/push binds (symbol (in p 0)))
(array/push binds (emit ctx (in p 1))))
['let (tuple/slice binds) (emit ctx (node :body))])
# An arity compiles to a named Janet fn whose name is its recur target, so recur
# is a self-call (Janet tail-calls it). The rest param is an ORDINARY positional
# param holding a seq (not Janet `&`), so `(recur fixed... rest-seq)` re-enters
# the way Clojure recur into a variadic arity does (rebinds the rest seq directly,
# no re-collection). The dispatch wrapper (emit-fn-body) collects the call's args.
(defn- emit-arity-fn [ctx ar]
(def ps @[])
(each pn (vview (ar :params)) (array/push ps (symbol pn)))
(when (ar :rest) (array/push ps (symbol (ar :rest))))
['fn (symbol (ar :recur-name)) (tuple/slice ps) (emit ctx (ar :body))])
# Invoke an arity's fn with args pulled from the dispatch tuple: fixed params by
# index, rest as a slice from n-fixed on.
(defn- emit-arity-invoke [ctx ar jargs]
(def nfixed (length (vview (ar :params))))
(def call @[(emit-arity-fn ctx ar)])
(for i 0 nfixed (array/push call ['in jargs i]))
(when (ar :rest) (array/push call ['tuple/slice jargs nfixed]))
(tuple/slice call))
(defn- emit-loop [ctx node]
(def L (symbol (node :recur-name)))
(def params @[])
(def inits @[])
(each pair (vview (node :bindings))
(def p (vview pair))
(array/push params (symbol (in p 0)))
(array/push inits (emit ctx (in p 1))))
['do
['var L nil]
['set L ['fn (tuple/slice params) (emit ctx (node :body))]]
(tuple/slice (array/concat @[L] inits))])
(defn- emit-recur [ctx node]
(tuple/slice (array/concat @[(symbol (node :recur-name))]
(map |(emit ctx $) (vview (node :args))))))
(defn- emit-try [ctx node]
(def core
(if (node :catch-sym)
['try (emit ctx (node :body))
[[(symbol (node :catch-sym))] (emit ctx (node :catch-body))]]
(emit ctx (node :body))))
(if (node :finally)
['defer (emit ctx (node :finally)) core]
core))
(defn- emit-fn-body [ctx node]
(def arities (map norm-node (vview (node :arities))))
(def multi (> (length arities) 1))
(cond
# Single fixed arity (the hot case): emit the arity fn directly — its name is
# the recur target, no dispatch overhead.
(and (not multi) (not ((first arities) :rest)))
(emit-arity-fn ctx (first arities))
# Single variadic arity: a thin wrapper collects the call's args so the rest
# seq can be built, then hands off to the arity fn.
(not multi)
(let [jargs (gsym)]
['fn ['& jargs] (emit-arity-invoke ctx (first arities) jargs)])
# Multi-arity: dispatch on arg count. Fixed arities match exactly; the (one)
# variadic arity matches >= its fixed count.
(let [jargs (gsym)
nsym (gsym)
cf @['cond]]
(each ar arities
(def nfixed (length (vview (ar :params))))
(array/push cf (if (ar :rest) [>= nsym nfixed] [= nsym nfixed]))
(array/push cf (emit-arity-invoke ctx ar jargs)))
(array/push cf ['error "wrong number of args passed to fn"])
['fn ['& jargs]
['do ['def nsym ['length jargs]] (tuple/slice cf)]])))
# A named fn (fn self [..] .. (self ..)) references itself by name. The analyzer
# binds that name as a local; bind it here to the fn value via a var (set before
# any call, so the captured closure sees it — same scheme as emit-loop). recur
# stays a separate self-call to the arity fn; this only covers by-name self-refs.
(defn- emit-fn [ctx node]
(def body (emit-fn-body ctx node))
(if (node :name)
(let [s (symbol (node :name))]
['do ['var s nil] ['set s body] s])
body))
# A direct Janet call (f args) is only correct when the callee is definitely a
# function: Janet calling a pvec/keyword/etc. does get (or the wrong thing), not
# IFn dispatch. So only emit a direct call for :fn / :host (always functions) and
# a :var whose CURRENT root is a function (the common user/core-fn case). A :var
# holding an IFn COLLECTION (vector/keyword/set used as a fn) or a :local of
# unknown value falls through to jolt-call, which dispatches IFn correctly
# (function fast-path first). Trade-off, like direct-linking: a fn-var redefined
# to a collection after this call was compiled would still emit a direct call.
(defn- direct-call? [ctx fnode]
(case (fnode :op)
:fn true
:host true
:var (let [r (get (cell-for ctx (fnode :ns) (fnode :name)) :root)]
(or (function? r) (cfunction? r)))
false))
# Hot primitives emitted as native Janet ops (host-specific optimization): a
# call to clojure.core/+ etc. becomes (+ …) rather than a var deref + variadic
# core fn. Matches numeric semantics; relaxes the non-number checks (a documented
# perf-mode divergence, same as the bootstrap's core-renames).
(def- native-ops
{"+" '+ "-" '- "*" '* "<" '< ">" '> "<=" '<= ">=" '>= "inc" '++ "dec" '--})
(defn- native-op
"If fnode is a clojure.core ref (or host ref) to a native-op primitive, return
the Janet op symbol, else nil. inc/dec are unary so only at arity 1."
[fnode nargs]
(def nm (case (fnode :op)
:var (when (= "clojure.core" (fnode :ns)) (fnode :name))
:host (fnode :name)
nil))
(def op (and nm (get native-ops nm)))
(cond
(nil? op) nil
(and (or (= op '++) (= op '--)) (not= nargs 1)) nil
op))
(defn- emit-invoke [ctx node]
(def fnode (norm-node (node :fn)))
(def args (map |(emit ctx $) (vview (node :args))))
(def nop (native-op fnode (length args)))
(cond
nop (case nop
'++ ['+ (in args 0) 1]
'-- ['- (in args 0) 1]
(tuple nop ;args))
(direct-call? ctx fnode) (tuple (emit ctx fnode) ;args)
(tuple jolt-call (emit ctx fnode) ;args)))
(defn- emit-vector [ctx node]
(def items (map |(emit ctx $) (vview (node :items))))
(tuple make-vec (tuple/slice (array/concat @['tuple] items))))
(defn- emit-map [ctx node]
(def args @[comp/build-map-literal])
(each pair (vview (node :pairs))
(def p (vview pair))
(array/push args (emit ctx (in p 0)))
(array/push args (emit ctx (in p 1))))
(tuple/slice args))
(set emit
(fn emit [ctx raw]
(def node (norm-node raw))
(case (node :op)
:const (node :val)
:local (symbol (node :name))
:host (symbol (node :name))
:var (let [cell (cell-for ctx (node :ns) (node :name))]
(if (direct-var? ctx cell)
(cell :root) # direct link: embed the fn value
# Indirect: live deref. Quote the cell so it's embedded by
# reference (a bare table in arg position would be re-evaluated as
# a constructor — deep-copying it, and any atom in :root, each call).
(tuple var-get (tuple 'quote cell))))
:if ['if (emit ctx (node :test)) (emit ctx (node :then)) (emit ctx (node :else))]
:do (emit-seq ctx node)
:loop (emit-loop ctx node)
:recur (emit-recur ctx node)
:try (emit-try ctx node)
:throw ['error (emit ctx (node :expr))]
:def (let [cell (cell-for ctx (node :ns) (node :name))
meta (node :meta)]
(tuple (if (and meta (not (empty? meta))) (var-setter-meta cell meta) (var-setter cell))
(emit ctx (node :init))))
:let (emit-let ctx node)
:fn (emit-fn ctx node)
:invoke (emit-invoke ctx node)
:vector (emit-vector ctx node)
:map (emit-map ctx node)
:quote ['quote (node :form)]
(error (string "backend: unhandled op " (node :op))))))
(defn emit-ir
"IR node -> Janet form (public entry for the back end)."
[ctx node]
(emit ctx node))
# --- pipeline wiring (the self-hosted compile path) ---
# Bootstrap-compile a source string into target-ns: each form is compiled via the
# bootstrap (native Janet) compiler and its defs interned in target-ns. This is
# the stage-1 builder — it runs BEFORE the self-hosted analyzer exists, so it's
# how both the compiler namespaces (jolt.ir/jolt.analyzer) and the clojure.core
# kernel tier (the structural fns the analyzer itself calls) get built. The
# analyzer uses unqualified referred names (jolt.host form-* + IR ctors), so the
# bootstrap's plain :var path compiles it; stateful forms fall back to interp.
(defn bootstrap-load-source [ctx target-ns src]
(def saved (ctx-current-ns ctx))
(ctx-set-current-ns ctx target-ns)
(var s src)
(while (> (length (string/trim s)) 0)
(def parsed (r/parse-next s))
(set s (in parsed 1))
(def f (in parsed 0))
(when (not (nil? f))
# Guard BOTH compile and the Janet-compile-of-emitted step: a form whose
# emitted Janet is invalid (e.g. a bad splice) falls back to interpreted
# definition rather than killing the whole load.
(def r (protect (comp/eval-compiled (comp/compile-ast f ctx) ctx)))
(unless (r 0) (eval-form ctx @{} f))))
(ctx-set-current-ns ctx saved))
# Compile-load an embedded jolt-core namespace by name (source from the stdlib map).
(defn- compile-load [ctx ns-name]
(def src (get (get (ctx :env) :embedded-sources @{}) ns-name))
(when src (bootstrap-load-source ctx ns-name src)))
# Build the self-hosted compiler (IR ctors + analyzer) via the bootstrap. The
# analyzer's references to clojure.core fns it uses (second/peek/subvec/mapv/
# update) resolve to whatever is interned in clojure.core at this point — so the
# kernel tier must already be loaded (see api/load-core-overlay!).
(defn- build-compiler! [ctx]
(compile-load ctx "jolt.ir")
(compile-load ctx "jolt.analyzer"))
(defn- ensure-analyzer [ctx]
# Don't build until the kernel tier is loaded (see api/load-core-overlay! and
# build-compiler!). Before then a compile request — e.g. a defn in a pre-kernel
# tier — must fall back to the interpreter, not build the analyzer against a
# core missing the fns it references (which would intern them as nil cells that
# then shadow the real definitions on the self-rebuild). The flag is absent in
# bare/test contexts that never load core; treat that as ready so those keep
# building the analyzer lazily as before.
(def env (ctx :env))
(def gated (and (has-key? env :kernel-ready?) (not (get env :kernel-ready?))))
(when (and (not gated)
(= 0 (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))))
(build-compiler! ctx)))
(defn rebuild-compiler!
"Recompile the self-hosted compiler (jolt.ir + jolt.analyzer) against the
CURRENT clojure.core. The fractal turn: once a core tier supplies Clojure
definitions the compiler itself uses, rebuilding makes the compiler run on
them. Idempotent; re-interns the compiler namespaces over the existing cells."
[ctx]
(build-compiler! ctx))
(defn analyze-form
"Run the portable Clojure analyzer (jolt.analyzer/analyze) on a reader form,
returning host-neutral IR."
[ctx form]
(ensure-analyzer ctx)
# Capture the real compile ns: the analyzer runs interpreted (defined in
# jolt.analyzer), and the interpreter rebinds current-ns to a fn's defining ns
# while it runs — so h/current-ns must read this instead of ctx-current-ns.
(put (ctx :env) :compile-ns (ctx-current-ns ctx))
(def av (ns-find (ctx-find-ns ctx "jolt.analyzer") "analyze"))
(def r ((var-get av) ctx form))
(put (ctx :env) :compile-ns nil)
r)
(defn compile-and-eval
"Self-hosted compile path: analyze (portable Clojure) -> IR -> Janet -> eval.
Hybrid: only the compile step (analyze+emit) is guarded — a form the analyzer
can't handle throws and falls back to the interpreter; runtime errors in
compiled code propagate (no double-eval, no hidden errors)."
[ctx form]
(def compiled (protect (emit-ir ctx (analyze-form ctx form))))
(if (compiled 0)
(eval (compiled 1) (comp/ctx-janet-env ctx))
(eval-form ctx @{} form)))
(defn analyzer-built? [ctx]
(> (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)) 0))
(defn try-compile-fn
"Compile a fn* form to a native Janet fn via the self-hosted pipeline, or nil if
it can't be compiled (analyzer not yet built, or the body isn't compilable).
Used to compile macro expanders for native-speed expansion."
[ctx fn-form]
(when (analyzer-built? ctx)
(def compiled (protect (emit-ir ctx (analyze-form ctx fn-form))))
(when (compiled 0)
(def r (protect (eval (compiled 1) (comp/ctx-janet-env ctx))))
(when (r 0) (r 1)))))

98
src/jolt/clojure/data.clj Normal file
View file

@ -0,0 +1,98 @@
; Copyright (c) Rich Hickey. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this distribution.
;; Ported from clojure.data (Stuart Halloway). The reference dispatches via the
;; EqualityPartition/Diff protocols extended over host types; Jolt uses a plain
;; equality-partition fn over its own predicates instead — same behaviour, no
;; host-type protocol plumbing.
(ns clojure.data
"Non-core data functions."
(:require [clojure.set :as set]))
(declare diff)
(defn- atom-diff [a b]
(if (= a b) [nil nil a] [a b nil]))
;; Convert an associative-by-numeric-index collection into an equivalent vector,
;; with nil for any missing keys.
(defn- vectorize [m]
(when (seq m)
(reduce
(fn [result [k v]] (assoc result k v))
(vec (repeat (apply max (keys m)) nil))
m)))
(defn- diff-associative-key
"Diff associative things a and b, comparing only the key k."
[a b k]
(let [va (get a k)
vb (get b k)
[a* b* ab] (diff va vb)
in-a (contains? a k)
in-b (contains? b k)
same (and in-a in-b
(or (not (nil? ab))
(and (nil? va) (nil? vb))))]
[(when (and in-a (or (not (nil? a*)) (not same))) {k a*})
(when (and in-b (or (not (nil? b*)) (not same))) {k b*})
(when same {k ab})]))
(defn- diff-associative
"Diff associative things a and b, comparing only keys in ks."
[a b ks]
(reduce
;; mapv (vector result) rather than the reference's (doall (map …)): the diff
;; triples are destructured positionally and a list with a nil middle element
;; mis-binds under jolt destructuring, whereas a vector indexes cleanly.
(fn [diff1 diff2] (mapv merge diff1 diff2))
[nil nil nil]
(mapv (partial diff-associative-key a b) ks)))
(defn- diff-sequential [a b]
(vec (mapv vectorize (diff-associative
(if (vector? a) a (vec a))
(if (vector? b) b (vec b))
(range (max (count a) (count b)))))))
(defn- diff-set [a b]
[(not-empty (set/difference a b))
(not-empty (set/difference b a))
(not-empty (set/intersection a b))])
(defn- equality-partition [x]
(cond
(nil? x) :atom
(map? x) :map
(set? x) :set
(sequential? x) :sequential
:else :atom))
(defn- diff-similar [a b]
((case (equality-partition a)
:atom atom-diff
:set diff-set
:sequential diff-sequential
:map (fn [a b] (diff-associative a b (set/union (keys a) (keys b)))))
a b))
(defn diff
"Recursively compares a and b, returning a tuple of
[things-only-in-a things-only-in-b things-in-both].
Comparison rules:
* For equal a and b, return [nil nil a].
* Maps are subdiffed where keys match and values differ.
* Sets are never subdiffed.
* All sequential things are treated as associative collections
by their indexes, with results returned as vectors.
* Everything else (including strings!) is treated as
an atom and compared for equality."
[a b]
(if (= a b)
[nil nil a]
(if (= (equality-partition a) (equality-partition b))
(diff-similar a b)
(atom-diff a b))))

View file

@ -1,13 +1,41 @@
; Jolt Standard Library: clojure.edn
; EDN reading and writing (stubs using the Jolt reader).
;; clojure.edn — reading EDN data. Delegates to the Jolt reader via
;; clojure.core/read-string (which parses, never evaluates — safe for EDN), and
;; adds the opts-map arity with :eof plus nil/blank-input handling.
(ns clojure.edn
"Reading EDN data."
(:require [clojure.string :as cstr]))
;; The reader yields set literals as a FORM ({:jolt/type :jolt/set :value [...]})
;; rather than a constructed set, so build the actual values, recursing into
;; maps/vectors/lists. (Lists stay lists — EDN never evaluates them as code.)
(defn- edn->value [x]
(cond
(and (map? x) (= :jolt/set (get x :jolt/type))) (set (map edn->value (get x :value)))
;; Only untagged structs are real maps; symbols/chars/tagged literals are also
;; struct? (=> map?) but carry a :jolt/type and must pass through unchanged.
(and (map? x) (nil? (get x :jolt/type)))
(into {} (map (fn [e] [(edn->value (key e)) (edn->value (val e))]) x))
(vector? x) (mapv edn->value x)
(seq? x) (map edn->value x)
:else x))
;; Private helper, NOT named read-string: an unqualified (read-string …) call
;; dispatches the core read-string SPECIAL FORM (by name, regardless of ns), so
;; the 1-arity can't delegate to the 2-arity through that name.
(defn- read-edn [opts s]
(if (or (nil? s) (cstr/blank? s))
(get opts :eof nil)
(edn->value (clojure.core/read-string s))))
(defn read-string
[s]
(let [ctx ((get (dyn :current-env) (symbol "init")))]
((get (dyn :current-env) (symbol "eval-string")) ctx s)))
"Reads one object from the string s. Returns the :eof option value (default
nil) for nil or blank input. opts is an options map; :eof sets the value
returned at end of input."
([s] (read-edn {} s))
([opts s] (read-edn opts s)))
(defn read
"Reads the next line from reader and parses one EDN object from it."
[reader]
(let [line ((get (dyn :current-env) (symbol "file/read")) reader :line)]
(when line
(read-string line))))
(when line (read-string line))))

View file

@ -24,7 +24,12 @@
(defn rename-keys
[map kmap]
(reduce (fn [m [old new]] (if (contains? m old) (assoc m new (get m old) old nil) m)) map kmap))
(reduce (fn [m [old new]]
(if (contains? map old)
(assoc m new (get map old))
m))
(apply dissoc map (keys kmap))
kmap))
(defn map-invert
[m]

View file

@ -1,98 +1,177 @@
; Jolt Standard Library: clojure.zip
; Functional zipper for tree navigation and editing.
; Copyright (c) Rich Hickey. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; Ported from clojure.zip (Rich Hickey). A loc is a vector [node path] carrying
;; the zipper fns (:zip/branch? :zip/children :zip/make-node) as metadata. The
;; reference indexes a loc with (loc 0)/(loc 1); Jolt uses (nth loc ...) because a
;; metadata-bearing vector is not currently invocable as a fn (see jolt-vh5).
(ns clojure.zip
"Functional hierarchical zipper, with navigation, editing, and enumeration.")
(defn zipper
"Creates a new zipper structure. branch? is a fn that, given a node, returns
true if it can have children. children returns a seq of a branch node's
children. make-node, given an existing node and a seq of children, returns a
new branch node. root is the root node."
[branch? children make-node root]
(let [z {:l [] :r [] :node root :pnodes [] :ppath nil :changed? false}]
(if (branch? root)
(let [chs (children root)]
(assoc z :l (vec (rest chs)) :node (first chs) :pnodes (conj (:pnodes z) root)))
z)))
(with-meta [root nil]
{:zip/branch? branch? :zip/children children :zip/make-node make-node}))
(defn node [z] (:node z))
(defn branch? [z] (and z (not (nil? (:node z)))))
(defn make-node [z node children]
(let [m (assoc z :node node :changed? true)]
(if children (assoc m :l (vec children)) m)))
(defn path [z] (:pnodes z))
(defn left [z]
(let [ls (:l z)]
(if (and (branch? z) (seq ls))
(assoc z :l (vec (rest ls)) :node (first ls)) nil)))
(defn right [z]
(if (and (branch? z) (seq (:r z)))
(assoc z :l (conj (:l z) (:node z)) :node (first (:r z)) :r (vec (rest (:r z)))) nil))
(defn up [z]
(if (seq (path z))
(let [pn (peek (path z))]
(assoc z :l nil :r (vec (concat (conj (:l z) (:node z)) (:r z))) :node pn :pnodes (pop (path z)))) nil))
(defn down [z]
(when (branch? z)
(let [chs (children z)]
(when (seq chs)
(assoc z :node (first chs) :l [] :r (vec (rest chs)) :pnodes (conj (path z) (:node z)))))))
(defn leftmost [z]
(let [p (up z)] (if p (down p) z)))
(defn rightmost [z]
(let [p (up z)]
(if p
(let [chs (children p)]
(assoc z :node (last chs) :l (vec (butlast chs)) :r [] :pnodes (conj (pop (path z)) (:node p)))) z)))
(defn next [z]
(if (= :end z) z
(or (and (branch? z) (down z))
(right z)
(loop [p z]
(if (up p)
(or (right (up p)) (recur (up p)))
(assoc z :node :end))))))
(defn prev [z]
(if-let [l (left z)]
(loop [l l]
(if-let [d (and (branch? l) (down l))]
(recur (rightmost d)) l)) (up z)))
(defn end? [z] (= :end (:node z)))
(defn remove [z]
(if-let [p (up z)]
(let [chs (children p)
new-chs (remove #{(:node z)} chs)]
(up (make-node p (:node p) new-chs))) (assoc z :node nil)))
(defn replace [z node]
(assoc z :node node :changed? true))
(defn edit [z f & args]
(replace z (apply f (:node z) args)))
(defn insert-left [z item]
(assoc z :l (conj (:l z) item)))
(defn insert-right [z item]
(assoc z :r (into [item] (:r z))))
(defn insert-child [z item]
(assoc z :l (into [item] (:l z))))
(defn append-child [z item]
(assoc z :l (conj (vec (:l z)) item)))
(defn root [z]
(if (seq (path z)) (recur (up z)) (:node z)))
(defn vector-zip [root]
(zipper vector? seq (fn [node children] (vec children)) root))
(defn seq-zip [root]
(defn seq-zip
"Returns a zipper for nested sequences, given a root sequence"
[root]
(zipper seq? identity (fn [node children] (with-meta children (meta node))) root))
(defn vector-zip
"Returns a zipper for nested vectors, given a root vector"
[root]
(zipper vector? seq (fn [node children] (with-meta (vec children) (meta node))) root))
(defn node "Returns the node at loc" [loc] (nth loc 0))
(defn branch? "Returns true if the node at loc is a branch"
[loc] ((:zip/branch? (meta loc)) (node loc)))
(defn children "Returns a seq of the children of node at loc, which must be a branch"
[loc]
(if (branch? loc)
((:zip/children (meta loc)) (node loc))
(throw "called children on a leaf node")))
(defn make-node "Returns a new branch node, given an existing node and new children."
[loc node children] ((:zip/make-node (meta loc)) node children))
(defn path "Returns a seq of nodes leading to this loc" [loc] (:pnodes (nth loc 1)))
(defn lefts "Returns a seq of the left siblings of this loc" [loc] (seq (:l (nth loc 1))))
(defn rights "Returns a seq of the right siblings of this loc" [loc] (:r (nth loc 1)))
(defn down "Returns the loc of the leftmost child of the node at this loc, or nil"
[loc]
(when (branch? loc)
(let [[node path] loc
[c & cnext :as cs] (children loc)]
(when cs
(with-meta [c {:l []
:pnodes (if path (conj (:pnodes path) node) [node])
:ppath path
:r cnext}]
(meta loc))))))
(defn up "Returns the loc of the parent of the node at this loc, or nil if at the top"
[loc]
(let [[node {l :l, ppath :ppath, pnodes :pnodes, r :r, changed? :changed?, :as path}] loc]
(when pnodes
(let [pnode (peek pnodes)]
(with-meta (if changed?
[(make-node loc pnode (concat l (cons node r)))
(and ppath (assoc ppath :changed? true))]
[pnode ppath])
(meta loc))))))
(defn root "Zips all the way up and returns the root node, reflecting any changes."
[loc]
(if (= :end (nth loc 1))
(node loc)
(let [p (up loc)]
(if p (recur p) (node loc)))))
(defn right "Returns the loc of the right sibling of the node at this loc, or nil"
[loc]
(let [[node {l :l, [r & rnext :as rs] :r, :as path}] loc]
(when (and path rs)
(with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc)))))
(defn rightmost "Returns the loc of the rightmost sibling of the node at this loc, or self"
[loc]
(let [[node {l :l r :r :as path}] loc]
(if (and path r)
(with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc))
loc)))
(defn left "Returns the loc of the left sibling of the node at this loc, or nil"
[loc]
(let [[node {l :l r :r :as path}] loc]
(when (and path (seq l))
(with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc)))))
(defn leftmost "Returns the loc of the leftmost sibling of the node at this loc, or self"
[loc]
(let [[node {l :l r :r :as path}] loc]
(if (and path (seq l))
(with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc))
loc)))
(defn insert-left "Inserts the item as the left sibling of the node at this loc, without moving"
[loc item]
(let [[node {l :l :as path}] loc]
(if (nil? path)
(throw "Insert at top")
(with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc)))))
(defn insert-right "Inserts the item as the right sibling of the node at this loc, without moving"
[loc item]
(let [[node {r :r :as path}] loc]
(if (nil? path)
(throw "Insert at top")
(with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc)))))
(defn replace "Replaces the node at this loc, without moving"
[loc node]
(let [[_ path] loc]
(with-meta [node (assoc path :changed? true)] (meta loc))))
(defn edit "Replaces the node at this loc with the value of (f node args)"
[loc f & args]
(replace loc (apply f (node loc) args)))
(defn insert-child "Inserts the item as the leftmost child of the node at this loc, without moving"
[loc item]
(replace loc (make-node loc (node loc) (cons item (children loc)))))
(defn append-child "Inserts the item as the rightmost child of the node at this loc, without moving"
[loc item]
(replace loc (make-node loc (node loc) (concat (children loc) [item]))))
(defn next
"Moves to the next loc in the hierarchy, depth-first. At the end, returns a
distinguished loc detectable via end?; if already at the end, stays there."
[loc]
(if (= :end (nth loc 1))
loc
(or
(and (branch? loc) (down loc))
(right loc)
(loop [p loc]
(if (up p)
(or (right (up p)) (recur (up p)))
[(node p) :end])))))
(defn prev
"Moves to the previous loc in the hierarchy, depth-first. At the root, returns nil."
[loc]
(if-let [lloc (left loc)]
(loop [loc lloc]
(if-let [child (and (branch? loc) (down loc))]
(recur (rightmost child))
loc))
(up loc)))
(defn end? "Returns true if loc represents the end of a depth-first walk"
[loc] (= :end (nth loc 1)))
(defn remove
"Removes the node at loc, returning the loc that would have preceded it in a
depth-first walk."
[loc]
(let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc]
(if (nil? path)
(throw "Remove at top")
(if (pos? (count l))
(loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))]
(if-let [child (and (branch? loc) (down loc))]
(recur (rightmost child))
loc))
(with-meta [(make-node loc (peek pnodes) rs)
(and ppath (assoc ppath :changed? true))]
(meta loc))))))

View file

@ -91,13 +91,16 @@
"complement" "core-complement"
"constantly" "core-constantly"
"memoize" "core-memoize"
"some" "core-some"
"range" "core-range"
"take" "core-take"
"drop" "core-drop"
"take-while" "core-take-while"
"drop-while" "core-drop-while"
"interpose" "core-interpose"
"nth" "core-nth"
"mapcat" "core-mapcat"
"apply" "core-apply"
"trampoline" "core-trampoline"
"list" "core-list"
"name" "core-name"
"subs" "core-subs"
@ -139,6 +142,42 @@
(= name "defmulti") (= name "defmethod") (= name "locking")
(= name "prefer-method") (= name "remove-method") (= name "remove-all-methods")))
# Forms the compiler can't compile correctly: definitional/stateful special
# forms and macros that mutate the context or build runtime values the emitter
# doesn't model (types, protocols, multimethods, dynamic binding, host interop).
# analyze-form throws uncompilable on these so the enclosing top-level form falls
# back to the interpreter — which handles them — instead of silently miscompiling.
# (Top-level occurrences are usually routed straight to the interpreter by
# loader/stateful-head?; this also covers them nested inside compiled forms.)
(def- uncompilable-heads
(let [t @{}]
# Interpreter special forms the compiler does NOT itself implement (it
# handles quote/do/if/def/fn*/let*/loop*/recur/throw/try). Kept in sync with
# eval-form's special-form match in evaluator.janet.
(each n ["syntax-quote" "unquote" "unquote-splicing" "eval" "read-string"
"macroexpand-1" "defonce" "defmacro" "deftype" "defmulti"
"defmethod" "prefer-method" "remove-method" "remove-all-methods"
"get-method" "methods" "register-method" "protocol-dispatch"
"make-reified" "satisfies?" "instance?" "set!" "var" "var-get"
"var-set" "var?" "in-ns" "ns" "require" "create-ns" "remove-ns"
"find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve"
"ns-resolve" "ns-aliases" "ns-imports" "ns-interns"
"alter-var-root" "alter-meta!" "reset-meta!" "locking" "new"
"disj" "set?"
# Definitional/host macros that mutate context or build runtime
# values the emitter doesn't model.
"defrecord" "defprotocol" "definterface" "reify" "proxy"
"extend-type" "extend-protocol" "extend" "gen-class" "import"
"use" "refer" "monitor-enter" "monitor-exit" "binding" "."
# letfn needs all its fns in scope simultaneously (mutual
# recursion); the sequential let* the compiler would build can't
# express that, so interpret it.
"letfn"]
(put t n true))
t))
(defn- uncompilable-head? [name] (get uncompilable-heads name))
# ============================================================
# Macro resolution
# ============================================================
@ -149,7 +188,12 @@
(let [name (sym-s :name)
ns-sym (sym-s :ns)]
(if ns-sym
(let [target-ns (ctx-find-ns ctx ns-sym)
# Resolve :as aliases (e.g. (t/is …) where t aliases clojure.test) so
# aliased macros are recognized as macros — matching the interpreter's
# resolve-var — rather than miscompiled as a value ref to the macro var.
(let [cur (ctx-find-ns ctx (ctx-current-ns ctx))
aliased (ns-import-lookup cur ns-sym)
target-ns (ctx-find-ns ctx (or aliased ns-sym))
v (ns-find target-ns name)]
(if (and v (var-macro? v)) v))
(let [current-ns-name (ctx-current-ns ctx)
@ -161,100 +205,6 @@
cv (ns-find core-ns name)]
(if (and cv (var-macro? cv)) cv))))))))
# ============================================================
# Core function value lookup
# ============================================================
(def- core-fn-values
(let [t @{}]
(put t "core-+" core-+)
(put t "core-sub" core-sub)
(put t "core-*" core-*)
(put t "core-/" core-/)
(put t "core-inc" core-inc)
(put t "core-dec" core-dec)
(put t "core-=" core-=)
(put t "core-not=" core-not=)
(put t "core-<" core-<)
(put t "core->" core->)
(put t "core-<=" core-<=)
(put t "core->=" core->=)
(put t "core-nil?" core-nil?)
(put t "core-not" core-not)
(put t "core-some?" core-some?)
(put t "core-string?" core-string?)
(put t "core-number?" core-number?)
(put t "core-fn?" core-fn?)
(put t "core-keyword?" core-keyword?)
(put t "core-symbol?" core-symbol?)
(put t "core-vector?" core-vector?)
(put t "core-map?" core-map?)
(put t "core-seq?" core-seq?)
(put t "core-coll?" core-coll?)
(put t "core-true?" core-true?)
(put t "core-false?" core-false?)
(put t "core-identical?" core-identical?)
(put t "core-zero?" core-zero?)
(put t "core-pos?" core-pos?)
(put t "core-neg?" core-neg?)
(put t "core-even?" core-even?)
(put t "core-odd?" core-odd?)
(put t "core-empty?" core-empty?)
(put t "core-every?" core-every?)
(put t "core-first" core-first)
(put t "core-rest" core-rest)
(put t "core-next" core-next)
(put t "core-cons" core-cons)
(put t "core-conj" core-conj)
(put t "core-assoc" core-assoc)
(put t "core-dissoc" core-dissoc)
(put t "core-get" core-get)
(put t "core-get-in" core-get-in)
(put t "core-contains?" core-contains?)
(put t "core-count" core-count)
(put t "core-seq" core-seq)
(put t "core-vec" core-vec)
(put t "core-map" core-map)
(put t "core-filter" core-filter)
(put t "core-remove" core-remove)
(put t "core-reduce" core-reduce)
(put t "core-str" core-str)
(put t "core-prn" core-prn)
(put t "core-println" core-println)
(put t "core-print" core-print)
(put t "core-identity" core-identity)
(put t "core-comp" core-comp)
(put t "core-partial" core-partial)
(put t "core-complement" core-complement)
(put t "core-constantly" core-constantly)
(put t "core-memoize" core-memoize)
(put t "core-range" core-range)
(put t "core-take" core-take)
(put t "core-drop" core-drop)
(put t "core-take-while" core-take-while)
(put t "core-drop-while" core-drop-while)
(put t "core-reverse" core-reverse)
(put t "core-into" core-into)
(put t "core-merge" core-merge)
(put t "core-merge-with" core-merge-with)
(put t "core-keys" core-keys)
(put t "core-vals" core-vals)
(put t "core-zipmap" core-zipmap)
(put t "core-select-keys" core-select-keys)
(put t "core-max" core-max)
(put t "core-min" core-min)
(put t "core-quot" core-quot)
(put t "core-rem" core-rem)
(put t "core-mod" core-mod)
(put t "core-apply" apply)
(put t "core-some" core-some?)
(put t "core-pr-str" core-pr-str)
(put t "core-nth" core-nth)
(put t "core-list" core-list)
(put t "core-name" core-name)
(put t "core-subs" core-subs)
t))
# Loop counter for generating unique loop function names
(var loop-counter 0)
@ -264,6 +214,15 @@
(++ loop-counter)
name))
(defn- make-gensym
"A fresh, collision-proof Janet symbol name for compiler-introduced bindings
(recur targets, arity-dispatch arg vectors). The leading `_jolt$` can't appear
in a Clojure source symbol, so these never shadow user names."
[prefix]
(let [name (string "_jolt$" prefix "_" loop-counter)]
(++ loop-counter)
name))
# ============================================================
# Syntax-quote expansion
# ============================================================
@ -352,6 +311,24 @@
# Analyzer
# ============================================================
(defn- plain-symbol?
"A bare Clojure symbol (not a destructuring pattern). `&` counts — it's the
varargs marker, which the emitter passes straight through to Janet."
[x]
(and (struct? x) (= :symbol (x :jolt/type))))
(defn- uncompilable
"Signal that the compiler can't (yet) handle this form. eval-one catches this
and falls back to the interpreter, which handles every form correctly. Throwing
here — rather than miscompiling — is what makes the hybrid path sound."
[reason]
(error (string "jolt/uncompilable: " reason)))
# fn* analysis is large enough (optional self-name, multi-arity, varargs, recur
# targets) to live in its own helper. Forward-declared so the fn* case in
# analyze-form can call it; defined after analyze-form (which it recurses into).
(var analyze-fn nil)
(defn analyze-form
"Analyze a Clojure form and return an AST node with :op key.
Takes bindings (table) and optional ctx (for macro expansion)."
@ -370,13 +347,35 @@
{:op :local :name name}
(if (and (not (special-form? name)) (get core-renames name))
{:op :core-symbol :name name :janet-name (get core-renames name)}
{:op :symbol :name name}))))
# A global reference. Resolution mirrors the interpreter's resolve-sym
# so compiled and interpreted code agree:
# 1. a jolt var in the current ns (which also holds refers) or
# clojure.core -> deref through the cell, so redefinition is
# visible to compiled callers (Janet early-binds plain symbols);
# 2. otherwise a binding in the runtime/Janet env (resolve-sym's own
# fallback — this is how int?, type, etc. resolve) -> emit it
# directly;
# 3. otherwise a forward reference -> intern a pending cell whose
# getter derefs at call time, once a later def fills it in.
# No ctx -> plain symbol.
(if ctx
(let [cur-ns (ctx-find-ns ctx (ctx-current-ns ctx))
cell (or (ns-find cur-ns name)
(ns-find (ctx-find-ns ctx "clojure.core") name))]
(cond
cell {:op :var :name name :var cell}
(get jolt-runtime-env (symbol name))
{:op :core-symbol :name name :janet-name name}
{:op :var :name name :var (ns-intern cur-ns name)}))
{:op :symbol :name name})))))
(array? form)
(let [first-form (first form)
head-name (if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
(first-form :name)
nil)]
(when (and head-name (uncompilable-head? head-name))
(uncompilable head-name))
# Macro expansion
(if (and ctx head-name
(not (special-form? head-name))
@ -426,54 +425,48 @@
"do" (let [all-statements (array/slice form 1)
n (length all-statements)
analyzed (map |(analyze-form $ bindings ctx) all-statements)]
{:op :do
:statements (array/slice analyzed 0 (- n 1))
:ret (in analyzed (- n 1))})
(if (= n 0)
{:op :const :val nil} # (do) -> nil
{:op :do
:statements (array/slice analyzed 0 (- n 1))
:ret (in analyzed (- n 1))}))
"if" {:op :if
:test (analyze-form (in form 1) bindings ctx)
:then (analyze-form (in form 2) bindings ctx)
:else (if (> (length form) 3)
(analyze-form (in form 3) bindings ctx)
{:op :const :val nil})}
"def" {:op :def
:name (in form 1)
:init (analyze-form (in form 2) bindings ctx)}
"fn*" (let [params (in form 1)
body-bindings (do
(var bb @{})
(loop [[k v] :pairs bindings] (put bb k v))
(each p params
(put bb (if (struct? p) (p :name) p) :jolt/local))
bb)
body-exprs (tuple/slice form 2)
analyzed-body (map |(analyze-form $ body-bindings ctx) body-exprs)
n-body (length analyzed-body)]
{:op :fn :params params
:body (if (> n-body 1)
{:op :do
:statements (array/slice analyzed-body 0 (- n-body 1))
:ret (last analyzed-body)}
(first analyzed-body))})
"def" (let [name-sym (in form 1)
nm (if (struct? name-sym) (name-sym :name) (string name-sym))
# Create/find the var cell first so a recursive init body
# self-references the same cell.
cell (when ctx (ns-intern (ctx-find-ns ctx (ctx-current-ns ctx)) nm))
# (def x) with no init (declare) -> nil.
init-form (if (> (length form) 2) (in form 2) nil)]
{:op :def :name name-sym :var cell
:init (analyze-form init-form bindings ctx)})
"fn*" (analyze-fn form bindings ctx)
"let*" (let [bind-vec (in form 1)
body-exprs (tuple/slice form 2)
# Accumulate scope as we go so a later binding's init can
# reference an earlier binding (sequential let scoping).
acc (do (var bb @{}) (loop [[k v] :pairs bindings] (put bb k v)) bb)
binding-pairs (do
(var pairs @[])
(var i 0)
(let [n (length bind-vec)]
(while (< i n)
(let [sym-s (in bind-vec i)
name (if (struct? sym-s) (sym-s :name) sym-s)
_ (unless (plain-symbol? sym-s)
(uncompilable "destructuring let binding"))
name (sym-s :name)
val-form (if (< (+ i 1) n) (in bind-vec (+ i 1)) nil)
val-ast (if val-form (analyze-form val-form bindings ctx) {:op :const :val nil})]
val-ast (if val-form (analyze-form val-form acc ctx) {:op :const :val nil})]
(array/push pairs {:name name :init val-ast})
(put acc name :jolt/local)
(+= i 2))))
pairs)
body-bindings (do
(var bb @{})
(loop [[k v] :pairs bindings] (put bb k v))
(each bp binding-pairs
(put bb (bp :name) :jolt/local))
bb)
body-bindings acc
analyzed-body (map |(analyze-form $ body-bindings ctx) body-exprs)
n-body (length analyzed-body)]
{:op :let
@ -485,16 +478,20 @@
(first analyzed-body))})
"loop*" (let [bind-vec (in form 1)
loop-name (make-loop-name)
acc (do (var bb @{}) (loop [[k v] :pairs bindings] (put bb k v)) bb)
binding-pairs (do
(var pairs @[])
(var i 0)
(let [n (length bind-vec)]
(while (< i n)
(let [sym-s (in bind-vec i)
name (if (struct? sym-s) (sym-s :name) sym-s)
_ (unless (plain-symbol? sym-s)
(uncompilable "destructuring loop binding"))
name (sym-s :name)
val-form (if (< (+ i 1) n) (in bind-vec (+ i 1)) nil)
val-ast (if val-form (analyze-form val-form bindings ctx) {:op :const :val nil})]
val-ast (if val-form (analyze-form val-form acc ctx) {:op :const :val nil})]
(array/push pairs {:name name :init val-ast})
(put acc name :jolt/local)
(+= i 2))))
pairs)
param-names (map |($ :name) binding-pairs)
@ -534,10 +531,94 @@
{:op :set :items (map |(analyze-form $ bindings ctx) (form :value))}
(= :jolt/char (form :jolt/type))
{:op :const :val form}
{:op :map :form form})
# Tagged literals (#"regex", data readers) need runtime construction the
# compiler doesn't model — interpret them.
(form :jolt/type)
(uncompilable (string "tagged literal " (form :jolt/type)))
# Plain map literal: keys and values are expressions to evaluate.
{:op :map
:pairs (map (fn [k] [(analyze-form k bindings ctx)
(analyze-form (get form k) bindings ctx)])
(keys form))})
{:op :const :val form}))
(defn- parse-fn-params
"Split a param vector into fixed param names and an optional rest name. Only
plain symbols are handled here; destructuring params signal uncompilable so the
whole fn falls back to the interpreter."
[params]
(unless (tuple? params) (uncompilable "fn params not a vector"))
(def fixed @[])
(var rest-name nil)
(var i 0)
(def n (length params))
(while (< i n)
(def p (in params i))
(unless (plain-symbol? p) (uncompilable "destructuring fn params"))
(if (= "&" (p :name))
(do
(++ i)
(when (< i n)
(def r (in params i))
(unless (plain-symbol? r) (uncompilable "destructuring fn rest param"))
(set rest-name (r :name)))
(++ i))
(do (array/push fixed (p :name)) (++ i))))
{:fixed (tuple/slice fixed) :rest rest-name})
(set analyze-fn
(fn analyze-fn [form bindings ctx]
# (fn* name? params-or-clauses...) where a clause is (params body...).
(def named? (plain-symbol? (in form 1)))
(def fn-name (when named? ((in form 1) :name)))
(def idx (if named? 2 1))
(def first-clause (in form idx))
# Single arity: a param vector at idx. Multi arity: each remaining element is
# an (params body...) list.
(def raw-clauses
(cond
(tuple? first-clause) [[first-clause (tuple/slice form (+ idx 1))]]
(array? first-clause) (map |[(in $ 0) (tuple/slice $ 1)] (tuple/slice form idx))
(uncompilable "fn: unexpected param shape")))
(def multi (> (length raw-clauses) 1))
# Public name: the symbol the fn binds to itself. Single-arity fns recur
# straight into this name; multi-arity fns recur into a per-arity inner fn so
# recur stays in its own arity rather than re-dispatching.
(def outer-name (or fn-name (make-gensym "fn")))
(def arities
(map
(fn [clause]
(def pinfo (parse-fn-params (in clause 0)))
(def fixed (pinfo :fixed))
(def rest-name (pinfo :rest))
(def recur-name
(if (and (not multi) (not rest-name)) outer-name (make-gensym "arity")))
(def body-bindings
(do
(var bb @{})
(loop [[k v] :pairs bindings] (put bb k v))
(when fn-name (put bb fn-name :jolt/local))
(each pn fixed (put bb pn :jolt/local))
(when rest-name (put bb rest-name :jolt/local))
(put bb :jolt/current-loop recur-name)
bb))
(def body-exprs (in clause 1))
(def analyzed (map |(analyze-form $ body-bindings ctx) body-exprs))
(def n-body (length analyzed))
{:param-names fixed
:rest-name rest-name
:n-fixed (length fixed)
:recur-name recur-name
:body (cond
(= 0 n-body) {:op :const :val nil}
(= 1 n-body) (first analyzed)
{:op :do
:statements (array/slice analyzed 0 (- n-body 1))
:ret (last analyzed)})})
raw-clauses))
{:op :fn :name outer-name :fn-name fn-name :multi multi :arities arities}))
# ============================================================
# Emitter — AST → Janet source string
# ============================================================
@ -575,16 +656,32 @@
(buffer/push buf "(def ") (buffer/push buf (name-sym :name))
(buffer/push buf " ") (emit-ast init buf) (buffer/push buf ")"))
(defn- emit-fn-str [params body buf]
(buffer/push buf "(fn [")
(defn- emit-arity-str [ar buf]
(buffer/push buf "[")
(var i 0)
(let [n (length params)]
(let [n (length (ar :param-names))]
(while (< i n)
(let [p (in params i)]
(buffer/push buf (if (struct? p) (p :name) (string p))))
(when (< (+ i 1) n) (buffer/push buf " "))
(buffer/push buf (in (ar :param-names) i))
(when (or (< (+ i 1) n) (ar :rest-name)) (buffer/push buf " "))
(++ i)))
(buffer/push buf "] ") (emit-ast body buf) (buffer/push buf ")"))
(when (ar :rest-name)
(buffer/push buf "& ") (buffer/push buf (ar :rest-name)))
(buffer/push buf "] ")
(emit-ast (ar :body) buf))
# Debug/source rendering. Single arity matches the original `(fn [params] body)`
# shape; multi-arity renders each arity as a clause. This path is for inspection
# (compile-string); the data emitter is the one that actually runs.
(defn- emit-fn-str [ast buf]
(def arities (ast :arities))
(if (ast :multi)
(do
(buffer/push buf "(fn")
(each ar arities
(buffer/push buf " (") (emit-arity-str ar buf) (buffer/push buf ")"))
(buffer/push buf ")"))
(do
(buffer/push buf "(fn ") (emit-arity-str (first arities) buf) (buffer/push buf ")"))))
(defn- emit-let-str [binding-pairs body buf]
(buffer/push buf "(let [")
@ -670,7 +767,12 @@
(++ i)))
(buffer/push buf "]"))
(defn- emit-map-str [form buf] (buffer/push buf (string form)))
(defn- emit-map-str [pairs buf]
(buffer/push buf "(build-map-literal")
(each [k v] pairs
(buffer/push buf " ") (emit-ast k buf)
(buffer/push buf " ") (emit-ast v buf))
(buffer/push buf ")"))
(defn- emit-set-str [items buf]
(buffer/push buf "(make-phs")
@ -709,13 +811,14 @@
(match (ast :op)
:const (emit-const-str (ast :val) buf)
:symbol (emit-symbol-str (ast :name) buf)
:var (emit-symbol-str (ast :name) buf)
:local (emit-local-str (ast :name) buf)
:core-symbol (emit-core-symbol-str (ast :janet-name) buf)
:qualified-symbol (emit-qualified-symbol-str (ast :ns) (ast :name) buf)
:do (emit-do-str (ast :statements) (ast :ret) buf)
:if (emit-if-str (ast :test) (ast :then) (ast :else) buf)
:def (emit-def-str (ast :name) (ast :init) buf)
:fn (emit-fn-str (ast :params) (ast :body) buf)
:fn (emit-fn-str ast buf)
:let (emit-let-str (ast :binding-pairs) (ast :body) buf)
:throw (emit-throw-str (ast :val) buf)
:try (emit-try-str (ast :body) (ast :catch-sym) (ast :catch-body) (ast :finally-body) buf)
@ -723,7 +826,7 @@
:recur (emit-recur-str (ast :args) (ast :loop-name) buf)
:invoke (emit-invoke-str (ast :fn) (ast :args) buf)
:vector (emit-vector-str (ast :items) buf)
:map (emit-map-str (ast :form) buf)
:map (emit-map-str (ast :pairs) buf)
:set (emit-set-str (ast :items) buf)
:quote (emit-quote-str (ast :expr) buf)
(buffer/push buf (string "/* unhandled op: " (ast :op) " */")))))
@ -746,8 +849,12 @@
(defn- emit-core-symbol-expr [janet-name]
(if (get native-ops janet-name)
(symbol janet-name)
(or (get core-fn-values janet-name)
(error (string "Core fn not found: " janet-name)))))
# Resolve the core-* function value from the compiler's runtime env (where
# `(use ./core)` bound them all) rather than a hand-maintained table that can
# drift out of sync. A name with no binding falls back to the interpreter.
(let [b (get jolt-runtime-env (symbol janet-name))]
(if b (b :value)
(uncompilable (string "core fn not found: " janet-name))))))
(defn- emit-qualified-symbol-expr [ns name]
(error (string "Cannot eval qualified symbol at compile time: " ns "/" name)))
@ -768,11 +875,62 @@
(defn- emit-def-expr [name-sym init]
['def (symbol (name-sym :name)) (emit-expr init)])
(defn- emit-fn-expr [params body]
(def param-syms @[])
(each p params
(array/push param-syms (symbol (if (struct? p) (p :name) p))))
['fn (tuple/slice (tuple ;param-syms)) (emit-expr body)])
# Var-indirection: a global reference derefs its cell at call time, and a def
# sets the same cell's root and returns it (Clojure's #'var). Janet COPIES table
# constants when compiling but references functions, so we embed memoized
# getter/setter CLOSURES over the cell (by reference) rather than the cell itself.
(defn- var-getter [cell]
(or (get cell :jolt/getter)
(let [g (fn [] (var-get cell))] (put cell :jolt/getter g) g)))
(defn- var-setter [cell]
(or (get cell :jolt/setter)
(let [s (fn [v] (bind-root cell v) cell)] (put cell :jolt/setter s) s)))
(defn- emit-var-expr [cell] (tuple (var-getter cell)))
(defn- emit-def-var-expr [cell init] (tuple (var-setter cell) (emit-expr init)))
# An arity compiles to a named Janet fn whose name is its recur target — a
# recur is just a self-call (Janet tail-calls it). The rest param is an ordinary
# param holding a seq (not Janet `&`), so `(recur fixed... rest-seq)` works the
# way Clojure recur into a variadic arity does.
(defn- emit-arity-fn [ar]
(def ps @[])
(each pn (ar :param-names) (array/push ps (symbol pn)))
(when (ar :rest-name) (array/push ps (symbol (ar :rest-name))))
['fn (symbol (ar :recur-name)) (tuple/slice ps) (emit-expr (ar :body))])
# Invoke an arity's fn with the actual args pulled out of the dispatch vector:
# fixed params by index, rest as a tuple slice.
(defn- emit-arity-invoke [ar jargs]
(def call @[(emit-arity-fn ar)])
(for i 0 (ar :n-fixed) (array/push call ['in jargs i]))
(when (ar :rest-name) (array/push call ['tuple/slice jargs (ar :n-fixed)]))
(tuple/slice call))
(defn- emit-fn-expr [ast]
(def arities (ast :arities))
(cond
# Single fixed arity — the common, hot case. Emit the arity fn directly
# (its name is the public name and the recur target); no dispatch overhead.
(and (not (ast :multi)) (not ((first arities) :rest-name)))
(emit-arity-fn (first arities))
# Single variadic arity: a thin wrapper collects the call's args so the rest
# seq can be built, then hands off to the arity fn.
(not (ast :multi))
(let [jargs (symbol (make-gensym "args"))]
['fn (symbol (ast :name)) ['& jargs] (emit-arity-invoke (first arities) jargs)])
# Multi-arity: dispatch on arg count. Fixed arities match exactly; the (one)
# variadic arity matches >= its fixed count and goes last.
(let [jargs (symbol (make-gensym "args"))
n-sym (symbol (make-gensym "n"))
cond-form @['cond]]
(each ar arities
(if (ar :rest-name)
(array/push cond-form ['>= n-sym (ar :n-fixed)])
(array/push cond-form ['= n-sym (ar :n-fixed)]))
(array/push cond-form (emit-arity-invoke ar jargs)))
(array/push cond-form ['error "Wrong number of args passed to fn"])
['fn (symbol (ast :name)) ['& jargs]
['let [n-sym ['length jargs]] (tuple/slice cond-form)]])))
(defn- emit-let-expr [binding-pairs body]
(def bind-tuple @[])
@ -828,7 +986,7 @@
# only when the head is a keyword/collection literal in call position (an IFn
# that needs runtime lookup), e.g. (:k m) or ({:a 1} :a).
(def direct (case (f-ast :op)
:core-symbol true :symbol true :local true
:core-symbol true :symbol true :var true :local true
:qualified-symbol true :fn true
false))
(def f (emit-expr f-ast))
@ -836,12 +994,40 @@
(each arg args (array/push exprs (emit-expr arg)))
(tuple/slice (tuple ;exprs)))
# A vector literal builds a mode-appropriate jolt vector (pvec when immutable,
# array when mutable) via make-vec — the same constructor the interpreter uses —
# so compiled and interpreted vectors share one representation. (Emitting a bare
# Janet tuple diverged: type-strict ops like rseq reject tuples.)
(defn- emit-vector-expr [items]
(def exprs @['tuple])
(each item items (array/push exprs (emit-expr item)))
(tuple/slice (tuple ;exprs)))
(def t @['tuple])
(each item items (array/push t (emit-expr item)))
[make-vec (tuple/slice t)])
(defn- emit-map-expr [form] form)
# Build a jolt map literal from evaluated alternating k/v args, mirroring the
# interpreter (eval-form's map-literal case): a Janet struct unless a key is a
# collection, in which case a phm so the key compares by value. Embedded as a
# function constant in emitted code (functions marshal by reference).
(defn build-map-literal [& kvs]
# phm (not a Janet struct) when a key is a collection (value-based hashing) or a
# key/value is nil (structs drop nil; phm preserves it, matching Clojure).
(var need-phm false)
(var ki 0)
(while (< ki (length kvs))
(let [kk (in kvs ki) vv (in kvs (+ ki 1))]
(when (or (table? kk) (array? kk) (nil? kk) (nil? vv)) (set need-phm true)))
(+= ki 2))
(if need-phm
(do (var m (make-phm)) (var j 0)
(while (< j (length kvs)) (set m (phm-assoc m (in kvs j) (in kvs (+ j 1)))) (+= j 2))
m)
(struct ;kvs)))
(defn- emit-map-expr [pairs]
(def call @[build-map-literal])
(each [k v] pairs
(array/push call (emit-expr k))
(array/push call (emit-expr v)))
(tuple/slice call))
(defn- emit-set-expr [items]
(tuple/slice (tuple make-phs ;(map emit-expr items))))
@ -854,13 +1040,15 @@
(match (ast :op)
:const (emit-const-expr (ast :val))
:symbol (emit-symbol-expr (ast :name))
:var (emit-var-expr (ast :var))
:local (emit-local-expr (ast :name))
:core-symbol (emit-core-symbol-expr (ast :janet-name))
:qualified-symbol (emit-qualified-symbol-expr (ast :ns) (ast :name))
:do (emit-do-expr (ast :statements) (ast :ret))
:if (emit-if-expr (ast :test) (ast :then) (ast :else))
:def (emit-def-expr (ast :name) (ast :init))
:fn (emit-fn-expr (ast :params) (ast :body))
:def (if (ast :var) (emit-def-var-expr (ast :var) (ast :init))
(emit-def-expr (ast :name) (ast :init)))
:fn (emit-fn-expr ast)
:let (emit-let-expr (ast :binding-pairs) (ast :body))
:throw (emit-throw-expr (ast :val))
:try (emit-try-expr (ast :body) (ast :catch-sym) (ast :catch-body) (ast :finally-body))
@ -868,7 +1056,7 @@
:recur (emit-recur-expr (ast :args) (ast :loop-name))
:invoke (emit-invoke-expr (ast :fn) (ast :args))
:vector (emit-vector-expr (ast :items))
:map (emit-map-expr (ast :form))
:map (emit-map-expr (ast :pairs))
:set (emit-set-expr (ast :items))
:quote (emit-quote-expr (ast :expr))
(error (string "Unhandled op: " (ast :op))))))
@ -893,30 +1081,17 @@
(emit-expr (analyze-form form @{} ctx)))
(defn compile-and-eval
"Compile a Clojure form and evaluate it as Janet, in the context's persistent
Janet env (so compiled def/defn bindings resolve across forms). For def/defn
forms, also interns the result in the Jolt namespace so the interpreter can
resolve it later."
"Compile a Clojure form and evaluate it as Janet. Globals resolve through Jolt
var cells (see analyze-form/:var), so compiled def/defn results are visible to
the interpreter (the cell is the namespace var), recursion self-references the
cell, and redefinition is seen by compiled callers — no separate interning or
named-fn rewrite needed."
[form ctx]
(def env (ctx-janet-env ctx))
(def def-form? (and ctx (array? form) (> (length form) 0)
(struct? (first form)) (= :symbol ((first form) :jolt/type))
(let [h ((first form) :name)] (or (= h "def") (= h "defn") (= h "defn-")))))
(def def-name (when def-form?
(let [name-sym (in form 1)] (if (struct? name-sym) (name-sym :name) name-sym))))
(var compiled (compile-ast form ctx))
# Name the fn after the def so a recursive body self-references lexically
# ((def f (fn [..] (f ..))) -> (def f (fn f [..] (f ..)))); the anonymous form
# can't resolve f at compile time.
(when (and def-name (indexed? compiled) (= 3 (length compiled))
(= 'def (in compiled 0))
(indexed? (in compiled 2)) (= 'fn (in (in compiled 2) 0))
(indexed? (in (in compiled 2) 1))) # 3rd elem is (fn [params] ...)
(let [f (in compiled 2)]
(set compiled [(in compiled 0) (in compiled 1)
[(in f 0) (symbol def-name) ;(tuple/slice f 1)]])))
(def result (eval compiled env))
# Also intern def/defn results in the Jolt namespace for interpreter resolution.
(when def-name
(ns-intern (ctx-find-ns ctx (ctx-current-ns ctx)) def-name result))
result)
(eval (compile-ast form ctx) (ctx-janet-env ctx)))
(defn eval-compiled
"Evaluate an already-compiled Janet form (the result of compile-ast) in the
context's compiled env. Split out from compile-and-eval so callers can guard
the compile step alone — see eval-one's hybrid fallback."
[compiled ctx]
(eval compiled (ctx-janet-env ctx)))

File diff suppressed because it is too large Load diff

View file

@ -34,6 +34,30 @@
(var eval-form nil)
# Macro expansion cache (interpreter): a macro CALL form expands ONCE and the
# result is reused — macroexpansion is a compile-time step with zero runtime cost,
# the proper Lisp model. Keyed by the call form's identity (a fn body re-evaluates
# the same form arrays each call). Also gives compile-once gensym semantics (a
# foo# auto-gensym is fixed across calls, unlike per-call re-expansion). Cleared
# when a macro is (re)defined so stale expansions don't linger.
(def macro-cache @{})
# Compile hook for macro expanders: set by the api to (fn [ctx args-form body] ->
# compiled-janet-fn | nil). When set and the body is compilable (no &env/&form,
# analyzer available), defmacro uses the compiled expander instead of the
# interpreted closure — macro expansion at native speed, zero runtime cost.
(var macro-compile-hook nil)
(defn- form-uses-sym? [form nm]
(cond
(and (struct? form) (= :symbol (form :jolt/type))) (= nm (form :name))
(or (array? form) (tuple? form))
(do (var found false) (each x form (when (form-uses-sym? x nm) (set found true) (break))) found)
(and (struct? form) (nil? (form :jolt/type)))
(do (var found false) (each k (keys form)
(when (or (form-uses-sym? k nm) (form-uses-sym? (get form k) nm)) (set found true) (break))) found)
false))
# A transient is a tagged mutable table @{:jolt/type :jolt/transient :kind ...}.
(defn- jolt-transient? [x]
(and (table? x) (= :jolt/transient (get x :jolt/type))))
@ -128,6 +152,25 @@
{:jolt/type :symbol :ns (ctx-current-ns ctx) :name nm}))
form))
(defn- d-realize
"Realize a lazy-seq to an array for positional destructuring / splicing; pass
others (pvec/plist coerced to array, everything else unchanged)."
[val]
(if (pvec? val) (pv->array val)
(if (plist? val) (pl->array val)
(if (lazy-seq? val)
(do
(var items @[]) (var cur val) (var go true)
(while go
(let [cell (realize-ls cur)]
(if (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))
(set go false)
(do (array/push items (in cell 0))
(let [rt (in cell 1)]
(if (nil? rt) (set go false) (set cur (make-lazy-seq rt))))))))
items)
val))))
(defn- syntax-quote*
[ctx bindings form &opt gsmap]
(default gsmap @{})
@ -145,7 +188,7 @@
(let [item (in form i)]
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
(let [sv (eval-form ctx bindings (in item 1))]
(each v (if (pvec? sv) (pv->array sv) sv) (array/push result v)))
(each v (d-realize sv) (array/push result v)))
(array/push result (syntax-quote* ctx bindings item gsmap))))
(++ i)) (tuple ;result))
(array? form)
@ -153,7 +196,7 @@
(let [item (in form i)]
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
(let [sv (eval-form ctx bindings (in item 1))]
(each v (if (pvec? sv) (pv->array sv) sv) (array/push result v)))
(each v (d-realize sv) (array/push result v)))
(array/push result (syntax-quote* ctx bindings item gsmap))))
(++ i)) result)
(and (struct? form) (get form :jolt/type)) form
@ -163,6 +206,49 @@
(array/push kvs (syntax-quote* ctx bindings (get form k) gsmap))) (struct ;kvs))
form))
# Syntax-quote LOWERING: instead of evaluating a `(...) form to a value (what
# syntax-quote* does), produce equivalent CONSTRUCTION CODE so a backtick body is
# plain compilable code (read -> macroexpand -> compile, zero runtime cost).
# Mirrors syntax-quote*/sq-symbol exactly; the canonical algorithm is
# tools.reader's syntax-quote*/expand-list. List forms build via __sqcat (-> array),
# vectors via __sqvec (-> tuple), maps via __sqmap; symbols become (quote resolved);
# ~ leaves the expr in place, ~@ passes the seq straight to __sqcat for splicing.
(defn- sqsym* [nm] {:jolt/type :symbol :ns nil :name nm})
(var syntax-quote-lower nil)
(defn- sq-lower-part [ctx item gsmap]
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
(in item 1)
@[(sqsym* "__sq1") (syntax-quote-lower ctx item gsmap)]))
(set syntax-quote-lower
(fn syntax-quote-lower [ctx form &opt gsmap]
(default gsmap @{})
(cond
(and (array? form) (> (length form) 0) (sym-name? (first form) "unquote"))
(in form 1)
(and (array? form) (> (length form) 0) (sym-name? (first form) "unquote-splicing"))
(error "~@ used outside of a list or vector in syntax-quote")
(or (number? form) (string? form) (keyword? form) (nil? form) (= true form) (= false form))
form
(and (struct? form) (= :symbol (form :jolt/type)))
@[(sqsym* "quote") (sq-symbol ctx form gsmap)]
(array? form)
(array/concat @[(sqsym* "__sqcat")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
(tuple? form)
(array/concat @[(sqsym* "__sqvec")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
# tagged structs (sets/chars): syntax-quote* returns them as-is (no recursion)
(and (struct? form) (get form :jolt/type))
@[(sqsym* "quote") form]
(struct? form)
(do (var parts @[(sqsym* "__sqmap")])
(each k (keys form)
(array/push parts (syntax-quote-lower ctx k gsmap))
(array/push parts (syntax-quote-lower ctx (get form k) gsmap)))
parts)
@[(sqsym* "quote") form])))
(defn resolve-var
[ctx bindings sym-s]
(let [name (sym-s :name) ns (sym-s :ns)]
@ -430,24 +516,6 @@
(do (array/push fixed a) (+= i 1)))))
{:fixed (tuple/slice (tuple ;fixed)) :rest rest-pat})
(defn- d-realize
"Realize a lazy-seq to an array for positional destructuring; pass others through."
[val]
(if (pvec? val) (pv->array val)
(if (plist? val) (pl->array val)
(if (lazy-seq? val)
(do
(var items @[]) (var cur val) (var go true)
(while go
(let [cell (realize-ls cur)]
(if (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))
(set go false)
(do (array/push items (in cell 0))
(let [rt (in cell 1)]
(if (nil? rt) (set go false) (set cur (make-lazy-seq rt))))))))
items)
val))))
(defn- d-get
"Look up key k in a map-like value (phm/struct/table/nil)."
[m k]
@ -482,14 +550,24 @@
(while (< di n)
(let [elem (in pat di)]
(cond
# & rest
(and (struct? elem) (= :symbol (elem :jolt/type)) (= "&" (elem :name)))
(do
# rest binds a seq (jolt list = array), per Clojure semantics
(destructure-bind ctx bindings (in pat (+ di 1))
(if (and seqable? (< vi (length rv)))
(array/slice (if (tuple? rv) (array/slice rv) rv) vi)
@[]))
# & rest
(and (struct? elem) (= :symbol (elem :jolt/type)) (= "&" (elem :name)))
(do
# rest binds a seq (jolt list = array), per Clojure semantics.
# For lazy-seqs, preserve laziness: walk vi steps via ls-rest
# instead of slicing the eagerly-realized array.
(destructure-bind ctx bindings (in pat (+ di 1))
(if (lazy-seq? val)
(do
(var c val) (var i 0)
(while (< i vi)
(let [nxt (ls-rest c)]
(if (nil? nxt) (break)
(do (set c nxt) (++ i)))))
c)
(if (and seqable? (< vi (length rv)))
(array/slice (if (tuple? rv) (array/slice rv) rv) vi)
@[])))
(set di (+ di 2)))
# :as whole
(= elem :as)
@ -611,12 +689,20 @@
(defn- eval-list
[ctx bindings form]
(def first-form (first form))
# Safe name extraction: non-symbol heads (e.g. keywords) fall through to default
# Safe name extraction: non-symbol heads (e.g. keywords) fall through to default.
# A head qualified to a NON-core namespace (e.g. clojure.edn/read-string) must
# resolve to that var, not the like-named clojure.core special form — so only
# unqualified or clojure.core-qualified heads dispatch as special forms.
(def name (if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
(first-form :name)
(let [ns (first-form :ns)]
(if (or (nil? ns) (= ns "clojure.core")) (first-form :name) nil))
nil))
(match name
"quote" (in form 1)
# Interpreter builds the form directly (self-contained, no core dependency).
# The COMPILE path instead lowers syntax-quote to construction code (via
# syntax-quote-lower) so a backtick body is compilable; the two are kept in
# sync and cross-checked by conformance (interpret vs compile modes).
"syntax-quote" (syntax-quote* ctx bindings (in form 1))
"unquote" (error "Unquote not valid outside of syntax-quote")
"unquote-splicing" (error "Unquote-splicing not valid outside of syntax-quote")
@ -686,7 +772,7 @@
fixed-pats (param-info :fixed)
rest-pat (param-info :rest)
defining-ns (ctx-current-ns ctx)]
(def macro-fn (fn [& macro-args]
(def interp-fn (fn [& macro-args]
(var new-bindings @{})
(table/setproto new-bindings bindings)
(put new-bindings "&env" @{}) # implicit &env for macro bodies (table — nil-safe)
@ -706,10 +792,20 @@
(set result (eval-form ctx new-bindings bf)))
(ctx-set-current-ns ctx saved-ns)
result))
# Prefer a COMPILED expander (native-speed expansion, zero runtime
# cost). Skip when the body uses &env/&form (the compiled fn has no
# such params) — those fall back to the interpreted closure.
(def uses-env (or (form-uses-sym? body "&env") (form-uses-sym? body "&form")))
(def compiled-fn
(when (and macro-compile-hook (not uses-env))
(macro-compile-hook ctx args-form body)))
(def macro-fn (or compiled-fn interp-fn))
(let [ns-name (ctx-current-ns ctx)
ns (ctx-find-ns ctx ns-name)]
(def v (ns-intern ns (name-sym :name) macro-fn))
(put v :macro true)
# A (re)defined macro invalidates any cached expansions.
(table/clear macro-cache)
(var-get v)))
"ns" (let [raw-name (in form 1)
name-sym (unwrap-meta-name raw-name)
@ -810,15 +906,20 @@
arities @{}
defining-ns (ctx-current-ns ctx)]
(var self nil)
# The (single) variadic clause is dispatched separately: it handles
# any arg count >= its fixed count. Storing it in `arities` by
# fixed-count would collide with a same-fixed-count fixed clause and
# only match that exact count.
(var variadic-fn nil)
(var variadic-min 0)
(each pair pairs
(let [args-form (in pair 0)
body (tuple/slice pair 1)
param-info (parse-params args-form)
fixed-pats (param-info :fixed)
rest-pat (param-info :rest)
n-fixed (length fixed-pats)]
(put arities n-fixed
(fn [& fn-args]
n-fixed (length fixed-pats)
f (fn [& fn-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
@ -836,12 +937,16 @@
(each body-form body
(set result (eval-form ctx fn-bindings body-form)))
(ctx-set-current-ns ctx saved-ns)
result))))
result)]
(if rest-pat
(do (set variadic-fn f) (set variadic-min n-fixed))
(put arities n-fixed f))))
(set self (fn [& fn-args]
(let [n (length fn-args)
f (get arities n)]
(if f
(apply f fn-args)
(cond
f (apply f fn-args)
(and variadic-fn (>= n variadic-min)) (apply variadic-fn fn-args)
(error (string "Wrong number of args (" n ") passed to fn"))))))
self)
# Single-arity: (fn* [args] body...)
@ -920,7 +1025,14 @@
(error {:jolt/type :jolt/exception :value val}))
"try" (let [body-form (in form 1)
clauses (tuple/slice form 2)
n (length clauses)]
n (length clauses)
# current-ns is dynamic state. The interpreter rebinds it to a
# fn's defining ns while that fn runs and restores it on normal
# return, but a fn that THROWS unwinds past its own restore — so
# the ns can leak. try is the unwind boundary: restore the ns that
# was current at try entry before running catch/finally, so caught
# code (and the harness's is/thrown?) sees the right namespace.
try-ns (ctx-current-ns ctx)]
(var catch-sym nil)
(var catch-body nil)
(var finally-body nil)
@ -943,6 +1055,7 @@
(try
(eval-form ctx bindings body-form)
([err]
(ctx-set-current-ns ctx try-ns)
(var new-bindings @{})
(table/setproto new-bindings bindings)
# bind the originally-thrown value (unwrap the :jolt/exception
@ -965,6 +1078,7 @@
(run-finally finally-body)
result)
([err]
(ctx-set-current-ns ctx try-ns)
(run-finally finally-body)
(error err)))
(eval-form ctx bindings body-form))))
@ -1051,12 +1165,30 @@
(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))))
# host value: try candidate host type-tags (Long/String/Object/...)
(let [cands (value-host-tags obj)]
(var found nil)
(each tag cands
(when (nil? found)
(set found (find-protocol-method ctx tag proto-name method-name))))
# host value: try candidate host type-tags (Long/String/Object/...).
# Generation-guarded inline cache: the candidate
# walk (array alloc + up to ~15 registry lookups) is
# the same for every value of a given host class, so
# cache (most-specific-tag, proto, method) -> fn,
# invalidated when the registry generation bumps.
(let [env (ctx :env)
reg-gen (or (get env :type-registry-gen) 0)
pc (let [c (get env :proto-dispatch-cache)]
(if (and c (= (c :gen) reg-gen)) c
(let [n @{:gen reg-gen :map @{}}]
(put env :proto-dispatch-cache n) n)))
cands (value-host-tags obj)
ckey [(first cands) proto-name method-name]
cached (get (pc :map) ckey)
found (if (nil? cached)
(let [f (do (var r nil)
(each tag cands
(when (nil? r)
(set r (find-protocol-method ctx tag proto-name method-name))))
r)]
(put (pc :map) ckey (if f f :jolt/none))
f)
(if (= cached :jolt/none) nil cached))]
(if found (apply found obj rest-args)
(error (string "No dispatch for " method-name " on " (type obj))))))))
"register-method" (let [type-sym (in form 1)
@ -1149,27 +1281,38 @@
(+= i 2))) h)
ns (ctx-find-ns ctx (ctx-current-ns ctx))
methods @{}
# Cache for hierarchy-resolved dispatch values: the isa? walk
# over every method key is the expensive path (derive-based
# dispatch). Direct (get methods dv) hits stay uncached (already
# fast). Cleared in place when methods/prefs change (defmethod,
# prefer-method, remove-method, …) so a redef can't be hidden.
dispatch-cache @{}
mm-fn (fn [& args]
(let [dv (apply dispatch-fn args)
method (get methods dv)]
(if method
(apply method args)
# hierarchy-based match (explicit :hierarchy or
# the global hierarchy from derive)
(let [h (or hierarchy the-global-hierarchy)
found (do (var f nil) (var i 0)
(let [ks (keys methods)]
(while (and (nil? f) (< i (length ks)))
(if (isa? h dv (in ks i)) (set f (get methods (in ks i))))
(++ i))) f)]
(if found (apply found args)
# fall back to the method registered under the default key
(let [dm (get methods default-key)]
(if dm (apply dm args)
(error (string "No method in multimethod "
(name-sym :name) " for dispatch value: " dv)))))))))]
(let [cached (get dispatch-cache dv)]
(if cached
(apply cached args)
# hierarchy-based match (explicit :hierarchy or
# the global hierarchy from derive)
(let [h (or hierarchy the-global-hierarchy)
found (do (var f nil) (var i 0)
(let [ks (keys methods)]
(while (and (nil? f) (< i (length ks)))
(if (isa? h dv (in ks i)) (set f (get methods (in ks i))))
(++ i))) f)]
(if found
(do (put dispatch-cache dv found) (apply found args))
# fall back to the method registered under the default key
(let [dm (get methods default-key)]
(if dm (apply dm args)
(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)
(put v :jolt/dispatch-cache dispatch-cache)
(put v :jolt/default default-key)
(when hierarchy (put v :jolt/hierarchy hierarchy))
(var-get v))
@ -1194,6 +1337,8 @@
methods (or (get mm-var :jolt/methods)
(let [m @{}] (put mm-var :jolt/methods m) m))]
(put methods dispatch-val impl)
(let [dc (get mm-var :jolt/dispatch-cache)]
(when dc (each k (keys dc) (put dc k nil))))
mm-var)
"prefer-method" (let [mm-arg (in form 1)
mm-var (if (and (struct? mm-arg) (= :symbol (mm-arg :jolt/type)))
@ -1211,6 +1356,8 @@
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)
(let [dc (get mm-var :jolt/dispatch-cache)]
(when dc (each k (keys dc) (put dc k nil))))
mm-var)
# A multimethod's methods live on its VAR, but the value is the dispatch fn;
# so resolve the var from the symbol rather than evaluating it.
@ -1234,11 +1381,15 @@
dispatch-val (eval-form ctx bindings (in form 2))]
(when mm-var
(let [methods (get mm-var :jolt/methods)]
(when methods (put methods dispatch-val nil))))
(when methods (put methods dispatch-val nil)))
(let [dc (get mm-var :jolt/dispatch-cache)]
(when dc (each k (keys dc) (put dc k nil)))))
mm-var)
"remove-all-methods" (let [mm-var (eval-form ctx bindings (in form 1))]
(if mm-var
(put mm-var :jolt/methods @{}))
(when mm-var
(put mm-var :jolt/methods @{})
(let [dc (get mm-var :jolt/dispatch-cache)]
(when dc (each k (keys dc) (put dc k nil)))))
mm-var)
"deftype" (let [raw-name (in form 1)
type-name (unwrap-meta-name raw-name)
@ -1363,9 +1514,14 @@
(apply ctor args))
(let [v (resolve-var ctx bindings first-form)]
(if (and v (var-macro? v))
(let [macro-fn (var-get v)
args (tuple/slice form 1)]
(eval-form ctx bindings (apply macro-fn args)))
# Expand once (cached by call-form identity), then evaluate the
# macro-free expansion with the current bindings each call.
(let [cached (in macro-cache form)]
(if (not (nil? cached))
(eval-form ctx bindings cached)
(let [expanded (apply (var-get v) (tuple/slice form 1))]
(put macro-cache form expanded)
(eval-form ctx bindings expanded))))
(let [f (eval-form ctx bindings first-form)
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
(jolt-invoke ctx f args)))))))
@ -1373,6 +1529,24 @@
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
(jolt-invoke ctx f args)))))
# Build a map value from an array of evaluated [k v k v ...]. A phm (not a Janet
# struct) is used when a key is a collection (value-based hashing) OR a key/value
# is nil (Janet structs drop nil; phm preserves it, matching Clojure). The common
# scalar/nil-free case stays a struct.
(defn- map-needs-phm? [kvs]
(var need false) (var i 0)
(while (< i (length kvs))
(let [k (in kvs i) v (in kvs (+ i 1))]
(when (or (table? k) (array? k) (nil? k) (nil? v)) (set need true) (break)))
(+= i 2))
need)
(defn- build-eval-map [kvs]
(if (map-needs-phm? kvs)
(do (var m (make-phm)) (var j 0)
(while (< j (length kvs)) (set m (phm-assoc m (in kvs j) (in kvs (+ j 1)))) (+= j 2)) m)
(struct ;kvs)))
(set eval-form (fn [ctx bindings form]
(cond
(nil? form) nil
@ -1408,19 +1582,15 @@
(each k (keys form)
(array/push kvs (eval-form ctx bindings k))
(array/push kvs (eval-form ctx bindings (get form k))))
# If any key is a collection (a Janet table/array — phm/pvec/plist/
# record/list), a Janet struct would key it by identity; use a phm so
# such keys compare by value.
(var coll-key false)
(var ki 0)
(while (< ki (length kvs))
(let [kk (in kvs ki)] (when (or (table? kk) (array? kk)) (set coll-key true)))
(+= ki 2))
(if coll-key
(do (var m (make-phm)) (var j 0)
(while (< j (length kvs)) (set m (phm-assoc m (in kvs j) (in kvs (+ j 1)))) (+= j 2))
m)
(struct ;kvs))))))))
(build-eval-map kvs)))))))
# A phm map-literal FORM (reader emits one for {:a nil} etc., which a struct
# would have dropped): evaluate its key/value forms and rebuild, preserving nil.
(phm? form)
(let [kvs @[]]
(each e (phm-entries form)
(array/push kvs (eval-form ctx bindings (in e 0)))
(array/push kvs (eval-form ctx bindings (in e 1))))
(build-eval-map kvs))
(array? form)
(if (= 0 (length form))
@[]

173
src/jolt/host_iface.janet Normal file
View file

@ -0,0 +1,173 @@
# Janet implementation of the Jolt host contract (ns `jolt.host`).
#
# This is the seam between the portable jolt-core (analyzer/IR/core, pure Clojure
# under jolt-core/) and the Janet runtime. jolt-core calls ONLY these functions —
# never Janet directly. Re-hosting Jolt to another runtime means reimplementing
# this contract (+ the back end and RT) for that runtime.
#
# Lives in src/jolt/ (with the rest of the Janet host) rather than a separate
# host/janet/ dir: Janet resolves relative imports per-file, so a host/janet
# module importing ../../src/jolt/* loads SECOND instances of compiler/types/core
# (inconsistent state). The portability boundary is the `jolt.host` namespace
# contract + jolt-core/, not the directory.
#
# Two groups:
# 1. Form introspection — reader forms are host-specific (the reader is the
# host's), so shape predicates/accessors live here. Returns jolt values the
# analyzer walks with ordinary Clojure.
# 2. Compile-time environment — resolve symbols to vars/macros, expand macros,
# the current namespace. These take ctx (an opaque host handle).
(use ./types)
(use ./evaluator)
(use ./core)
(import ./phm :as phm)
# ---------------------------------------------------------------------------
# Form introspection
# ---------------------------------------------------------------------------
(defn h-sym? [form] (and (struct? form) (= :symbol (form :jolt/type))))
(defn h-sym-name [form] (form :name))
(defn h-sym-ns [form] (form :ns))
# Reader metadata on a symbol (e.g. ^:dynamic / ^:redef / ^:private on a def
# name). Returns the meta map or nil. Lets the analyzer carry def metadata that
# the back end applies to the var — without it, compiled defs drop all var meta.
(defn h-sym-meta [form] (form :meta))
(defn h-list? [form] (array? form)) # a call / list (reader: array)
(defn h-vector? [form] (tuple? form)) # a vector literal (reader: tuple)
# A map-literal form is a plain struct, or a phm when the reader preserved a nil
# key/value (Janet structs drop nil). Sets/chars/symbols are tagged structs (have
# :jolt/type); phm carries :jolt/deftype, distinct from those.
(defn h-map? [form]
(or (and (struct? form) (nil? (form :jolt/type)))
(phm/phm? form)))
(defn h-set? [form] (and (struct? form) (= :jolt/set (form :jolt/type))))
(defn h-char? [form] (and (struct? form) (= :jolt/char (form :jolt/type))))
(defn h-literal? [form]
(or (nil? form) (boolean? form) (number? form) (string? form)
(keyword? form) (h-char? form)))
# Items of a list/vector as a jolt vector, so the analyzer walks them with Clojure.
(defn h-elements [form] (make-vec form))
(defn h-vector-items [form] (make-vec form))
(defn h-map-pairs [form]
(if (phm/phm? form)
(make-vec (map (fn [e] (make-vec [(in e 0) (in e 1)])) (phm/phm-entries form)))
(make-vec (map (fn [k] (make-vec [k (get form k)])) (keys form)))))
(defn h-set-items [form] (make-vec (form :value)))
# ---------------------------------------------------------------------------
# Compile-time environment
# ---------------------------------------------------------------------------
# Names the analyzer must NOT treat as a function call: interpreter special forms
# plus definitional/host macros the compiler doesn't lower. The analyzer handles
# a subset (quote/if/do/def/fn*/let*/loop*/recur/throw/try) and falls back to the
# interpreter for the rest. Kept in sync with evaluator/special-symbol? and
# compiler/uncompilable-heads.
(def- special-names
(let [t @{}]
(each n ["quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def"
"defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!" "var"
"locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new"
"." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern"
"alter-meta!" "reset-meta!" "disj" "set?" "satisfies?"
"protocol-dispatch" "register-method" "make-reified" "prefer-method"
"remove-method" "remove-all-methods" "get-method" "methods"
# ns-management forms dispatched by the interpreter (not core vars)
"create-ns" "remove-ns" "find-ns" "all-ns" "the-ns" "resolve"
"ns-resolve" "ns-aliases" "ns-imports" "ns-interns"
"read-string" "macroexpand-1" "defonce" "ns" "in-ns" "require"
"import" "use" "refer" "defrecord" "defprotocol" "definterface"
"reify" "proxy" "extend-type" "extend-protocol" "extend" "gen-class"
"monitor-enter" "monitor-exit" "binding" "letfn"]
(put t n true))
t))
# Interop-shaped heads the interpreter lowers but the back end doesn't model:
# (.method obj …) / (.-field obj) — member access (name starts with ".")
# (Foo. …) — constructor (name ends with "." )
# Treated as special so the analyzer marks them uncompilable and falls back.
(defn- interop-head? [name]
(def n (length name))
(and (> n 1)
(or (= (string/slice name 0 1) ".")
(= (string/slice name (- n 1)) "."))))
(defn h-special? [name]
(if (or (get special-names name) (interop-head? name)) true false))
# The namespace being compiled. NOT ctx-current-ns directly: the interpreter
# rebinds current-ns to a fn's defining ns while that fn runs, so an interpreted
# analyzer (defined in jolt.analyzer) would otherwise see jolt.analyzer. The back
# end stashes the real compile ns in :compile-ns before invoking the analyzer.
(defn h-current-ns [ctx] (or (get (ctx :env) :compile-ns) (ctx-current-ns ctx)))
(defn h-macro? [ctx sym]
(let [v (resolve-var ctx @{} sym)]
(if (and v (var-macro? v)) true false)))
(defn h-expand-1 [ctx form]
(let [head (in form 0)
v (resolve-var ctx @{} head)
macro-fn (var-get v)]
(apply macro-fn (tuple/slice form 1))))
# Classify a global (non-local) symbol reference:
# {:kind :var :ns NS :name NAME} — a Jolt var (current ns / clojure.core)
# {:kind :host :name NAME} — resolves only via the host env (+, int?, …),
# same fallback the interpreter's resolve-sym uses
# {:kind :unresolved :name NAME} — not yet defined (forward reference)
(defn h-resolve-global [ctx sym]
(let [v (resolve-var ctx @{} sym)]
(if v
{:kind :var :ns (var-ns v) :name (var-name v)}
(let [nm (sym :name)
entry (in (fiber/getenv (fiber/current)) (symbol nm))]
(if (not (nil? entry))
{:kind :host :name nm}
{:kind :unresolved :name nm})))))
(defn h-intern! [ctx ns-name nm]
(ns-intern (ctx-find-ns ctx ns-name) nm)
nil)
# ---------------------------------------------------------------------------
# Installation: bind these fns as vars in the `jolt.host` namespace so jolt-core
# can call them. Idempotent per context.
# ---------------------------------------------------------------------------
# Form predicates use `form-*` names (not list?/vector?/map?/set?/char?) so the
# analyzer can refer them unqualified without the bootstrap's core-renames
# intercepting them as the value-level predicates.
# Lower a syntax-quote's inner form to construction code (so the analyzer can
# compile it). The portable analyzer calls this and analyzes the result.
(defn h-syntax-quote-lower [ctx inner]
(syntax-quote-lower ctx inner))
# Runtime host primitive: set a key on a mutable reference cell (an atom, the
# watches sub-table, ...). The minimal mutation kernel the overlay can't express
# over core fns — putting nil removes the key (Janet table semantics). Returns the
# table so callers can thread; overlay wrappers return the Clojure-meaningful value.
(defn h-ref-put! [tab key val] (put tab key val) tab)
(def- exports
{"form-sym?" h-sym? "form-sym-name" h-sym-name "form-sym-ns" h-sym-ns
"ref-put!" h-ref-put!
"form-sym-meta" h-sym-meta
"form-list?" h-list? "form-vec?" h-vector? "form-map?" h-map?
"form-set?" h-set? "form-char?" h-char? "form-literal?" h-literal?
"form-elements" h-elements "form-vec-items" h-vector-items
"form-map-pairs" h-map-pairs "form-set-items" h-set-items
"form-special?" h-special? "compile-ns" h-current-ns "form-macro?" h-macro?
"form-expand-1" h-expand-1 "resolve-global" h-resolve-global
"form-syntax-quote-lower" h-syntax-quote-lower
"host-intern!" h-intern!})
(defn install! [ctx]
(def ns (ctx-find-ns ctx "jolt.host"))
(eachp [nm f] exports (ns-intern ns nm f))
ns)

View file

@ -3,77 +3,76 @@
# Supports in-memory bytecode caching when :compile? is enabled.
(use ./reader)
(use ./compiler)
(use ./evaluator)
(import ./backend :as backend)
# Stateful / context-modifying forms always interpret: they mutate the context
# (namespaces, macros, types, multimethods, dynamic vars, …) in ways the compiler
# doesn't model. Kept here so the compile/interpret routing lives in one place,
# used by both load-ns and the public eval-one.
(defn- stateful-head? [head-name]
(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")
(= head-name "eval")))
(defn- form-head-name [form]
(when (array? form)
(let [ff (first form)]
(when (and (struct? ff) (= :symbol (ff :jolt/type))) (ff :name)))))
(defn eval-toplevel
"Evaluate one top-level form for ctx, honoring :compile?. Stateful forms always
interpret; otherwise the form runs through the self-hosted compile pipeline
(portable Clojure analyzer -> IR -> Janet back end), which falls back to the
interpreter for forms it can't compile. Only the compile step is guarded —
runtime errors in compiled code propagate (no double-eval, no hidden errors)."
[ctx form]
(defn try-compile [] (backend/compile-and-eval ctx form))
(if (get (ctx :env) :compile?)
(if (array? form)
# A call/list: compile it unless its head is a stateful special form.
(let [hn (form-head-name form)]
(if (and hn (stateful-head? hn))
(eval-form ctx @{} form)
(try-compile)))
# A bare symbol or vector literal compiles; anything else interprets.
(if (or (and (struct? form) (= :symbol (form :jolt/type))) (tuple? form))
(try-compile)
(eval-form ctx @{} form)))
(eval-form ctx @{} form)))
(defn load-ns
"Load a Clojure namespace from a .clj file.
When ctx has :compile? enabled, forms are compiled to Janet source,
evaluated via Janet's evaluator, and cached.
"Load a Clojure namespace from a .clj file. Per-form routing (compile-or-
interpret, stateful forms interpret) is shared with eval-one via eval-toplevel.
(load-ns ctx filepath) → namespace symbol string"
[ctx filepath]
(let [env (ctx :env)
compile? (get env :compile?)
cache (get env :compiled-cache)]
(def source (slurp filepath))
(var ns-name nil)
(var remaining source)
(var forms @[])
# Parse all forms
(while (> (length (string/trim remaining)) 0)
(def [form rest] (parse-next remaining))
(set remaining rest)
(when (not (nil? form))
(array/push forms form)
# Extract ns name from the first ns form
(when (and (nil? ns-name)
(array? form)
(> (length form) 0)
(and (struct? (first form))
(= :symbol ((first form) :jolt/type))
(= "ns" ((first form) :name))))
(let [name-form (in form 1)]
(set ns-name (if (struct? name-form) (name-form :name) (string name-form)))))))
(when (nil? ns-name)
(error (string "No ns form found in " filepath)))
(if compile?
(do
# Compile each form and eval as Janet
(var cached (get cache ns-name))
(when (nil? cached)
(set cached @[])
(put cache ns-name cached))
(each form forms
(array/push cached form)
(compile-and-eval form ctx))
ns-name)
# Interpreter path
(do
(each form forms
(eval-form ctx @{} form))
ns-name))))
(def source (slurp filepath))
(var ns-name nil)
(var remaining source)
(var forms @[])
(defn compiled?
"Check if a namespace has been compiled and cached."
[ctx ns-name]
(let [cache (get (ctx :env) :compiled-cache)]
(not (nil? (get cache ns-name)))))
# Parse all forms
(while (> (length (string/trim remaining)) 0)
(def [form rest] (parse-next remaining))
(set remaining rest)
(when (not (nil? form))
(array/push forms form)
# Extract ns name from the first ns form
(when (and (nil? ns-name)
(array? form)
(> (length form) 0)
(and (struct? (first form))
(= :symbol ((first form) :jolt/type))
(= "ns" ((first form) :name))))
(let [name-form (in form 1)]
(set ns-name (if (struct? name-form) (name-form :name) (string name-form)))))))
(defn get-compiled-forms
"Get the compiled Janet source forms for a namespace."
[ctx ns-name]
(get (ctx :env) :compiled-cache ns-name))
(when (nil? ns-name)
(error (string "No ns form found in " filepath)))
(defn clear-compiled-cache
"Clear the compiled form cache for a namespace or all namespaces."
[ctx &opt ns-name]
(let [cache (get (ctx :env) :compiled-cache)]
(if ns-name
(put cache ns-name nil)
(loop [[k] :pairs cache] (put cache k nil)))))
(each form forms (eval-toplevel ctx form))
ns-name)

View file

@ -11,7 +11,13 @@
(def jolt-version "0.1.0")
(def ctx (init))
# Compile by default: the shipped runtime runs each form through the self-hosted
# pipeline (portable Clojure analyzer -> IR -> Janet back end) to native bytecode
# (hybrid — forms the analyzer can't compile fall back to the interpreter, so the
# result always matches the interpreter; see backend.janet / loader/eval-toplevel).
# Set JOLT_INTERPRET=1 to force the tree-walking interpreter (debugging / A-B).
(def compile-default? (not (= "1" (os/getenv "JOLT_INTERPRET"))))
(def ctx (init {:compile? compile-default?}))
(ctx-set-current-ns ctx "user")
(defn read-line [prompt]

View file

@ -72,7 +72,11 @@
(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)))
# presence-check, not nil-of-value: a key mapped to nil is still present,
# so return nil (not the default) when the key exists with a nil value.
(if (and bucket (phm-bucket-contains? bucket k))
(phm-bucket-find bucket k)
default)))
(defn phm-assoc [m k v]
(let [cnt (m :cnt) idx (phm-hash-key k)
@ -197,6 +201,16 @@
(set cur (if (nil? rt) nil (make-lazy-seq rt))))))
cnt)
# ============================================================
# Lazy combinator — primitive for building lazy sequences
# ============================================================
(defn lazy-cons
"Returns a LazySeq whose first element is x and whose rest is produced
by rest-thunk (a 0-arg function returning nil or a LazySeq)."
[x rest-thunk]
(make-lazy-seq (fn [] @[x rest-thunk])))
# ============================================================
# PersistentHashSet — backed by PersistentHashMap
# ============================================================

View file

@ -9,6 +9,7 @@
# Sets #{1 2} → tagged struct {:jolt/type :jolt/set :value [1 2]}
(use ./types)
(import ./phm :as phm)
# Forward declaration for mutual recursion
(var read-form nil)
@ -266,6 +267,16 @@
(read-vec-items s new-pos (array/push items form))))))))
(read-vec-items s (+ pos 1) @[]))
# A map-literal form. Janet structs drop nil keys/values, so when a key or value
# is nil (e.g. {:a nil}) build a phm — it preserves nil, matching Clojure. The
# common nil-free case stays a struct: fast, and what the downstream map-form
# handling (evaluator/analyzer) already expects. Collection keys are left to
# eval-time construction (build-map-literal/eval-form), which phm-ifies them.
(defn- reader-map [kvs]
(var has-nil false) (var i 0)
(while (< i (length kvs)) (when (nil? (in kvs i)) (set has-nil true) (break)) (++ i))
(if has-nil (phm/make-phm kvs) (struct ;kvs)))
(defn read-map [s pos]
# pos is at opening brace
(defn read-kvs [s pos kvs]
@ -273,7 +284,7 @@
(if (>= pos (length s))
(error "Unterminated map"))
(if (= (s pos) 125) # }
[(struct ;kvs) (+ pos 1)]
[(reader-map kvs) (+ pos 1)]
(let [[key new-pos] (read-form s pos)]
(if (and (struct? key) (= :jolt/skip (key :jolt/type)))
(read-kvs s new-pos kvs)

View file

@ -30,4 +30,6 @@
(let [acc @{}]
(collect "src/jolt/clojure" "clojure/" acc)
(collect "src/jolt/jolt" "jolt/" acc)
# Portable Clojure core (analyzer/IR/…): jolt-core/jolt/foo.clj -> jolt.foo
(collect "jolt-core" "" acc)
acc))

View file

@ -86,6 +86,10 @@
:name name
:root init-val
:meta m
# Generation: bumped on every root change (redefinition). Call
# sites / dispatch caches keyed on this can detect a redef and
# invalidate; direct-linked (sealed) sites can detect staleness.
:gen 0
:dynamic (if meta (get meta :dynamic) false)
:macro (if meta (get meta :macro) false)
:ns (if meta (get meta :ns) nil)}]
@ -125,19 +129,25 @@
"Deref the var. If the var is dynamic and has a thread-local binding, return that.
Otherwise return the root binding."
[v]
# walk binding stack top-down for this var
# Fast path: no dynamic bindings are active (the common case — the stack is
# only non-empty inside a `binding` block), so the value is just the root. This
# is the hot path for every global deref; skip building the walk otherwise.
(def bs (cur-binding-stack))
(var result nil)
(var i (dec (length bs)))
(while (>= i 0)
(let [frame (in bs i)
val (get frame v)]
(if (not (nil? val))
(do
(set result (if (var? val) (var-get val) val))
(set i -1))
(-- i))))
(if (not (nil? result)) result (v :root)))
(if (= 0 (length bs))
(v :root)
# walk binding stack top-down for this var
(do
(var result nil)
(var i (dec (length bs)))
(while (>= i 0)
(let [frame (in bs i)
val (get frame v)]
(if (not (nil? val))
(do
(set result (if (var? val) (var-get val) val))
(set i -1))
(-- i))))
(if (not (nil? result)) result (v :root)))))
(defn var-set
"Set a var's value. If the var has a thread-local binding on the stack, update
@ -152,14 +162,16 @@
(if (not (nil? (get frame v)))
(do (put bs i (merge frame {v val})) (set done true))
(-- i))))
(unless done (put v :root val))
(unless done (do (put v :root val) (put v :gen (+ 1 (or (v :gen) 0)))))
val)
(defn alter-var-root
"Atomically alter the root binding of v by applying f to current value plus args."
[v f & args]
(let [new-val (f (v :root) ;args)]
(put v :root new-val)))
(put v :root new-val)
(put v :gen (+ 1 (or (v :gen) 0)))
new-val))
(defn alter-meta!
"Atomically update a var's metadata via (apply f args)."
@ -244,14 +256,18 @@
:name (v :name)
:root (v :root)
:meta new-meta
:gen (or (v :gen) 0)
:dynamic (v :dynamic)
:macro (v :macro)
:ns (v :ns)}))
(defn bind-root
"Set the root binding (internal, same as var-set)."
"Set the root binding and bump the var's generation (the redefinition
chokepoint: def, ns-intern-with-val, and the root-set paths all route here)."
[v val]
(put v :root val))
(put v :root val)
(put v :gen (+ 1 (or (v :gen) 0)))
val)
# ============================================================
# Namespace
@ -297,7 +313,10 @@
(when (not (nil? val))
(bind-root existing val))
existing)
(let [v (make-var sym val {:ns ns :name sym})]
# Store the namespace *name*, not the ns table: a back-pointer to the ns
# would make the var cyclic (ns -> mappings -> var -> ns), and the compiler
# embeds var cells as constants, which can't be cyclic.
(let [v (make-var sym val {:ns (get ns :name) :name sym})]
(put mappings sym v)
v))))
@ -362,14 +381,23 @@
[&opt opts]
(default opts nil)
(let [compile? (if opts (get opts :compile?) false)
# Direct-linking (call-site/unit property, like Clojure). :aot-core?
# (default true; JOLT_AOT_CORE=0 disables) compiles the core tiers +
# compiler with direct-linking on. :direct-linking? is the per-unit flag
# the back end reads while emitting; it defaults to the user-code setting
# (off unless opted in) and load-core-overlay! flips it on around core.
aot-core? (let [o (if opts (get opts :aot-core?) nil)]
(if (nil? o) (not (= "0" (os/getenv "JOLT_AOT_CORE"))) o))
env @{:namespaces @{}
:class->opts @{}
:current-ns "user"
:compile? compile?
:aot-core? aot-core?
:direct-linking? (if opts (get opts :direct-linking?) nil)
# Ordered roots searched (after the stdlib) to resolve a namespace
# to a .clj/.cljc file. deps.edn resolution appends dep src dirs.
:source-paths @["src/jolt"]
:compiled-cache @{}
# to a .clj/.cljc file. jolt-core holds the portable Clojure layer
# (analyzer/IR/core); deps.edn resolution appends dep src dirs.
:source-paths @["jolt-core" "src/jolt"]
:type-registry @{}
:data-readers (let [dr @{}]
(put dr (keyword "#inst") (fn [s] s))
@ -472,12 +500,15 @@
(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)
(let [env (ctx :env)
registry (get 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)))
(put proto-impls method-name fn)
# Bump the registry generation so any dispatch cache keyed on it invalidates.
(put env :type-registry-gen (+ 1 (or (get env :type-registry-gen) 0)))))
(defn find-protocol-method
"Find a protocol method implementation for a type."

View file

@ -0,0 +1,42 @@
# Performance baseline for the clojure.core migration (jolt-1j0).
#
# Times representative core operations end-to-end (compile path) so a phase that
# moves fns from native Janet to the self-hosted Clojure overlay can be checked
# for regressions. Same programs before/after a phase -> relative delta is the
# migration's perf impact. Run: janet test/bench/core-bench.janet
#
# Each program carries its own internal iteration so the measured work dominates
# parse/compile overhead. Reports the min of N runs (least noisy).
(import ../../src/jolt/api :as api)
(def runs 5)
(def benches
[[:fib "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 28)"]
[:seq-pipe "(loop [i 0 a 0] (if (< i 300) (recur (inc i) (+ a (reduce + 0 (map inc (filter even? (range 200)))))) a))"]
[:reduce "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (reduce + 0 (range 500)))) a))"]
[:into-vec "(loop [i 0 a 0] (if (< i 1000) (recur (inc i) (+ a (count (into [] (map inc (range 100)))))) a))"]
[:map-build "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (count (reduce (fn [m k] (assoc m k k)) {} (range 50))))) a))"]
[:map-read "(let [m (zipmap (range 100) (range 100))] (loop [i 0 a 0] (if (< i 5000) (recur (inc i) (+ a (get m (mod i 100) 0))) a)))"]
[:str-join "(loop [i 0 a 0] (if (< i 1000) (recur (inc i) (+ a (count (apply str (map str (range 100)))))) a))"]
[:hof "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (reduce + 0 (map (comp inc inc) (range 200))))) a))"]])
(defn time-bench [ctx src]
(var best math/inf)
(for _ 0 runs
(def t0 (os/clock))
(api/load-string ctx src)
(def dt (* 1000 (- (os/clock) t0)))
(when (< dt best) (set best dt)))
best)
(defn main [&]
(def ctx (api/init {:compile? true}))
(print "bench (compile mode), min of " runs " runs, ms:")
(var total 0)
(each [name src] benches
(def ms (time-bench ctx src))
(+= total ms)
(printf " %-10s %8.2f ms" name ms))
(printf " %-10s %8.2f ms" "TOTAL" total))

View file

@ -0,0 +1,149 @@
(ns clojure.data-test.diff
(:require [clojure.test :refer [deftest is testing]]
;; NOTE (jolt): sequential-diff expectations corrected to match real Clojure —
;; clojure.data pads only to the max differing index (e.g. (diff [1 2 3] [1 9 3])
;; -> a=[nil 2], not [nil 2 nil]). The upstream clojurust fixtures had this wrong.
[clojure.data :refer [diff]]))
;; ── Atoms ────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-atoms
(testing "equal atoms"
(is (= [nil nil :a] (diff :a :a)))
(is (= [nil nil 1] (diff 1 1)))
(is (= [nil nil "hello"] (diff "hello" "hello")))
(is (= [nil nil nil] (diff nil nil)))
(is (= [nil nil true] (diff true true)))))
(deftest test-diff-unequal-atoms
(testing "unequal atoms"
(is (= [:a :b nil] (diff :a :b)))
(is (= [1 2 nil] (diff 1 2)))
(is (= ["a" "b" nil] (diff "a" "b")))
(is (= [nil 1 nil] (diff nil 1)))
(is (= [true false nil] (diff true false)))))
;; ── Maps ─────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-maps
(testing "equal maps"
(is (= [nil nil {:a 1 :b 2}] (diff {:a 1 :b 2} {:a 1 :b 2})))
(is (= [nil nil {}] (diff {} {})))))
(deftest test-diff-maps-only-in-a
(testing "keys only in a"
(let [[a b both] (diff {:a 1 :b 2} {:a 1})]
(is (= {:b 2} a))
(is (nil? b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-only-in-b
(testing "keys only in b"
(let [[a b both] (diff {:a 1} {:a 1 :b 2})]
(is (nil? a))
(is (= {:b 2} b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-different-values
(testing "same keys, different values"
(let [[a b both] (diff {:a 1 :b 2} {:a 1 :b 9})]
(is (= {:b 2} a))
(is (= {:b 9} b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-nested
(testing "nested maps"
(let [[a b both] (diff {:a {:x 1 :y 2}} {:a {:x 1 :z 3}})]
(is (= {:a {:y 2}} a))
(is (= {:a {:z 3}} b))
(is (= {:a {:x 1}} both)))))
(deftest test-diff-maps-disjoint
(testing "completely disjoint maps"
(let [[a b both] (diff {:a 1} {:b 2})]
(is (= {:a 1} a))
(is (= {:b 2} b))
(is (nil? both)))))
;; ── Sets ─────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-sets
(testing "equal sets"
(is (= [nil nil #{1 2 3}] (diff #{1 2 3} #{1 2 3})))
(is (= [nil nil #{}] (diff #{} #{})))))
(deftest test-diff-sets
(testing "overlapping sets"
(let [[a b both] (diff #{1 2 3} #{2 3 4})]
(is (= #{1} a))
(is (= #{4} b))
(is (= #{2 3} both)))))
(deftest test-diff-disjoint-sets
(testing "disjoint sets"
(let [[a b both] (diff #{1 2} #{3 4})]
(is (= #{1 2} a))
(is (= #{3 4} b))
(is (nil? both)))))
;; ── Vectors / Sequential ────────────────────────────────────────────────────
(deftest test-diff-equal-vectors
(testing "equal vectors"
(is (= [nil nil [1 2 3]] (diff [1 2 3] [1 2 3])))
(is (= [nil nil []] (diff [] [])))))
(deftest test-diff-vectors-same-length
(testing "same length, different elements"
(let [[a b both] (diff [1 2 3] [1 9 3])]
(is (= [nil 2] a))
(is (= [nil 9] b))
(is (= [1 nil 3] both)))))
(deftest test-diff-vectors-different-length
(testing "different lengths"
(let [[a b both] (diff [1 2 3] [1 2])]
(is (= [nil nil 3] a))
(is (nil? b))
(is (= [1 2] both)))
(let [[a b both] (diff [1] [1 2 3])]
(is (nil? a))
(is (= [nil 2 3] b))
(is (= [1] both)))))
(deftest test-diff-lists
(testing "lists treated as sequential"
(let [[a b both] (diff '(1 2 3) '(1 9 3))]
(is (= [nil 2] a))
(is (= [nil 9] b))
(is (= [1 nil 3] both)))))
;; ── Mixed types ─────────────────────────────────────────────────────────────
(deftest test-diff-mixed-types
(testing "different partition types treated as atoms"
(is (= [{:a 1} [1 2] nil] (diff {:a 1} [1 2])))
(is (= [#{1} [1] nil] (diff #{1} [1])))
(is (= [1 :a nil] (diff 1 :a)))))
;; ── Nil handling ────────────────────────────────────────────────────────────
(deftest test-diff-nil
(testing "nil vs non-nil"
(is (= [nil 1 nil] (diff nil 1)))
(is (= [1 nil nil] (diff 1 nil)))
(is (= [nil {:a 1} nil] (diff nil {:a 1})))))
;; ── Deeply nested ───────────────────────────────────────────────────────────
(deftest test-diff-deeply-nested
(testing "deeply nested structures"
(let [[a b both] (diff {:a {:b {:c 1}}} {:a {:b {:c 2}}})]
(is (= {:a {:b {:c 1}}} a))
(is (= {:a {:b {:c 2}}} b))
(is (nil? both))))
(testing "deeply nested with shared keys"
(let [[a b both] (diff {:a {:b 1 :c 2}} {:a {:b 1 :c 9}})]
(is (= {:a {:c 2}} a))
(is (= {:a {:c 9}} b))
(is (= {:a {:b 1}} both)))))

View file

@ -0,0 +1,107 @@
(ns clojure.edn-test.read-string
(:require [clojure.edn :as edn]
[clojure.test :refer [are deftest is testing]]))
(deftest test-read-string-scalars
(testing "nil, booleans"
(is (nil? (edn/read-string "nil")))
(is (true? (edn/read-string "true")))
(is (false? (edn/read-string "false"))))
(testing "integers"
(is (= 0 (edn/read-string "0")))
(is (= 42 (edn/read-string "42")))
(is (= -1 (edn/read-string "-1")))
(is (= 1000000000000 (edn/read-string "1000000000000"))))
(testing "floats"
(is (= 3.14 (edn/read-string "3.14")))
(is (= -0.5 (edn/read-string "-0.5")))
(is (= 1.0 (edn/read-string "1.0"))))
(testing "bigints"
(is (= 42N (edn/read-string "42N"))))
(testing "bigdecimals"
(is (= 3.14M (edn/read-string "3.14M"))))
(testing "strings"
(is (= "" (edn/read-string "\"\"")))
(is (= "hello" (edn/read-string "\"hello\"")))
(is (= "line1\nline2" (edn/read-string "\"line1\\nline2\"")))
(is (= "tab\there" (edn/read-string "\"tab\\there\""))))
(testing "characters"
(is (= \a (edn/read-string "\\a")))
(is (= \newline (edn/read-string "\\newline")))
(is (= \space (edn/read-string "\\space")))
(is (= \tab (edn/read-string "\\tab"))))
(testing "keywords"
(is (= :foo (edn/read-string ":foo")))
(is (= :bar/baz (edn/read-string ":bar/baz"))))
(testing "symbols"
(is (= 'foo (edn/read-string "foo")))
(is (= 'bar/baz (edn/read-string "bar/baz")))))
(deftest test-read-string-collections
(testing "vectors"
(is (= [] (edn/read-string "[]")))
(is (= [1 2 3] (edn/read-string "[1 2 3]")))
(is (= [1 [2 3] 4] (edn/read-string "[1 [2 3] 4]"))))
(testing "lists"
(is (= '() (edn/read-string "()")))
(is (= '(1 2 3) (edn/read-string "(1 2 3)")))
(is (= '(+ 1 2) (edn/read-string "(+ 1 2)"))))
(testing "maps"
(is (= {} (edn/read-string "{}")))
(is (= {:a 1} (edn/read-string "{:a 1}")))
(is (= {:a 1 :b 2} (edn/read-string "{:a 1 :b 2}")))
(is (= {:nested {:deep true}} (edn/read-string "{:nested {:deep true}}"))))
(testing "sets"
(is (= #{} (edn/read-string "#{}")))
(is (= #{1 2 3} (edn/read-string "#{1 2 3}"))))
(testing "mixed nested"
(is (= {:users [{:name "Alice" :age 30}
{:name "Bob" :age 25}]}
(edn/read-string "{:users [{:name \"Alice\" :age 30} {:name \"Bob\" :age 25}]}")))))
(deftest test-read-string-tagged-literals
(testing "#uuid"
(let [u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"")]
(is (uuid? u))
(is (= u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\""))))))
(deftest test-read-string-eof
(testing "empty string with :eof option"
(is (= :eof (edn/read-string {:eof :eof} "")))
(is (= nil (edn/read-string {:eof nil} "")))
(is (= 42 (edn/read-string {:eof 42} ""))))
(testing "whitespace-only with :eof option"
(is (= :done (edn/read-string {:eof :done} " "))))
(testing "nil input returns nil"
(is (nil? (edn/read-string nil)))))
(deftest test-read-string-comments
(testing "comments are skipped"
(is (= 42 (edn/read-string "; this is a comment\n42"))))
(testing "discard reader macro"
(is (= 2 (edn/read-string "#_ 1 2")))))
(deftest test-read-string-only-first-form
(testing "reads only the first form"
(is (= 1 (edn/read-string "1 2 3")))
(is (= :a (edn/read-string ":a :b :c")))))
(deftest test-read-string-ratios
(testing "ratios"
(is (= 1/2 (edn/read-string "1/2")))
(is (= 3/4 (edn/read-string "3/4")))))

View file

@ -0,0 +1,101 @@
(ns clojure.walk-test.walk
(:require [clojure.test :refer [deftest is testing]]
[clojure.walk :as w]))
(deftest test-walk
(testing "walk with identity"
(is (= [1 2 3] (w/walk identity identity [1 2 3])))
(is (= '(1 2 3) (w/walk identity identity '(1 2 3))))
(is (= #{1 2 3} (w/walk identity identity #{1 2 3}))))
(testing "walk with inner transform"
(is (= [2 3 4] (w/walk inc identity [1 2 3])))
(is (= [2 3 4] (w/walk inc vec [1 2 3]))))
(testing "walk with outer transform"
(is (= [1 2 3] (w/walk identity vec '(1 2 3))))))
(deftest test-postwalk
(testing "postwalk with numbers"
(is (= [2 3 4] (w/postwalk #(if (number? %) (inc %) %) [1 2 3]))))
(testing "postwalk with nested structures"
(is (= [2 [3 4] 5]
(w/postwalk #(if (number? %) (inc %) %) [1 [2 3] 4]))))
(testing "postwalk preserves types"
(is (vector? (w/postwalk identity [1 2 3])))
(is (list? (w/postwalk identity '(1 2 3))))
(is (set? (w/postwalk identity #{1 2 3})))
(is (map? (w/postwalk identity {:a 1 :b 2}))))
(testing "postwalk on maps"
(is (= {:a 2 :b 3}
(w/postwalk #(if (number? %) (inc %) %) {:a 1 :b 2}))))
(testing "postwalk on empty collections"
(is (= [] (w/postwalk identity [])))
(is (= {} (w/postwalk identity {})))
(is (= #{} (w/postwalk identity #{})))
(is (= '() (w/postwalk identity '())))))
(deftest test-prewalk
(testing "prewalk with numbers"
(is (= [2 3 4] (w/prewalk #(if (number? %) (inc %) %) [1 2 3]))))
(testing "prewalk with nested structures"
(is (= [2 [3 4] 5]
(w/prewalk #(if (number? %) (inc %) %) [1 [2 3] 4]))))
(testing "prewalk transforms before descending"
;; prewalk applies f to the outer form first, so we can replace
;; entire subtrees before they are walked
(is (= [:replaced]
(w/prewalk #(if (= % [1 2 3]) [:replaced] %) [1 2 3])))))
(deftest test-keywordize-keys
(testing "basic keywordize"
(is (= {:a 1 :b 2} (w/keywordize-keys {"a" 1 "b" 2}))))
(testing "nested keywordize"
(is (= {:a {:b 2}} (w/keywordize-keys {"a" {"b" 2}}))))
(testing "non-string keys unchanged"
(is (= {:a 1 42 2} (w/keywordize-keys {"a" 1 42 2}))))
(testing "already keyword keys unchanged"
(is (= {:a 1} (w/keywordize-keys {:a 1})))))
(deftest test-stringify-keys
(testing "basic stringify"
(is (= {"a" 1 "b" 2} (w/stringify-keys {:a 1 :b 2}))))
(testing "nested stringify"
(is (= {"a" {"b" 2}} (w/stringify-keys {:a {:b 2}}))))
(testing "non-keyword keys unchanged"
(is (= {"a" 1 42 2} (w/stringify-keys {:a 1 42 2})))))
(deftest test-postwalk-replace
(testing "basic replacement"
(is (= [:x :y :c] (w/postwalk-replace {:a :x :b :y} [:a :b :c]))))
(testing "nested replacement"
(is (= [:x [:y :c]] (w/postwalk-replace {:a :x :b :y} [:a [:b :c]]))))
(testing "no matches"
(is (= [1 2 3] (w/postwalk-replace {:a :x} [1 2 3]))))
(testing "empty smap"
(is (= [1 2 3] (w/postwalk-replace {} [1 2 3])))))
(deftest test-prewalk-replace
(testing "basic replacement"
(is (= [:x :y :c] (w/prewalk-replace {:a :x :b :y} [:a :b :c]))))
(testing "nested replacement"
(is (= [:x [:y :c]] (w/prewalk-replace {:a :x :b :y} [:a [:b :c]]))))
(testing "replaces before descending"
;; prewalk-replace replaces the whole form first, then walks children
(is (= :replaced (w/prewalk-replace {[:a :b] :replaced} [:a :b])))))

View file

@ -0,0 +1,122 @@
(ns clojure.zip-test.zip
(:require [clojure.test :refer [deftest is testing run-tests]]
[clojure.zip :as zip]))
(deftest test-vector-zip-navigation
(let [data [[1 2] [3 [4 5]]]
z (zip/vector-zip data)]
(testing "root node"
(is (= (zip/node z) [[1 2] [3 [4 5]]]))
(is (zip/branch? z)))
(testing "down"
(is (= (zip/node (zip/down z)) [1 2])))
(testing "right"
(is (= (zip/node (zip/right (zip/down z))) [3 [4 5]])))
(testing "down into nested"
(is (= (zip/node (zip/down (zip/right (zip/down z)))) 3)))
(testing "up returns parent"
(is (= (zip/node (zip/up (zip/down z))) [[1 2] [3 [4 5]]])))
(testing "rights"
(is (= (zip/rights (zip/down z)) '([3 [4 5]]))))
(testing "lefts"
(is (= (zip/lefts (zip/right (zip/down z))) [[1 2]])))))
(deftest test-vector-zip-rightmost-leftmost
(let [z (zip/vector-zip [1 2 3])]
(testing "rightmost"
(is (= (zip/node (zip/rightmost (zip/down z))) 3)))
(testing "leftmost"
(is (= (zip/node (zip/leftmost (zip/rightmost (zip/down z)))) 1)))))
(deftest test-seq-zip-navigation
(let [z (zip/seq-zip '(1 (2 3) 4))]
(testing "root"
(is (= (zip/node z) '(1 (2 3) 4))))
(testing "down"
(is (= (zip/node (zip/down z)) 1)))
(testing "right"
(is (= (zip/node (zip/right (zip/down z))) '(2 3))))
(testing "down into nested list"
(is (= (zip/node (zip/down (zip/right (zip/down z)))) 2)))))
(deftest test-path
(let [z (zip/vector-zip [[1 2] [3 4]])]
(testing "path at root is nil"
(is (nil? (zip/path z))))
(testing "path one level down"
(is (= (zip/path (zip/down z)) [[[1 2] [3 4]]])))
(testing "path two levels down"
(is (= (zip/path (zip/down (zip/down z)))
[[[1 2] [3 4]] [1 2]])))))
(deftest test-edit
(let [z (zip/vector-zip [1 [2 3] [4 5]])]
(testing "edit a leaf"
(let [loc (-> z zip/down zip/right zip/down)
edited (zip/edit loc inc)]
(is (= (zip/root edited) [1 [3 3] [4 5]]))))
(testing "edit a branch"
(let [loc (-> z zip/down zip/right)
edited (zip/edit loc (fn [x] (vec (map inc x))))]
(is (= (zip/root edited) [1 [3 4] [4 5]]))))))
(deftest test-replace
(let [z (zip/vector-zip '[a b c])]
(is (= (zip/root (zip/replace (zip/down z) 'x))
'[x b c]))))
(deftest test-insert-left-right
(let [z (zip/vector-zip [1 2 3])
loc (-> z zip/down zip/right)]
(testing "insert-left"
(is (= (zip/root (zip/insert-left loc 'x)) [1 'x 2 3])))
(testing "insert-right"
(is (= (zip/root (zip/insert-right loc 'y)) [1 2 'y 3])))))
(deftest test-insert-child-append-child
(let [z (zip/vector-zip [1 2 3])]
(testing "insert-child"
(is (= (zip/root (zip/insert-child z 0)) [0 1 2 3])))
(testing "append-child"
(is (= (zip/root (zip/append-child z 4)) [1 2 3 4])))))
(deftest test-remove
(let [z (zip/vector-zip [1 2 3])
loc (-> z zip/down zip/right)]
(is (= (zip/root (zip/remove loc)) [1 3]))))
(deftest test-next-traversal
(let [z (zip/vector-zip [1 [2 3]])]
(testing "next enumerates depth-first"
(is (= (loop [loc z, acc []]
(if (zip/end? loc)
acc
(recur (zip/next loc) (conj acc (zip/node loc)))))
[[1 [2 3]] 1 [2 3] 2 3])))))
(deftest test-end?
(let [z (zip/vector-zip [1 2])]
(testing "not end at start"
(is (not (zip/end? z))))
(testing "end after full traversal"
(is (zip/end? (-> z zip/next zip/next zip/next))))))
(deftest test-prev
(let [z (zip/vector-zip [1 [2 3]])]
(testing "prev from second child"
(let [loc (-> z zip/next zip/next)]
(is (= (zip/node loc) [2 3]))
(is (= (zip/node (zip/prev loc)) 1))))
(testing "prev from leaf inside nested"
(let [loc (-> z zip/next zip/next zip/next)]
(is (= (zip/node loc) 2))
(is (= (zip/node (zip/prev loc)) [2 3]))))))
(deftest test-root-after-edits
(testing "root unwinds all the way after deep edits"
(let [z (zip/vector-zip [[1 2] [3 [4 5]]])
loc (-> z zip/down zip/right zip/down zip/right zip/down)
edited (zip/edit loc inc)]
(is (= (zip/root edited) [[1 2] [3 [5 5]]])))))
(run-tests)

View file

@ -0,0 +1,43 @@
# AOT image round-trip: compile a namespace, marshal it to bytecode, load it into
# a FRESH context, and run the loaded functions without recompiling.
(use ../../src/jolt/api)
(use ../../src/jolt/aot)
(use ../../src/jolt/types)
(print "AOT image round-trip...")
(def img-path (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-aot-test.jimg"))
# 1. Compile a namespace into ctx1: a constant, a fn over it, a fn using core
# fns, and a recursive fn.
(def ctx1 (init {:compile? true}))
(ctx-set-current-ns ctx1 "demo")
(eval-string ctx1 "(def base 100)")
(eval-string ctx1 "(defn add-base [x] (+ x base))")
(eval-string ctx1 "(defn sum-sq [xs] (reduce + (map (fn [x] (* x x)) xs)))")
(eval-string ctx1 "(defn fact [n] (if (zero? n) 1 (* n (fact (dec n)))))")
(assert (= 107 (eval-string ctx1 "(add-base 7)")) "ctx1 add-base")
(assert (= 14 (eval-string ctx1 "(sum-sq [1 2 3])")) "ctx1 sum-sq")
(assert (= 120 (eval-string ctx1 "(fact 5)")) "ctx1 fact")
# 2. Save an AOT image of the compiled namespace.
(save-ns ctx1 "demo" img-path)
(assert (os/stat img-path) "image written")
# 3. Load it into a brand-new context — no recompilation of demo.
(def ctx2 (init {:compile? true}))
(load-ns-image ctx2 "demo" img-path)
(ctx-set-current-ns ctx2 "demo")
(assert (= 107 (eval-string ctx2 "(add-base 7)")) "ctx2 add-base from image")
(assert (= 14 (eval-string ctx2 "(sum-sq [1 2 3])")) "ctx2 sum-sq from image")
(assert (= 3628800 (eval-string ctx2 "(fact 10)")) "ctx2 fact from image (new arg)")
# 4. The loaded vars are live: redefining one is visible to callers compiled in
# ctx2 that reference it.
(eval-string ctx2 "(def base 1000)")
(assert (= 1007 (eval-string ctx2 "(add-base 7)")) "loaded var still redefinable")
(os/rm img-path)
(print "AOT round-trip passed!")

View file

@ -0,0 +1,81 @@
# Bootstrap fixpoint (jolt-d0r).
#
# Soundness gate for self-hosting: the self-hosted compiler, rebuilt by compiling
# its OWN source through itself (stage2), must behave identically to the compiler
# built by the Janet bootstrap (stage1). We test this BEHAVIORALLY — run a corpus
# of programs through each stage and compare results — rather than by comparing
# emitted code, because emitted forms embed live setter/getter closures and the IR
# carries representation-level gensyms; behavioral parity is the property that
# actually matters and is representation-independent.
#
# stage1 = analyzer as built by the bootstrap.
# stage2 = analyzer rebuilt by compiling jolt.ir + jolt.analyzer through stage1
# (self-host, the fractal turn) and installing the result over itself.
# stage3 = the same self-rebuild applied again, on top of stage2.
# All three must produce identical results on the corpus.
(use ../../src/jolt/types)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(import ../../src/jolt/backend :as be)
(import ../../src/jolt/stdlib_embed :as se)
(defn- forms [src]
(var s src) (def fs @[])
(while (> (length (string/trim s)) 0)
(def p (parse-next s)) (set s (p 1))
(when (p 0) (array/push fs (p 0))))
fs)
# Programs exercising the compiled constructs (fn/multi-arity/recur/loop/if/let/
# map+vector literals/closures/higher-order/protocol dispatch). Each is a single
# expression evaluated through the compile pipeline; we compare printed results.
(def corpus
["(let [f (fn [x] (* x x))] (map f [1 2 3 4]))"
"(loop [i 0 acc 0] (if (< i 10) (recur (inc i) (+ acc i)) acc))"
"((fn fact [n] (if (zero? n) 1 (* n (fact (dec n))))) 6)"
"(reduce + 0 (filter even? (range 20)))"
"(let [[a b & r] [1 2 3 4 5]] [a b r])"
"(mapv (juxt identity inc dec) [10 20])"
"(frequencies (concat [:a :a] [:b]))"
"(group-by odd? (range 8))"
"(get-in {:a {:b {:c 42}}} [:a :b :c])"
"(first {:x 1})"
"(into {} (map (fn [k] [k (* k k)]) (range 5)))"
"((comp inc inc) 10)"
"(apply max [3 1 4 1 5 9 2 6])"
"(str (reverse \"hello\") (count [1 2 3]))"
"(let [m {:a 1}] (assoc m :b (+ (:a m) 1)))"])
(defn- run-corpus [ctx]
(map (fn [p] (def r (protect (eval-string ctx p)))
(if (r 0) (string/format "%j" (normalize-pvecs (r 1))) (string "ERR:" (r 1))))
corpus))
# Rebuild the analyzer through the self-hosted pipeline, in place.
(defn- self-rebuild! [ctx]
(def saved (ctx-current-ns ctx))
(each nsn ["jolt.ir" "jolt.analyzer"]
(ctx-set-current-ns ctx nsn)
(each f (forms (get se/sources nsn)) (protect (be/compile-and-eval ctx f))))
(ctx-set-current-ns ctx saved))
(def ctx (init {:compile? true}))
(def r1 (run-corpus ctx)) # stage1 (bootstrap-built)
(self-rebuild! ctx)
(def r2 (run-corpus ctx)) # stage2 (self-built)
(self-rebuild! ctx)
(def r3 (run-corpus ctx)) # stage3 (self-built from stage2)
(var failures 0)
(for i 0 (length corpus)
(unless (and (= (r1 i) (r2 i)) (= (r2 i) (r3 i)))
(++ failures)
(printf "FAIL [%s]\n stage1=%s\n stage2=%s\n stage3=%s" (corpus i) (r1 i) (r2 i) (r3 i)))
# also guard against everything silently erroring
(when (string/has-prefix? "ERR:" (r1 i))
(++ failures) (printf "FAIL [%s] stage1 errored: %s" (corpus i) (r1 i))))
(if (pos? failures)
(do (printf "bootstrap-fixpoint: %d failure(s)" failures) (os/exit 1))
(printf "bootstrap-fixpoint: stage1 == stage2 == stage3 on %d programs\n" (length corpus)))

View file

@ -0,0 +1,61 @@
# Vendored stdlib-namespace battery (jolt-0mb).
#
# clojure.test suites for stdlib namespaces beyond clojure.core, vendored from
# clojurust's clojure-test-suite fork (test/clojure-stdlib/, with corrected
# fixtures where the upstream expectations disagreed with real Clojure). Each
# file runs in the shared per-file worker; we guard a minimum pass count so a
# regression is caught and improvements (e.g. finishing clojure.edn) can raise
# the floor.
(def files
# [relative-path min-pass must-be-clean?]
[["clojure/walk_test/walk.cljc" 34 true]
["clojure/zip_test/zip.cljc" 33 true]
["clojure/data_test/diff.cljc" 61 true]
# clojure.edn reads via clojure.core/read-string (opts/:eof + nil/blank) and
# constructs set/nested values. Only #uuid remains (no real uuid type) —
# jolt-b7y. Guard the passing subset.
["clojure/edn_test/read_string.cljc" 49 false]])
(def root "test/clojure-stdlib")
(def per-file-timeout 6)
(defn- run-file [path]
(def proc (os/spawn ["janet" "test/integration/suite-worker.janet" path] :p {:out :pipe}))
(def out (proc :out))
(var data nil)
(def ok (try
(ev/with-deadline per-file-timeout
(set data (ev/read out 0x10000))
(os/proc-wait proc) true)
([err] false)))
(when (not ok)
(protect (os/proc-kill proc true))
(protect (ev/with-deadline 2 (os/proc-wait proc))))
(protect (:close out))
(if (and ok data) (string data) nil))
(defn- counts [s]
(var r nil)
(each line (string/split "\n" (or s ""))
(when (string/has-prefix? "@@COUNTS " line)
(let [p (string/split " " (string/trim line))]
(when (= 4 (length p)) (set r [(scan-number (p 1)) (scan-number (p 2)) (scan-number (p 3))])))))
r)
(var failures 0)
(each [rel min-pass clean?] files
(def path (string root "/" rel))
(def c (counts (run-file path)))
(if (nil? c)
(do (++ failures) (printf "FAIL %s: no result (crash/timeout)" rel))
(let [[p f e] c]
(printf " %-34s pass=%d fail=%d err=%d" rel p f e)
(when (< p min-pass)
(++ failures) (printf "FAIL %s: pass %d < baseline %d" rel p min-pass))
(when (and clean? (or (pos? f) (pos? e)))
(++ failures) (printf "FAIL %s: expected clean, got %d fail / %d err" rel f e)))))
(if (pos? failures)
(do (printf "clojure-stdlib-suite: %d failure(s)" failures) (os/exit 1))
(print "clojure-stdlib-suite: OK"))

View file

@ -1,20 +1,20 @@
# clojure-test-suite conformance: runs the external, cross-dialect
# clojure-test-suite (https://github.com/lread/clojure-test-suite, EPL) against
# Jolt and asserts the number of passing per-function test files stays at/above
# a baseline. Like the jank battery, this does NOT vendor the suite — it
# references ~/src/clojure-test-suite if present and SKIPS cleanly when absent.
# clojure-test-suite (jank-lang fork) against Jolt and asserts the number of
# passing per-function test files stays at/above a baseline. The suite is a git
# submodule at vendor/clojure-test-suite (CI checks it out via submodules:
# recursive). The test SKIPS cleanly only if the submodule isn't initialized
# (run `git submodule update --init`).
#
# Each suite file is a `clojure.test` namespace (one per clojure.core/string
# function). A minimal clojure.test + portability shim (test/support/clojure_test.clj)
# lets Jolt load them; `when-var-exists` auto-skips fns Jolt doesn't implement.
#
# Files are run in a one-shot worker subprocess (test/integration/suite-worker.janet)
# under a wall-clock deadline. Some suite tests build infinite sequences
# (cycle/range/transducers-over-infinite) that Jolt's eager evaluator can't
# truncate and so HANG rather than fail; the deadline contains them — a timed-out
# file is reported as :timeout and contributes nothing, no manual skip-list needed.
# under a wall-clock deadline. A few suite tests build infinite sequences that an
# uncompilable/eager path can't truncate and so HANG rather than fail; the
# deadline contains them — a timed-out file contributes nothing, no skip-list.
(def suite-dir (string (os/getenv "HOME") "/src/clojure-test-suite/test/clojure"))
(def suite-dir "vendor/clojure-test-suite/test/clojure")
# Baseline: assertions Jolt currently passes across the suite. Raise as Jolt
# improves so a regression (previously-passing assertion breaking) is caught.
@ -25,12 +25,30 @@
# running thread (Janet OS threads can't be interrupted), so `(deref (future
# (sleep 1)))` re-raises the unresolved-`Thread/sleep` error — a documented
# platform gap, not a regression in any previously-working behavior.
(def baseline-pass 3913)
# Raised 3913 -> 3916 with the staged-bootstrap kernel tier (ns-restore-on-throw
# + faithful subvec coercion), then 3916 -> 3919 moving juxt/every-pred/some-fn to
# Clojure (the canonical defs are more correct than the prior Janet ones). Raised
# 3919 -> 3926 preserving nil map values (jolt-c7h): a nil value is a present key,
# which several suite tests assert. Runs read 3927 consistently, occasionally 3926
# when a timeout-prone test (of the 9 that can time out) doesn't finish; floor at
# the consistent-minus-one 3926.
# Raised 3971 -> 3981 with Option A full laziness (jolt-fng): transformers return
# lazy seqs, lazy interleave stops timing out, and the lazy-seq nil-element +
# non-seqable-input fixes (case/seq/reverse/empty? over nil-first lazy seqs;
# lazy-from throws on non-seqable like Clojure) recovered + extended the suite.
# clean files 45 -> 66 (Option A makes seq?/vector? results match Clojure across
# many cross-dialect files). Stable across runs.
(def baseline-pass 3981)
# A file is "clean" when it ran with zero failures AND zero errors.
(def baseline-clean-files 45)
# Per-file wall-clock budget (seconds). Normal files finish in well under 1s;
# this only fires on infinite-sequence hangs.
(def per-file-timeout 6)
(def baseline-clean-files 66)
# Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so
# this normally only fires on genuinely-infinite-sequence hangs. It's an env var
# (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can
# give slow-but-finite files generous headroom without timing them out (which
# would drop total-pass below the baseline and flake CI red). Default 6 locally.
(def per-file-timeout
(let [e (os/getenv "JOLT_SUITE_TIMEOUT")]
(or (and e (scan-number e)) 6)))
(defn- walk [dir acc]
(each e (os/dir dir)
@ -73,7 +91,7 @@
result)
(if (not (os/stat suite-dir))
(print "clojure-test-suite: ~/src/clojure-test-suite not present — skipped")
(print "clojure-test-suite: vendor/clojure-test-suite not initialized — skipped (run: git submodule update --init)")
(do
(def progress? (os/getenv "SUITE_PROGRESS"))
(def files (sort (walk suite-dir @[])))

View file

@ -98,12 +98,44 @@
(assert (= 1 (ct-eval ctx "(:a {:a 1})")) "keyword as fn")
(assert (= 1 (ct-eval ctx "({:a 1} :a)")) "map as fn")
(assert (= 2 (ct-eval ctx "(#{1 2 3} 2)")) "set as fn")
(assert (= true (ct-eval ctx "(= [1 2] [1 2])")) "= is value equality, not core-= bypass"))
(assert (= true (ct-eval ctx "(= [1 2] [1 2])")) "= is value equality, not core-= bypass")
# Context isolation: a def in one compiled context is invisible in another.
# Phase 2: hybrid fallback. Forms the compiler can't compile (destructuring,
# multi-arity, named fns) interpret instead of erroring or miscompiling. The
# result is the same — compilation is a transparent speedup.
(print " hybrid fallback (destructuring / multi-arity)...")
(assert (= 3 (ct-eval ctx "(let [[a b] [1 2]] (+ a b))")) "vector destructuring let")
(assert (= 6 (ct-eval ctx "(let [{:keys [x y z]} {:x 1 :y 2 :z 3}] (+ x y z))")) "map destructuring let")
(assert (= 3 (ct-eval ctx "((fn [[a b]] (+ a b)) [1 2])")) "destructuring fn param")
(assert (= 5 (ct-eval ctx "(let [[a & more] [1 2 3 4 5]] (+ a (count more)))")) "rest destructuring")
(ct-eval ctx "(defn arity ([a] a) ([a b] (+ a b)) ([a b & more] (apply + a b more)))")
(assert (= 5 (ct-eval ctx "(arity 5)")) "multi-arity 1")
(assert (= 7 (ct-eval ctx "(arity 3 4)")) "multi-arity 2")
(assert (= 15 (ct-eval ctx "(arity 1 2 3 4 5)")) "multi-arity variadic clause")
(assert (= 10 (ct-eval ctx "((fn self [n] (if (zero? n) 0 (+ n (self (dec n))))) 4)")) "named fn recursion")
# recur directly inside a fn (not a loop) — re-enters the fn's arity. Compiles
# to a self-call; was previously broken under compilation.
(assert (= 15 (ct-eval ctx "((fn [n acc] (if (zero? n) acc (recur (dec n) (+ acc n)))) 5 0)")) "recur in fn")
(assert (= 3 (ct-eval ctx "((fn cnt [acc & xs] (if (seq xs) (recur (inc acc) (rest xs)) acc)) 0 :a :b :c)")) "recur into variadic arity")
(assert (= 6 (ct-eval ctx "(loop [[x & xs] [1 2 3] acc 0] (if x (recur xs (+ acc x)) acc))")) "destructuring loop binding")
# A runtime error in compiled code must propagate, not silently fall back to a
# second (interpreted) evaluation.
(assert (= :threw (try (do (ct-eval ctx "(inc nil)") :no-throw) ([_] :threw)))
"runtime error in compiled code propagates"))
# Context isolation: a def in one compiled context is invisible in another. With
# var-indirection each context has its own var cells, so b's `secret` is a
# distinct, unbound var (nil) rather than a's 7.
(let [a (init {:compile? true}) b (init {:compile? true})]
(eval-string a "(def secret 7)")
(assert (= 7 (ct-eval a "secret")) "def visible in its own ctx")
(assert (not ((protect (ct-eval b "secret")) 0)) "def isolated to its ctx"))
(assert (nil? (ct-eval b "secret")) "def isolated to its ctx"))
# Redefinition is visible to already-compiled callers (var-indirection).
(let [c (init {:compile? true})]
(eval-string c "(defn g [] 1)")
(eval-string c "(defn calls-g [] (g))")
(eval-string c "(defn g [] 2)")
(assert (= 2 (ct-eval c "(calls-g)")) "compiled caller sees redefined global"))
(print "\nAll Phase 6 tests passed!")

View file

@ -13,6 +13,8 @@
# until a minimal clojure.test lets us load the real files directly.
(use ../../src/jolt/api)
(import ../../src/jolt/backend :as selfhost)
(use ../../src/jolt/reader)
(def cases
[
@ -60,6 +62,30 @@
["into map onto map" "{:a 1 :b 2 :c 3}" "(into {:a 1} [[:b 2] [:c 3]])"]
["into list" "(quote (3 2 1))" "(into (list) [1 2 3])"]
### ---- Option A: lazy transformers return seqs, not vectors ----
# map/filter/take/take-while over a concrete vector yield a lazy seq, matching
# Clojure: (seq? (map ...)) is true, (vector? (map ...)) is false.
["map vec is seq" "true" "(seq? (map inc [1 2 3]))"]
["map vec not vector" "false" "(vector? (map inc [1 2 3]))"]
["filter vec is seq" "true" "(seq? (filter odd? [1 2 3]))"]
["take vec is seq" "true" "(seq? (take 2 [1 2 3]))"]
["map over set" "true" "(= #{2 3 4} (set (map inc #{1 2 3})))"]
["filter over map ev" "(quote ([:b 2]))" "(filter (fn [[k v]] (> v 1)) {:a 1 :b 2})"]
# cons of cons over a lazy tail must not leak the rest-thunk
["cons cons lazy" "(quote (1 2 3))" "(cons 1 (cons 2 (lazy-seq (cons 3 nil))))"]
["juxt fns in vec" "[1 3]" "((juxt first last) [1 2 3])"]
["last of lazy take" "5" "(last (take 5 (iterate inc 1)))"]
["next empty lazy" "nil" "(next (take 1 [1]))"]
# drop/distinct/partition/map-indexed/take-nth/interpose/keep are lazy too
["drop vec is seq" "true" "(seq? (drop 1 [1 2 3]))"]
["distinct vec is seq" "true" "(seq? (distinct [1 1 2]))"]
["map-indexed is seq" "true" "(seq? (map-indexed vector [1 2]))"]
["partition vec lazy" "(quote ((1 2) (3 4)))" "(partition 2 [1 2 3 4 5])"]
# nth over a lazy seq must not treat a false/nil element as end-of-seq
["nth lazy false elem" "false" "(nth (map identity [false 1 2]) 0)"]
["nth lazy past false" "2" "(nth (drop 1 (list false 1 2)) 1)"]
["cond-> false clause" "2" "(cond-> 1 true inc false inc)"]
### ---- HIGH: destructuring ----
["destr nested seq" "[1 2 3]" "(let [[a [b c]] [1 [2 3]]] [a b c])"]
["destr rest+as" "[1 (quote (2 3)) [1 2 3]]" "(let [[a & r :as all] [1 2 3]] [a r all])"]
@ -106,6 +132,7 @@
["subvec" "[2 3]" "(subvec [1 2 3 4 5] 1 3)"]
["subvec to-end" "[3 4 5]" "(subvec [1 2 3 4 5] 2)"]
["reduce-kv" "{:a 2 :b 3}" "(reduce-kv (fn [m k v] (assoc m k (inc v))) {} {:a 1 :b 2})"]
["reduce-kv vector idx" "(quote ([0 :a] [1 :b]))" "(reduce-kv (fn [a i v] (conj a [i v])) [] [:a :b])"]
### ---- iterating maps yields entries ----
["map over map" "true" "(= #{1 2} (set (map val {:a 1 :b 2})))"]
@ -125,6 +152,20 @@
["reductions" "(quote (1 3 6 10))" "(reductions + [1 2 3 4])"]
["reductions init" "(quote (0 1 3 6))" "(reductions + 0 [1 2 3])"]
["dedupe" "(quote (1 2 3 1))" "(dedupe [1 1 2 3 3 1])"]
# partition-by with a strict pred (odd?) — guards jolt-r81: a lazy overlay fn
# whose lazy-seq leaked its expansion in compile mode passed a non-int to odd?.
["partition-by odd?" "(quote ((1 1) (2) (3 3)))" "(partition-by odd? [1 1 2 3 3])"]
["reductions inf" "(quote (0 1 3 6))" "(take 4 (reductions + (range)))"]
["tree-seq strict" "10" "(reduce + 0 (filter (complement coll?) (tree-seq coll? seq [1 [2 [3 4]]])))"]
# nil/collection case-constants past the point where Option A's lazy `drop`
# made the case macro's (empty? (drop 2 cls)) hit a nil-first lazy seq.
["case nil + default" "[:nilr :def]" "(let [f (fn [x] (case x 1 :one nil :nilr :def))] [(f nil) (f 9)])"]
["case collection consts" "[:v :m :s]" "(let [f (fn [x] (case x [1 2] :v {:a 1} :m #{3} :s :def))] [(f [1 2]) (f {:a 1}) (f #{3})])"]
# a lazy seq whose first element is nil is non-empty (seq/empty?/reverse)
["seq of nil-first" "true" "(boolean (seq (cons nil (list 1))))"]
["reverse nil elem" "[2 nil 1]" "(vec (reverse (list 1 nil 2)))"]
# lazy transformer over a non-seqable scalar throws (matches Clojure)
["map non-seqable throws" "true" "(try (doall (map inc 5)) false (catch Throwable _ true))"]
["keep-indexed" "(quote (:b :d))" "(keep-indexed (fn [i x] (if (odd? i) x)) [:a :b :c :d])"]
["map-indexed" "(quote ([0 :a] [1 :b]))" "(map-indexed (fn [i x] [i x]) [:a :b])"]
["trampoline" ":done" "(do (defn a [n] (if (zero? n) :done (fn [] (a (dec n))))) (trampoline a 5))"]
@ -271,6 +312,10 @@
["transduce remove" "[1 3 5]" "(into [] (remove even?) [1 2 3 4 5])"]
["transduce take-while" "[1 2]" "(into [] (take-while (fn [x] (< x 3))) [1 2 3 4 1])"]
["transduce map-indexed" "[[0 :a] [1 :b]]" "(into [] (map-indexed (fn [i x] [i x])) [:a :b])"]
["partition-all xform" "[[1 2] [3 4] [5]]" "(into [] (partition-all 2) [1 2 3 4 5])"]
["partition-all xform comp" "[2 2 1]" "(into [] (comp (partition-all 2) (map count)) [1 2 3 4 5])"]
["partition-by xform" "[[1 1] [2 4] [5]]" "(into [] (partition-by odd?) [1 1 2 4 5])"]
["partition-by xform reduced" "[[1 1] [2 4]]" "(into [] (comp (partition-by odd?) (take 2)) [1 1 2 4 5 5])"]
### ==== regex (capturing groups, backtracking, flags, lookahead) ====
["re-find groups" "[\"12-34\" \"12\" \"34\"]" "(re-find #\"(\\d+)-(\\d+)\" \"x12-34y\")"]
@ -297,29 +342,64 @@
["map literal nested" "{:a {:b 2}}" "(let [y 2] {:a {:b y}})"]
["map literal keyfn" "{:x 1}" "(let [k :x] {k 1})"]
["map literal in fn" "6" "(do (defn mk [a b] {:sum (+ a b)}) (:sum (mk 2 4)))"]
### ---- overlay migration (jolt-1j0): run in all 3 modes ----
# if-let/when-let bind only in the taken branch (else sees outer scope)
["if-let else outer scope" "5" "(let [x 5] (if-let [x nil] :then x))"]
["if-some else outer" "5" "(let [x 5] (if-some [x nil] :then x))"]
["when-let body multi" "14" "(when-let [x 7] (inc x) (* x 2))"]
# nthrest returns () (not nil) for an exhausted n>0 walk; coll for n<=0
["nthrest exhausted" "(quote ())" "(nthrest nil 100)"]
["nthrest n=0 keeps coll" "[1 2 3]" "(nthrest [1 2 3] 0)"]
["nthnext surprising nil" "nil" "(nthnext nil nil)"]
# distinct? compares by value
["distinct? equal colls" "false" "(distinct? [1 2] [1 2])"]
["not-any?" "true" "(not-any? even? [1 3 5])"]
["take-last" "[3 4]" "(take-last 2 [1 2 3 4])"]
["replace nil val" "[1 nil 3]" "(replace {2 nil} [1 2 3])"]
])
(var pass 0)
(def fails @[])
(each [name expected actual] cases
(def ctx (init))
(def prog (string "(= " expected " " actual ")"))
(def res (protect (eval-string ctx prog)))
(cond
(not= (res 0) true)
(array/push fails [name "ERROR" (string (res 1))])
(= (res 1) true)
(++ pass)
# not equal: re-eval actual alone to show what we got
(let [got (protect (eval-string (init) actual))]
(array/push fails [name "MISMATCH"
(string "want=" expected
" got=" (if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))]))))
# Run every case under a given context factory and return the failures. The same
# cases run under both the interpreter and the compiler: results must match real
# Clojure semantics either way, so the compile path (hybrid: hot compiles,
# unsupported forms fall back to the interpreter) must not diverge.
# mode: {} interpret, {:compile? true} bootstrap compiler, {:selfhost true} the
# self-hosted pipeline (portable Clojure analyzer -> IR -> Janet back end).
(defn- run-cases [mode]
(def selfhost? (get mode :selfhost))
(def init-opts (if selfhost? {} mode))
(defn ev [ctx prog]
(if selfhost? (selfhost/compile-and-eval ctx (parse-string prog)) (eval-string ctx prog)))
(def fails @[])
(each [name expected actual] cases
(def ctx (init init-opts))
(def prog (string "(= " expected " " actual ")"))
(def res (protect (ev ctx prog)))
(cond
(not= (res 0) true)
(array/push fails [name "ERROR" (string (res 1))])
(= (res 1) true)
nil
(let [got (protect (ev (init init-opts) actual))]
(array/push fails [name "MISMATCH"
(string "want=" expected
" got=" (if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))]))))
fails)
(printf "\n=== CONFORMANCE: %d/%d passed ===" pass (length cases))
(unless (empty? fails)
(print "\n--- Failures ---")
(each [name kind detail] fails
(printf "[%s] %s: %s" kind name detail)))
(defn- report [label fails]
(printf "=== CONFORMANCE (%s): %d/%d passed ===" label (- (length cases) (length fails)) (length cases))
(unless (empty? fails)
(print "--- Failures ---")
(each [name kind detail] fails
(printf "[%s] %s: %s" kind name detail))))
(def interp-fails (run-cases {}))
(report "interpret" interp-fails)
(def compile-fails (run-cases {:compile? true}))
(report "compile" compile-fails)
(def selfhost-fails (run-cases {:selfhost true}))
(report "self-host" selfhost-fails)
(print)
(when (pos? (length fails)) (os/exit 1))
(when (or (pos? (length interp-fails)) (pos? (length compile-fails))
(pos? (length selfhost-fails)))
(os/exit 1))

View file

@ -0,0 +1,63 @@
# Direct-linking / redefinition matrix (jolt-d9j, jolt-g86).
#
# Direct-linking is a per-compilation-UNIT property (Clojure model). A call
# compiles direct iff the unit has direct-linking on AND the target is not
# ^:redef/^:dynamic AND the target is an already-defined fn. Otherwise indirect
# (live var deref → redefinable). This pins the user-visible semantics:
# - default user/REPL unit (direct-linking off): redefine anything, callers see it
# - direct-linked unit: callers don't see a later redef (unless target ^:redef)
# - :aot-core? gates whether the core tiers compile direct-linked
(use ../../src/jolt/api)
(var failures 0)
(defn- check [label got want]
(unless (= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
# 1. Default unit (direct-linking OFF): redefinition reaches compiled callers.
(let [ctx (init {:compile? true})]
(eval-string ctx "(defn add [a b] (+ a b))")
(eval-string ctx "(defn caller [] (add 1 2))")
(check "default before redef" (eval-string ctx "(caller)") 3)
(eval-string ctx "(defn add [a b] (* a b))")
(check "default sees redef (indirect)" (eval-string ctx "(caller)") 2))
# 2. Direct-linked unit: compiled caller keeps the original target after a redef.
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(defn add [a b] (+ a b))")
(eval-string ctx "(defn caller [] (add 1 2))")
(check "direct before redef" (eval-string ctx "(caller)") 3)
(eval-string ctx "(defn add [a b] (* a b))")
(check "direct ignores redef (sealed)" (eval-string ctx "(caller)") 3)
# the var itself is still redefined; only the direct-linked call is frozen
(check "direct var still updated" (eval-string ctx "(add 3 4)") 12))
# 3. ^:redef opts a var OUT of direct-linking even in a direct-linked unit.
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(defn ^:redef add [a b] (+ a b))")
(eval-string ctx "(defn caller [] (add 1 2))")
(check "redef-tagged before" (eval-string ctx "(caller)") 3)
(eval-string ctx "(defn ^:redef add [a b] (* a b))")
(check "redef-tagged sees redef" (eval-string ctx "(caller)") 2))
# 4. :aot-core? true (default): redefining a core fn (in clojure.core) is still
# seen by USER code, because user calls are indirect regardless of core being
# direct-linked internally.
(let [ctx (init {:compile? true})]
(eval-string ctx "(defn uses-last [] (last [1 2 3]))")
(check "core call before" (eval-string ctx "(uses-last)") 3)
(eval-string ctx "(in-ns (quote clojure.core))")
(eval-string ctx "(def last (fn [coll] :patched))")
(eval-string ctx "(in-ns (quote user))")
(check "user sees core redef (indirect)" (eval-string ctx "(uses-last)") :patched))
# 5. :aot-core? false: core compiles indirect too, so even core-internal callers
# see a redef — the whole language is redefinable.
(let [ctx (init {:compile? true :aot-core? false})]
(check "aot-core off still correct" (eval-string ctx "(last [1 2 3])") 3))
(if (pos? failures)
(do (printf "direct-linking: %d failure(s)" failures) (os/exit 1))
(print "direct-linking: all matrix cases passed"))

View file

@ -0,0 +1,51 @@
# Protocol host-value dispatch cache (jolt-4ay).
#
# Host-value protocol dispatch used to recompute the candidate type-tag list and
# walk the registry on every call. It's now a generation-guarded cache keyed by
# (most-specific-host-tag, protocol, method); registering a protocol impl bumps
# the registry generation and invalidates it. This pins correctness: the cache
# must never hide a re-extension.
(use ../../src/jolt/api)
(var failures 0)
(defn- check [label got want]
(unless (= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
(each mode [{:compile? true} {} {:aot-core? false}]
(def ctx (init mode))
(eval-string ctx "(defprotocol P (m [x]))")
(eval-string ctx "(extend-protocol P Number (m [x] (* x 2)))")
(check (string mode " host dispatch") (eval-string ctx "(m 5)") 10)
(check (string mode " cache hit (same class)") (eval-string ctx "(m 7)") 14)
# Re-extend: registry generation bumps, cache must invalidate.
(eval-string ctx "(extend-protocol P Number (m [x] (+ x 100)))")
(check (string mode " sees re-extension") (eval-string ctx "(m 5)") 105)
# Extending a different host class bumps gen too; number impl re-resolves.
(eval-string ctx "(extend-protocol P String (m [x] (str \"s:\" x)))")
(check (string mode " other class") (eval-string ctx "(m \"hi\")") "s:hi")
(check (string mode " number after other-class extend") (eval-string ctx "(m 3)") 103))
# Multimethod hierarchy-fallback cache (jolt-g8w): the isa? walk result for a
# dispatch value is cached; defmethod/remove-method must invalidate it.
(each mode [{:compile? true} {} {:aot-core? false}]
(def ctx (init mode))
(eval-string ctx "(derive ::circle ::shape)")
(eval-string ctx "(derive ::square ::shape)")
(eval-string ctx "(defmulti area identity)")
(eval-string ctx "(defmethod area ::shape [_] :generic)")
(check (string mode " mm hierarchy") (eval-string ctx "(area ::circle)") :generic)
(check (string mode " mm cache hit") (eval-string ctx "(area ::circle)") :generic)
# adding a more specific method must invalidate the cached hierarchy result
(eval-string ctx "(defmethod area ::circle [_] :specific)")
(check (string mode " mm sees new method") (eval-string ctx "(area ::circle)") :specific)
(check (string mode " mm other still hierarchy") (eval-string ctx "(area ::square)") :generic)
# removing it must re-expose the hierarchy fallback
(eval-string ctx "(remove-method area ::circle)")
(check (string mode " mm sees removal") (eval-string ctx "(area ::circle)") :generic))
(if (pos? failures)
(do (printf "dispatch-cache: %d failure(s)" failures) (os/exit 1))
(print "dispatch-cache: all cases passed (compile, interpret, aot-core off)"))

View file

@ -0,0 +1,123 @@
# Deadlined infinite-seq conformance harness (Phase 5 Step 0).
#
# Each case is [name expected-clj actual-clj]. The harness spawns a subprocess
# worker (test/support/lazy-eval.janet) that evaluates (= expected actual) and
# prints @@RESULT true/false. Workers run under a wall-clock deadline; a hang
# = a FAIL. This is the safety net that makes it safe to convert transformers
# to lazy — wrong answers hang instead of silently passing.
#
# Pattern mirrors clojure-test-suite-test.janet: os/spawn + ev/with-deadline
# + os/proc-kill on timeout. Never probe infinite cases in-process.
(def per-case-timeout 5)
(defn- run-case [expected actual]
(def proc (os/spawn ["janet" "test/support/lazy-eval.janet" expected actual] :p {:out :pipe}))
(def out (proc :out))
(var data nil)
(def ok
(try
(ev/with-deadline per-case-timeout
(set data (ev/read out 0x10000))
(os/proc-wait proc)
true)
([err] false)))
(when (not ok)
(protect (os/proc-kill proc true))
(protect (ev/with-deadline 2 (os/proc-wait proc))))
(protect (:close out))
(if (and ok data) (string data) nil))
(defn- parse-result [s]
(def prefix-len (length "@@RESULT "))
(if (string/has-prefix? "@@RESULT " s)
(let [val (string/slice s prefix-len (dec (length s)))]
[:ok val])
(if (string/has-prefix? "@@ERROR " s)
(let [msg (string/slice s (length "@@ERROR ") (dec (length s)))]
[:error msg])
nil)))
# ---- Cases from phase-5.md §6.2 ----
# Expected values use Clojure quote syntax so the worker evaluates
# (= (quote ...) actual) with Clojure's = semantics.
(def cases
[
["nth of map inc range" "1001" "(nth (map inc (range)) 1000)"]
["first filter even? drop range" "4" "(first (filter even? (drop 3 (range))))"]
["take 3 remove odd? range" "(quote (0 2 4))" "(take 3 (remove odd? (range)))"]
["take 3 drop-while <5 range" "(quote (5 6 7))" "(take 3 (drop-while (fn [x] (< x 5)) (range)))"]
["take 4 interleave range iterate" "(quote (0 10 1 11))" "(take 4 (interleave (range) (iterate inc 10)))"]
["take 4 reductions + range" "(quote (0 1 3 6))" "(take 4 (reductions + (range)))"]
["take 3 tree-seq infinite" "(quote (0 0 0))" "(take 3 (tree-seq (fn [_] true) (fn [n] [n]) 0))"]
["sequence xform lazy inf" "(quote (1 2 3))" "(take 3 (sequence (map inc) (range)))"]
["sequence comp xform inf" "(quote (2 4 6))" "(take 3 (sequence (comp (filter odd?) (map inc)) (range)))"]
["every? short-circuits on inf" "false" "(every? pos? (range))"]
["not-every? short-circuits on inf" "true" "(not-every? pos? (range))"]
["take 3 partition 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition 2 (range)))"]
["take 3 partition-all 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition-all 2 (range)))"]
["take 3 map-indexed vector range" "(quote ([0 0] [1 1] [2 2]))" "(take 3 (map-indexed vector (range)))"]
["take 3 distinct cycle" "(quote (1 2 3))" "(take 3 (distinct (cycle [1 2 1 3 1])))"]
["take 6 mapcat dup range" "(quote (0 0 1 1 2 2))" "(take 6 (mapcat (fn [x] [x x]) (range)))"]
["first rest lazy" "1" "(let [[a & r] (range)] (first r))"]
["take 3 rest lazy" "(quote (1 2 3))" "(let [[a & r] (range)] (take 3 r))"]
["dedupe inf" "(quote (1 2 1 2 1))" "(take 5 (dedupe (cycle [1 1 2 2])))"]
["take 3 take-nth 2 range" "(quote (0 2 4))" "(take 3 (take-nth 2 (range)))"]
["take 3 interpose :x range" "(quote (0 :x 1))" "(take 3 (interpose :x (range)))"]
["take 3 map vector range iterate" "(quote ([0 100] [1 101] [2 102]))" "(take 3 (map vector (range) (iterate inc 100)))"]
# §6.3 Laziness counter tests — realize exactly the demanded prefix. Under
# Option A `take` is lazy, so the take result must be forced (dorun) to drive
# realization; reading the counter without forcing would (correctly) see 0.
["LAZY map" "3" "(do (def c (atom 0)) (dorun (take 3 (map (fn [x] (swap! c inc) x) (range)))) @c)"]
["LAZY filter" "6" "(do (def c (atom 0)) (dorun (take 3 (filter (fn [x] (swap! c inc) (odd? x)) (range)))) @c)"]
["LAZY remove" "6" "(do (def c (atom 0)) (dorun (take 3 (remove (fn [x] (swap! c inc) (even? x)) (range)))) @c)"]
["LAZY take-while" "6" "(do (def c (atom 0)) (dorun (take-while (fn [x] (swap! c inc) (< x 5)) (range))) @c)"]
["LAZY drop-while" "6" "(do (def c (atom 0)) (dorun (take 3 (drop-while (fn [x] (swap! c inc) (< x 5)) (range)))) @c)"]
["LAZY distinct" "4" "(do (def c (atom 0)) (dorun (take 3 (distinct (map (fn [x] (swap! c inc) x) (cycle [1 2 1 3 1]))))) @c)"]
["LAZY take-nth" "7" "(do (def c (atom 0)) (dorun (take 3 (take-nth 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY map-indexed" "3" "(do (def c (atom 0)) (dorun (take 3 (map-indexed (fn [i x] (swap! c inc) [i x]) (range)))) @c)"]
["LAZY keep" "6" "(do (def c (atom 0)) (dorun (take 3 (keep (fn [x] (swap! c inc) (if (odd? x) x nil)) (range)))) @c)"]
["LAZY keep-indexed" "6" "(do (def c (atom 0)) (dorun (take 3 (keep-indexed (fn [i x] (swap! c inc) (if (odd? i) x)) (range)))) @c)"]
["LAZY interpose" "2" "(do (def c (atom 0)) (dorun (take 3 (interpose :x (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY partition" "6" "(do (def c (atom 0)) (dorun (take 3 (partition 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY partition-all" "6" "(do (def c (atom 0)) (dorun (take 3 (partition-all 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY mapcat" "3" "(do (def c (atom 0)) (dorun (take 6 (mapcat (fn [x] (swap! c inc) [x x]) (range)))) @c)"]
["LAZY dedupe" "9" "(do (def c (atom 0)) (dorun (take 5 (dedupe (map (fn [x] (swap! c inc) x) (cycle [1 1 2 2]))))) @c)"]
["LAZY repeated inc" "3" "(do (def c (atom 0)) (dorun (take 3 (map (fn [x] (swap! c inc) x) (iterate inc 0)))) @c)"]
# Already-working cases (guard against regression)
["take 5 iterate inc" "(quote (0 1 2 3 4))" "(take 5 (iterate inc 0))"]
["take 3 range" "(quote (0 1 2))" "(take 3 (range))"]
["take 3 repeat" "(quote (7 7 7))" "(take 3 (repeat 7))"]
["take 3 cycle" "(quote (1 2 1))" "(take 3 (cycle [1 2]))"]
["take 3 filter even? range" "(quote (0 2 4))" "(take 3 (filter even? (range)))"]
["take 5 lazily filtered from range" "(quote (1 3 5 7 9))" "(take 5 (filter odd? (range)))"]
])
# ---- Run ----
(var fails @[])
(var timeouts 0)
(var passed 0)
(each [name expected expr] cases
(def out (run-case expected expr))
(cond
(nil? out)
(do (++ timeouts) (array/push fails (string "TIMEOUT: " name)))
(let [res (parse-result out)]
(case (res 0)
:ok (if (= "true" (res 1))
(++ passed)
(array/push fails (string "MISMATCH: " name " — expected " expected)))
:error (array/push fails (string "ERROR: " name " — " (res 1)))
(array/push fails (string "PARSE: " name " — raw: " (string/trim out)))))))
(printf "lazy-infinite: %d cases — %d passed / %d timeouts / %d failures"
(length cases) passed timeouts (length fails))
(when (> (length fails) 0)
(print "\nFailures:")
(each f fails (printf " %s" f)))
(if (or (> (length fails) 0) (> timeouts 0))
(os/exit 1))

View file

@ -0,0 +1,88 @@
# End-to-end proof of the self-hosting pipeline: a reader form is analyzed by the
# PORTABLE Clojure analyzer (jolt.analyzer, in jolt-core) into host-neutral IR,
# then the Janet back end lowers the IR to a Janet form and evaluates it. No use
# of compiler.janet's analyzer — this is the Clojure-in-Clojure front end.
(import ../../src/jolt/backend :as backend)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(use ../../src/jolt/types)
(defn ce [ctx s] (normalize-pvecs (backend/compile-and-eval ctx (parse-string s))))
(print "self-host pipeline (Clojure analyzer -> IR -> Janet)...")
(let [ctx (init)]
# primitives + control flow
(assert (= 3 (ce ctx "(+ 1 2)")) "+")
(assert (= 6 (ce ctx "(* 2 3)")) "*")
(assert (= :a (ce ctx "(if true :a :b)")) "if true")
(assert (= :b (ce ctx "(if false :a :b)")) "if false")
(assert (= 10 (ce ctx "(let [x 4 y 6] (+ x y))")) "let")
(assert (= 6 (ce ctx "(do 1 2 6)")) "do")
# literals
(assert (= [2 3 4] (ce ctx "(map inc [1 2 3])")) "vector literal + core fn")
(assert (= 1 (ce ctx "(get {:a 1 :b 2} :a)")) "map literal")
(assert (= 42 (ce ctx "(quote 42)")) "quote literal")
# def + global reference (name-based var resolution)
(ce ctx "(def base 100)")
(assert (= 142 (ce ctx "(+ base 42)")) "def + later ref")
# fn / defn (defn is a macro -> expand -> def of fn*)
(ce ctx "(defn add [a b] (+ a b))")
(assert (= 7 (ce ctx "(add 3 4)")) "defn")
(assert (= 49 (ce ctx "((fn [x] (* x x)) 7)")) "anon fn")
# recursion through the var cell (no recur needed)
(ce ctx "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
(assert (= 55 (ce ctx "(fib 10)")) "recursive fib via var")
# multi-arity + variadic
(ce ctx "(defn arity ([a] a) ([a b] (+ a b)) ([a b & more] (apply + a b more)))")
(assert (= 5 (ce ctx "(arity 5)")) "multi-arity 1")
(assert (= 7 (ce ctx "(arity 3 4)")) "multi-arity 2")
(assert (= 15 (ce ctx "(arity 1 2 3 4 5)")) "multi-arity variadic")
# loop / recur
(assert (= 15 (ce ctx "(loop [i 0 acc 0] (if (< i 6) (recur (inc i) (+ acc i)) acc))")) "loop/recur")
# recur directly in a fixed-arity fn
(assert (= 15 (ce ctx "((fn [n acc] (if (zero? n) acc (recur (dec n) (+ acc n)))) 5 0)")) "recur in fn")
# try / catch / finally
(assert (= "caught" (ce ctx "(try (throw 42) (catch Exception e \"caught\"))")) "try/catch")
(assert (= 7 (ce ctx "(try 7 (finally 0))")) "try/finally")
# higher-order + nesting
(assert (= 15 (ce ctx "(reduce + (map inc [0 1 2 3 4]))")) "reduce+map"))
# eval-toplevel routing: :compile? IS the self-hosted pipeline now — the only
# compile path. Forms the analyzer can't handle (stateful / destructuring) fall
# back to the interpreter, with the same observable results.
(print "self-host via eval-toplevel routing...")
(let [ctx (init {:compile? true})]
(defn ev [s] (normalize-pvecs (eval-one ctx (parse-string s))))
(assert (= 3 (ev "(+ 1 2)")) "tl +")
(ev "(defn sq [x] (* x x))") # def via self-host
(assert (= 81 (ev "(sq 9)")) "tl defn")
(ev "(defmacro twice [x] (list (quote do) x x))") # stateful -> interp fallback
(assert (= 5 (ev "(do (twice 1) 5)")) "tl macro fallback")
(assert (= [1 2 3] (ev "(let [{:keys [a b c]} {:a 1 :b 2 :c 3}] [a b c])")) "tl destructuring fallback")
(assert (= 15 (ev "(reduce + (range 6))")) "tl reduce/range")
# Proof the self-hosted pipeline actually ran: only backend/ensure-analyzer
# populates jolt.analyzer. An interpret-only ctx never loads it.
(assert (pos? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) "analyzer loaded under :compile?"))
(let [ctx (init {})]
(eval-one ctx (parse-string "(+ 1 2)"))
(assert (zero? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) "analyzer NOT loaded when interpreting"))
# clojure.core overlay: fns moved from core.janet to jolt-core/clojure/core.clj
# load into clojure.core at init and work the same compiled or interpreted.
(print "clojure.core overlay (Clojure-defined core fns)...")
(each opts [{:compile? true} {}]
(let [ctx (init opts)]
(defn ev [s] (normalize-pvecs (eval-one ctx (parse-string s))))
(assert (= 1 (ev "(ffirst [[1 2] [3 4]])")) "ffirst")
(assert (= [2] (ev "(nfirst [[1 2] [3 4]])")) "nfirst")
(assert (= 2 (ev "(fnext [1 2 3])")) "fnext")
(assert (= [3 4] (ev "(nnext [1 2 3 4])")) "nnext")))
(print "self-host pipeline passed!")

View file

@ -0,0 +1,63 @@
# Staged-bootstrap soundness (jolt-vcx, under epic jolt-tzo).
#
# The self-hosted compiler's structural deps — second/peek/subvec/mapv/update —
# now come from the Clojure kernel tier (jolt-core/clojure/core/00-kernel.clj),
# bootstrap-compiled into clojure.core BEFORE the analyzer is built. This pins
# the two properties that make that safe:
#
# 1. Compile mode: the analyzer (which itself calls second/peek/subvec/mapv)
# compiles analyzer-exercising forms correctly — the exact case that broke
# when `second` was a plain overlay fn: (first {:a 1}) / (key (first ...)).
# 2. Bootstrap FIXPOINT: rebuilding the compiler (rebuild-compiler!) against the
# now Clojure-defined core still yields a correct compiler. This is the
# soundness gate for every future fractal turn (S2 -> S3).
(use ../../src/jolt/api)
(import ../../src/jolt/backend :as backend)
(var failures 0)
# Each probe is a jolt boolean expression; compared with jolt's own `=`.
(def probes
["(= 2 (second [1 2 3]))"
"(= nil (second [1]))"
"(= 3 (peek [1 2 3]))"
"(= 1 (peek (list 1 2 3)))"
"(= nil (peek []))"
"(= [2 3] (subvec [1 2 3 4 5] 1 3))"
"(= [3 4 5] (subvec [1 2 3 4 5] 2))"
"(= [2 3 4] (mapv inc [1 2 3]))"
"(= [11 22 33] (mapv + [1 2 3] [10 20 30]))"
"(= {:a 2} (update {:a 1} :a inc))"
"(= {:a 1 :b 1} (update {:a 1} :b (fnil inc 0)))"
# Regression: these run the analyzer's own second/map-pair path in compile mode.
"(= [:a 1] (first {:a 1}))"
"(= :a (key (first {:a 1})))"
"(= 1 (val (first {:a 1})))"
"(= 3 (let [[a b] [1 2]] (+ a b)))"
"(= 3 (loop [i 0 acc 0] (if (< i 3) (recur (inc i) (+ acc i)) acc)))"])
(defn- run-probes [ctx label]
(each prog probes
(def got (protect (eval-string ctx prog)))
(unless (and (got 0) (= (got 1) true))
(++ failures)
(printf "FAIL [%s] %s => %s" label prog
(if (got 0) (string/format "%q" (got 1)) (string "ERR:" (got 1)))))))
# Interpret mode: kernel tier interpreted, no analyzer involved.
(run-probes (init {}) "interpret")
# Compile mode: kernel tier bootstrap-compiled, analyzer built against it.
(def cctx (init {:compile? true}))
(run-probes cctx "compile")
# Fixpoint: rebuild the compiler against the current (Clojure-defined) core and
# re-run. A correct compiler recompiled on the language it just defined stays
# correct.
(backend/rebuild-compiler! cctx)
(run-probes cctx "compile+rebuilt")
(if (pos? failures)
(do (printf "staged-bootstrap: %d failure(s)" failures) (os/exit 1))
(print "staged-bootstrap: all probes passed (interpret, compile, compile+rebuilt)"))

View file

@ -5,6 +5,7 @@
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(use ../../src/jolt/evaluator)
(import ../../src/jolt/backend :as selfhost)
(defn- parse-forms [src]
(var s src) (def fs @[]) (var go true)
@ -19,8 +20,21 @@
(def path (get (dyn :args) 1))
(when path
(def ctx (init))
(each f (parse-forms (slurp "test/support/clojure_test.clj")) (eval-form ctx @{} f))
# JOLT_COMPILE=1 runs the suite through the compile path (hybrid: hot forms
# compile, unsupported forms fall back to the interpreter) so the whole battery
# validates compile-mode correctness against the same baseline.
(def compile? (= "1" (os/getenv "JOLT_COMPILE")))
# JOLT_SELFHOST=1 routes each form through the self-hosted pipeline (the
# portable Clojure analyzer + Janet back end, hybrid with interpreter fallback)
# so the whole battery validates the self-hosted compiler against the baseline.
(def selfhost? (= "1" (os/getenv "JOLT_SELFHOST")))
(def ctx (init (if compile? {:compile? true} {})))
(defn run-form [f]
(cond
selfhost? (selfhost/compile-and-eval ctx f)
compile? (eval-one ctx f)
(eval-form ctx @{} f)))
(each f (parse-forms (slurp "test/support/clojure_test.clj")) (run-form f))
# Pre-load the suite's own clojure.core-test.number-range helper ns if present
# (35 files require it for r/max-int, r/max-double, … — its :default branches are
@ -29,10 +43,10 @@
(let [dir (string/slice path 0 (- (length path) (length (last (string/split "/" path)))))
nr (string dir "number_range.cljc")]
(when (os/stat nr)
(each f (parse-forms (slurp nr)) (protect (eval-form ctx @{} f)))))
(each f (parse-forms (slurp nr)) (protect (run-form f)))))
(eval-string ctx "(clojure.test/reset-report!)")
(each form (parse-forms (slurp path)) (protect (eval-form ctx @{} form)))
(each form (parse-forms (slurp path)) (protect (run-form form)))
(protect (eval-string ctx "(clojure.test/run-registered)"))
(def p (eval-string ctx "(clojure.test/n-pass)"))
(def f (eval-string ctx "(clojure.test/n-fail)"))

View file

@ -44,6 +44,22 @@
["if-some zero" "1" "(if-some [x 0] (inc x) :none)"]
["when-some nil" "nil" "(when-some [x nil] x)"])
# Regression: if-let/when-let/if-some/when-some bind the name ONLY in the
# then/body branch. The else branch (and a falsy when-let body, which there is
# none of) must see the surrounding scope, not the binding — so the else of
# (let [x 5] (if-let [x nil] ...)) sees x=5, like Clojure. (Previously the macros
# wrapped the whole `if` in the binding's let*, leaking it into the else.)
(defspec "control / conditional-binding scope"
["if-let else sees outer" "5" "(let [x 5] (if-let [x nil] :then x))"]
["if-let then binds" "7" "(let [x 5] (if-let [x 7] x :else))"]
["if-some else sees outer" "5" "(let [x 5] (if-some [x nil] :then x))"]
["if-some binds false" "false" "(if-some [x false] x :else)"]
["when-let else via or" "5" "(let [x 5] (or (when-let [x nil] x) x))"]
["when-let multi-form body" "14" "(when-let [x 7] (inc x) (* x 2))"]
["if-let in fn param" "9" "((fn [xs] (if-let [xs nil] :then xs)) 9)"]
["when-some binds zero" "1" "(when-some [x 0] (inc x))"]
["if-let evals test once" "1" "(let [c (atom 0)] (if-let [v (do (swap! c inc) :v)] @c :none))"])
(defspec "control / iteration"
["dotimes side-effect" "5" "(let [a (atom 0)] (dotimes [i 5] (swap! a inc)) @a)"]
["while" "5" "(let [a (atom 0)] (while (< @a 5) (swap! a inc)) @a)"]
@ -52,8 +68,15 @@
["for :when" "[0 2 4]" "(for [x (range 6) :when (even? x)] x)"]
["for :while" "[0 1 2]" "(for [x (range 10) :while (< x 3)] x)"]
["for :let" "[0 1 4]" "(for [x (range 3) :let [sq (* x x)]] sq)"]
["for :let+:when" "[4 6 8]" "(for [x (range 5) :let [y (* x 2)] :when (> y 3)] y)"]
["for multi :when" "[[1 :a] [1 :b]]" "(for [x [0 1] :when (odd? x) y [:a :b]] [x y])"]
["for destructure" "[3 7]" "(for [[a b] [[1 2] [3 4]]] (+ a b))"]
["doseq side-effect" "6" "(let [a (atom 0)] (doseq [x [1 2 3]] (swap! a (fn [v] (+ v x)))) @a)"]
["doseq nested" "4" "(let [c (atom 0)] (doseq [x [1 2] y [10 20]] (swap! c inc)) @c)"])
["doseq nested" "4" "(let [c (atom 0)] (doseq [x [1 2] y [10 20]] (swap! c inc)) @c)"]
["doseq :when" "[1 3]" "(let [a (atom [])] (doseq [x [1 2 3] :when (odd? x)] (swap! a conj x)) @a)"]
["doseq :while" "6" "(let [a (atom 0)] (doseq [x (range 10) :while (< x 4)] (swap! a + x)) @a)"]
["doseq :let" "[0 1 4]" "(let [a (atom [])] (doseq [x (range 3) :let [sq (* x x)]] (swap! a conj sq)) @a)"]
["doseq returns nil" "nil" "(doseq [x [1 2 3]] x)"])
(defspec "control / threading"
["->" "6" "(-> 1 inc (+ 4))"]

View file

@ -35,7 +35,10 @@
[":strs" "7" "(let [{:strs [a]} {\"a\" 7}] a)"]
[":syms" "8" "(let [{:syms [a]} {(quote a) 8}] a)"]
["namespaced :keys" "3" "(let [{:keys [x/y]} {:x/y 3}] y)"]
["namespaced :syms" "4" "(let [{:syms [p/q]} {(quote p/q) 4}] q)"])
["namespaced :syms" "4" "(let [{:syms [p/q]} {(quote p/q) 4}] q)"]
# :keys also accepts keyword elements ({:keys [:a :b]}), binding bare locals.
["keyword :keys" "3" "(let [{:keys [:a :b]} {:a 1 :b 2}] (+ a b))"]
["keyword :keys ns" "3" "(let [{:keys [:x/y]} {:x/y 3}] y)"])
(defspec "destructure / keyword args (& {:keys})"
["fn kwargs" "[1 2]" "(do (defn f [& {:keys [a b]}] [a b]) (f :a 1 :b 2))"]
@ -43,6 +46,15 @@
["fn kwargs :or" "9" "(do (defn h [& {:keys [a] :or {a 9}}] a) (h))"]
["fn kwargs trailing map" "7" "(do (defn k [& {:keys [a]}] a) (k {:a 7}))"])
(defspec "destructure / fn params & loop"
["fn vector param" "7" "((fn [[a b]] (+ a b)) [3 4])"]
["fn map param" "30" "((fn [{:keys [x y]}] (* x y)) {:x 5 :y 6})"]
["fn :or param" "7" "((fn [{:keys [x] :or {x 7}}] x) {})"]
["fn multi-arity destr" "15" "((fn ([[a]] a) ([[a] b] (+ a b))) [10] 5)"]
["loop vector binding" "[4 2]" "(loop [[a b] [1 2] n 0] (if (< n 3) (recur [(inc a) b] (inc n)) [a b]))"]
["loop map binding" "4" "(loop [{:keys [v]} {:v 1} n 0] (if (< n 2) (recur {:v (* v 2)} (inc n)) v))"]
["loop init sees destr" "[1 2 3]" "(loop [[a b] [1 2] c (+ a b)] [a b c])"])
(defspec "destructure / macro params"
["macro & [a & more :as all]"
"[1 [2 3] [1 2 3]]"

View file

@ -35,4 +35,7 @@
["catch binds thrown value" "42"
"(try (throw 42) (catch :default e e))"]
["rethrow preserves ex" "\"inner\""
"(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"])
"(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"]
["ex-data on non-ex" "nil" "(ex-data 42)"]
["ex-cause on non-ex" "nil" "(ex-cause {:k 1})"]
["ex-message of string" "\"hi\"" "(ex-message \"hi\")"])

View file

@ -31,3 +31,10 @@
["janet-type string" ":string" "(do (require (quote [jolt.interop :as j])) (j/janet-type \"x\"))"]
["janet-type number" ":number" "(do (require (quote [jolt.interop :as j])) (j/janet-type 1))"]
["janet-type keyword" ":keyword" "(do (require (quote [jolt.interop :as j])) (j/janet-type :a))"])
(defspec "interop / arrays (aget/aset/alength)"
["alength" "3" "(alength (object-array [1 2 3]))"]
["aget" "20" "(aget (object-array [10 20 30]) 1)"]
["aset returns val" "9" "(aset (object-array [1 2 3]) 1 9)"]
["aset mutates" "[7 2 3]" "(let [a (object-array [1 2 3])] (aset a 0 7) (vec a))"]
["aget 2d" "4" "(aget (to-array-2d [[1 2] [3 4]]) 1 1)"])

View file

@ -25,3 +25,50 @@
"(= (gensym) (gensym))"]
["gensym# in template" "true"
"(do (defmacro m [] `(let [x# 1] x#)) (= 1 (m)))"])
# Core macros ported from Janet to the Clojure overlay (jolt-1j0 phase 3,
# jolt-core/clojure/core/30-macros.clj).
(defspec "macros / core-overlay"
["if-not true branch" ":then" "(if-not false :then :else)"]
["if-not else branch" ":else" "(if-not true :then :else)"]
["if-not no else" "nil" "(if-not true :then)"]
["if-not no else hit" ":then" "(if-not false :then)"]
["comment -> nil" "nil" "(comment a b c)"]
["comment in do" "42" "(do (comment ignored) 42)"]
["if-let then" "6" "(if-let [x 5] (inc x) :none)"]
["if-let else" ":none" "(if-let [x nil] (inc x) :none)"]
["if-let else scope" "9" "(let [x 9] (if-let [x nil] :t x))"]
["if-some zero" "1" "(if-some [x 0] (inc x) :none)"]
["if-some nil" ":none" "(if-some [x nil] x :none)"]
["when-some multi" "14" "(when-some [x 7] (inc x) (* x 2))"]
["when-some nil" "nil" "(when-some [x nil] x)"]
["while loop" "3" "(let [a (atom 0)] (while (< @a 3) (swap! a inc)) @a)"]
["dotimes sum" "10" "(let [a (atom 0)] (dotimes [i 5] (swap! a + i)) @a)"]
["as-> threads" "12" "(as-> 5 x (+ x 1) (* x 2))"]
["as-> no forms" "5" "(as-> 5 x)"]
["some-> through" "6" "(some-> {:a {:b 5}} :a :b inc)"]
["some-> short-circuit" "nil" "(some-> {:a nil} :a :b)"]
["some->> through" "9" "(some->> [1 2 3] (map inc) (reduce +))"]
["some->> nil" "nil" "(some->> nil (map inc))"]
["doto returns obj" "[1 2]" "(deref (doto (atom []) (swap! conj 1) (swap! conj 2)))"]
["when-first" "20" "(when-first [x [10 20 30]] (* x 2))"]
["when-first empty" "nil" "(when-first [x []] :body)"]
["when-first nil coll" "nil" "(when-first [x nil] :body)"]
["when-first range" "0" "(when-first [x (range 5)] x)"]
["cond->> threads" "12" "(cond->> 5 true (+ 1) false (* 100) true (* 2))"]
["cond->> skip" "10" "(cond->> 10 false (+ 1))"]
["assert pass" ":ok" "(do (assert (= 1 1)) :ok)"]
["assert throws" ":threw" "(try (assert (= 1 2)) (catch :default e :threw))"]
["assert message" "\"nope\"" "(try (assert false \"nope\") (catch :default e (ex-message e)))"]
["delay value" "42" "(deref (delay 42))"]
["delay forces once" "1" "(let [c (atom 0) d (delay (swap! c inc))] @d @d @c)"]
["future deref" "9" "(deref (future (* 3 3)))"]
["letfn simple" "25" "(letfn [(sq [x] (* x x))] (sq 5))"]
["letfn mutual" "true" "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 8))"]
["condp match" ":two" "(condp = 2 1 :one 2 :two 3 :three)"]
["condp default" ":else" "(condp = 9 1 :one 2 :two :else)"]
["condp :>> form" "\"got 2\"" "(condp some [1 2 3] #{0 9} :>> (fn [x] (str \"got \" x)) #{2 6} :>> (fn [x] (str \"got \" x)))"]
["condp no match" ":threw" "(try (condp = 9 1 :one) (catch :default e :threw))"]
["binding rebinds" "99" "(do (def ^:dynamic *bx* 10) (binding [*bx* 99] *bx*))"]
["binding restores" "10" "(do (def ^:dynamic *by* 10) (binding [*by* 99] *by*) *by*)"]
["binding seen by fn" "7" "(do (def ^:dynamic *bz* 0) (defn rdz [] *bz*) (binding [*bz* 7] (rdz)))"])

View file

@ -115,3 +115,32 @@
["subvec float trunc" "[0]" "(subvec [0 1 2] 0.5 1.33)"]
["subvec NaN start" "[0 1 2]" "(subvec [0 1 2] ##NaN 3)"]
["subvec NaN end" "[]" "(subvec [0 1 2] 0 ##NaN)"])
# A nil value is a PRESENT key in Clojure (distinct from a missing key); Janet
# structs drop nil, so jolt builds these maps as a phm. Tested via literals (the
# reader path) and the construction/op surface, in every spec mode.
(defspec "map / nil values preserved"
["literal contains" "true" "(contains? {:b nil} :b)"]
["literal not= empty" "false" "(= {:b nil} {})"]
["literal get nil" "nil" "(get {:b nil} :b :x)"]
["literal keys incl nil" "true" "(= #{:a :b} (set (keys {:a nil :b 1})))"]
["literal count" "2" "(count {:a nil :b 1})"]
["literal vals incl nil" "2" "(count (vals {:a nil :b 1}))"]
["eval values w/ nil" "3" "(:a {:a (+ 1 2) :b nil})"]
["nil key present" "true" "(contains? {nil :v} nil)"]
["assoc nil present" "true" "(contains? (assoc {:a 1} :b nil) :b)"]
["assoc nil get" "nil" "(get (assoc {:a 1} :b nil) :b :x)"]
["assoc overwrite nil" "nil" "(get (assoc {:a 1} :a nil) :a :x)"]
["hash-map nil" "true" "(contains? (hash-map :b nil) :b)"]
["merge new nil" "true" "(contains? (merge {:a 1} {:b nil}) :b)"]
["merge overwrite nil" "nil" "(get (merge {:a 1} {:a nil}) :a :x)"]
["merge-with present nil" "true" "(= [nil 1] (get (merge-with (fn [a b] [a b]) {:a nil} {:a 1}) :a))"]
["into nil val" "true" "(contains? (into {} [[:a nil]]) :a)"]
["conj map nil" "true" "(contains? (conj {:x 1} {:a nil}) :a)"]
["zipmap nil" "true" "(contains? (zipmap [:a] [nil]) :a)"]
["select-keys nil" "true" "(contains? (select-keys {:a nil} [:a]) :a)"]
["get-in present nil" "nil" "(get-in {:a nil} [:a] :x)"]
["get-in through nil" ":x" "(get-in {:a nil} [:a :b] :x)"]
["dissoc keeps nil" "true" "(contains? (dissoc {:a nil :b 1} :b) :a)"]
["reduce-kv sees nil" "true" "(= #{:a :b} (reduce-kv (fn [acc k v] (conj acc k)) #{} {:a nil :b 2}))"]
["nil-free stays fast" "true" "(= {:a 1 :b 2} {:b 2 :a 1})"])

View file

@ -7,8 +7,10 @@
["with-meta preserves value" "true" "(= [1 2 3] (with-meta [1 2 3] {:a 1}))"]
["with-meta on map" "{:doc \"x\"}" "(meta (with-meta {:k 1} {:doc \"x\"}))"]
["vary-meta" "{:a 2}" "(meta (vary-meta (with-meta [1] {:a 1}) update :a inc))"]
["vary-meta extra args" "{:a 1 :b 2}" "(meta (vary-meta (with-meta [1] {:a 1}) assoc :b 2))"]
["meta reader ^" "{:tag :int}" "(meta ^{:tag :int} [1 2])"]
["with-meta on fn ok" "true" "(fn? (with-meta inc {:a 1}))"])
["with-meta on fn ok" "true" "(fn? (with-meta inc {:a 1}))"]
["with-meta nil clears" "nil" "(meta (with-meta [1 2 3] nil))"])
(defspec "metadata / type hints"
# ^Type / ^:kw / ^"str" on a symbol attach as metadata and are otherwise inert:

View file

@ -59,6 +59,50 @@
["symbol constructor" "(quote x)" "(symbol \"x\")"]
["name of string" "\"s\"" "(name \"s\")"])
# Predicates moved from Janet to the Clojure overlay (jolt-1j0). Jolt has no
# ratio/bigdecimal types (so ratio?/decimal? are always false, rational?=int?),
# and no distinct host object/undefined types (object?/undefined? always false).
(defspec "predicates / overlay-migrated"
["not-any? true" "true" "(not-any? even? [1 3 5])"]
["not-any? false" "false" "(not-any? even? [1 2 3])"]
["not-every? true" "true" "(not-every? even? [2 4 5])"]
["not-every? false" "false" "(not-every? even? [2 4 6])"]
["ident? number" "false" "(ident? 1)"]
["qualified-ident?" "true" "(qualified-ident? :a/b)"]
["qualified-ident? no" "false" "(qualified-ident? :a)"]
["simple-ident?" "true" "(simple-ident? :a)"]
["ratio?" "false" "(ratio? 3)"]
["decimal?" "false" "(decimal? 3)"]
["rational? int" "true" "(rational? 3)"]
["rational? float" "false" "(rational? 3.5)"]
["nat-int? zero" "true" "(nat-int? 0)"]
["nat-int? neg" "false" "(nat-int? -1)"]
["pos-int?" "true" "(pos-int? 5)"]
["neg-int?" "true" "(neg-int? -3)"]
["NaN? on nan" "true" "(NaN? (/ 0.0 0.0))"]
["NaN? on number" "false" "(NaN? 5)"]
["abs negative" "3" "(abs -3)"]
["abs positive" "2.5" "(abs 2.5)"]
["object?" "false" "(object? 1)"]
["undefined?" "false" "(undefined? 1)"]
["keyword-identical?" "true" "(keyword-identical? :a :a)"]
["keyword-identical? no" "false" "(keyword-identical? :a :b)"])
# Tagged-value predicates moved to the overlay in Phase 4 (read the value's
# :jolt/type via get). The constructors stay native.
(defspec "predicates / tagged-value (Phase 4)"
["atom? yes" "true" "(atom? (atom 1))"]
["atom? no" "false" "(atom? 1)"]
["volatile? yes" "true" "(volatile? (volatile! 1))"]
["volatile? no" "false" "(volatile? (atom 1))"]
["record? yes" "true" "(do (defrecord Rp [a]) (record? (->Rp 1)))"]
["record? no map" "false" "(record? {:a 1})"]
["record? no nil" "false" "(record? nil)"]
["tagged-literal? yes" "true" "(tagged-literal? (tagged-literal (quote inst) \"2020\"))"]
["tagged-literal? no" "false" "(tagged-literal? 1)"]
["reader-conditional? no" "false" "(reader-conditional? 1)"]
["chunked-seq? always false" "false" "(chunked-seq? (seq [1 2 3]))"])
(defspec "predicates / equality & identity"
["= same" "true" "(= 1 1)"]
["= vectors" "true" "(= [1 2] [1 2])"]

View file

@ -43,6 +43,14 @@
["map" "[2 3 4]" "(map inc [1 2 3])"]
["map two colls" "[5 7 9]" "(map + [1 2 3] [4 5 6])"]
["map stops at shortest" "[5 7]" "(map + [1 2] [4 5 6])"]
# nil elements are values, not end-of-seq: multi-coll map must not truncate.
["map keeps nil elements" "[[1 :a] [nil :b] [3 nil]]" "(map vector [1 nil 3] [:a :b nil])"]
["map 3 colls" "[12 15 18]" "(map + [1 2 3] [4 5 6] [7 8 9])"]
["map 3 colls shortest" "[12 15]" "(map + [1 2] [4 5 6] [7 8 9])"]
["map 4 colls" "[16 20]" "(map + [1 2] [3 4] [5 6] [7 8])"]
["map 3 colls nils" "[[1 :a 10] [nil :b 20] [3 nil 30]]" "(map vector [1 nil 3] [:a :b nil] [10 20 30])"]
["map empty coll" "()" "(map + [] [1 2 3] [4 5 6])"]
["map lazy+concrete" "[11 22 33]" "(map + (map identity [1 2 3]) [10 20 30])"]
["map-indexed" "[[0 :a] [1 :b]]" "(map-indexed vector [:a :b])"]
["mapv" "[2 3 4]" "(mapv inc [1 2 3])"]
["filter" "[2 4]" "(filter even? [1 2 3 4])"]
@ -54,8 +62,15 @@
["reduce single no init" "5" "(reduce + [5])"]
["reduced short-circuits" "3" "(reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 [1 2 3 4 5])"]
["reduce-kv" "6" "(reduce-kv (fn [a k v] (+ a v)) 0 {:a 1 :b 2 :c 3})"]
["reduce-kv on vector" "[[0 :a] [1 :b]]" "(reduce-kv (fn [a i v] (conj a [i v])) [] [:a :b])"]
["reduce-kv honors reduced" "[:a]" "(reduce-kv (fn [a i v] (if (= i 1) (reduced a) (conj a v))) [] [:a :b :c])"]
["reduce-kv on nil" "0" "(reduce-kv (fn [a k v] (+ a v)) 0 nil)"]
["reductions" "[1 3 6]" "(reductions + [1 2 3])"]
["mapcat" "[1 1 2 2]" "(mapcat (fn [x] [x x]) [1 2])"]
["mapcat two colls" "[1 3 2 4]" "(mapcat vector [1 2] [3 4])"]
["mapcat three colls" "[1 2 3]" "(mapcat vector [1] [2] [3])"]
["mapcat empty coll" "()" "(mapcat vector [] [1 2] [3 4])"]
["mapcat seqs" "[1 2 3 4]" "(mapcat identity [[1 2] [3 4]])"]
["keep" "[1 3]" "(keep (fn [x] (if (odd? x) x nil)) [1 2 3 4])"]
["some truthy" "true" "(some even? [1 2 3])"]
["some nil" "nil" "(some even? [1 3 5])"]
@ -197,3 +212,52 @@
["nthnext nil count" :throws "(nthnext [0 1 2] nil)"]
["update vec oob" :throws "(update [] 1 identity)"]
["update vec kw key" :throws "(update [1 2 3] :k identity)"])
# Regression cases for clojure.core fns moved from Janet to the Clojure overlay
# (jolt-1j0), plus two bugs fixed in the process: nthrest returns () (not nil)
# for an exhausted n>0 walk, and distinct? compares by VALUE (equal collections
# are not distinct).
(defspec "seq / overlay-migrated fns"
["nthrest exhausted -> ()" "()" "(nthrest nil 100)"]
["nthrest vec exhausted" "()" "(nthrest [1 2 3] 100)"]
["nthrest n<=0 keeps coll" "[1 2 3]" "(nthrest [1 2 3] 0)"]
["nthrest drops n" "[3 4 5]" "(nthrest [1 2 3 4 5] 2)"]
["nthnext exhausted -> nil" "nil" "(nthnext [1 2] 5)"]
["nthnext surprising nil" "nil" "(nthnext nil nil)"]
["nthnext drops n" "[3 4]" "(nthnext [1 2 3 4] 2)"]
["distinct? distinct" "true" "(distinct? 1 2 3)"]
["distinct? dup" "false" "(distinct? 1 2 1)"]
["distinct? equal colls" "false" "(distinct? [1 2] [1 2])"]
["distinct? single" "true" "(distinct? 5)"]
["replace maps elements" "[:a 2 :c 2]" "(replace {1 :a 3 :c} [1 2 3 2])"]
["replace preserves nil val" "[1 nil 3]" "(replace {2 nil} [1 2 3])"]
["take-last" "[3 4]" "(take-last 2 [1 2 3 4])"]
["take-last empty -> nil" "nil" "(take-last 2 [])"]
["take-last n>len" "[1 2]" "(take-last 9 [1 2])"]
["drop-last default 1" "[1 2]" "(drop-last [1 2 3])"]
["drop-last n" "[1 2]" "(drop-last 2 [1 2 3 4])"]
["split-with" "[[2 4] [5 6]]" "(split-with even? [2 4 5 6])"]
["replicate" "[:x :x :x]" "(replicate 3 :x)"]
["bounded-count" "3" "(bounded-count 3 [1 2 3 4 5])"]
["run! side effects" "6" "(let [a (atom 0)] (run! (fn [x] (swap! a + x)) [1 2 3]) @a)"]
["completing wraps rf" "3" "((completing +) 1 2)"]
["comparator <" "[1 2 3]" "(sort (comparator <) [3 1 2])"]
["comparator >" "[3 2 1]" "(sort (comparator >) [3 1 2])"]
["reductions" "[1 3 6 10]" "(reductions + [1 2 3 4])"]
["reductions with init" "[10 11 13 16]" "(reductions + 10 [1 2 3])"]
["reductions empty calls f" "[0]" "(reductions + [])"]
["reductions empty + init" "[5]" "(reductions + 5 [])"]
["tree-seq pre-order" "[[1 [2] 3] 1 [2] 2 3]" "(tree-seq sequential? seq [1 [2] 3])"]
["some found" "true" "(some even? [1 3 4])"]
["some none -> nil" "nil" "(some even? [1 3 5])"]
["some keyword pred" "7" "(some :a [{:b 1} {:a 7}])"]
["some returns value" "4" "(some (fn [x] (when (even? x) x)) [1 3 4 5])"]
["flatten nested" "[1 2 3 4 5]" "(flatten [1 [2 [3 4]] 5])"]
["flatten lists too" "[1 2 3]" "(flatten [1 (list 2 3)])"]
["flatten scalar -> empty" "[]" "(flatten 5)"]
["interleave" "[1 :a 2 :b]" "(interleave [1 2 3] [:a :b])"]
["interleave empty" "[]" "(interleave)"]
["rationalize identity" "5" "(rationalize 5)"]
["dedupe consecutive" "[1 2 3 1]" "(dedupe [1 1 2 2 3 1 1])"]
["dedupe empty" "[]" "(dedupe [])"]
["dedupe no dups" "[1 2 3]" "(dedupe [1 2 3])"])

View file

@ -48,3 +48,8 @@
["subs end past len" :throws "(subs \"abcde\" 1 6)"]
["subs nil start" :throws "(subs \"abcde\" nil 2)"]
["subs on nil" :throws "(subs nil 1 2)"])
(defspec "string / namespace-munge"
["hyphens to underscores" "\"a_b_c\"" "(namespace-munge \"a-b-c\")"]
["from a symbol" "\"foo_bar\"" "(namespace-munge (quote foo-bar))"]
["no hyphens unchanged" "\"ok\"" "(namespace-munge \"ok\")"])

View file

@ -24,7 +24,12 @@
["count" "3" "(count [1 2 3])"]
["contains? index" "true" "(contains? [:a :b] 1)"]
["contains? past end" "false" "(contains? [:a] 3)"]
["vector as fn" ":b" "([:a :b :c] 1)"])
["vector as fn" ":b" "([:a :b :c] 1)"]
# An IFn collection held in a binding (not just a literal) must dispatch as IFn,
# not as a host call: applies to vectors, keywords, and meta-bearing vectors.
["vector-in-local as fn" "20" "(let [v [10 20 30]] (v 1))"]
["keyword-in-local as fn" "7" "(let [k :a] (k {:a 7}))"]
["meta vector as fn" "10" "((with-meta [10 20] {:k 1}) 0)"])
(defspec "vector / update (persistent)"
["conj appends" "[1 2 3]" "(conj [1 2] 3)"]

View file

@ -0,0 +1,16 @@
# Worker: evaluate a Clojure equality check in a fresh Jolt ctx and print
# @@RESULT true or @@RESULT false. Used by lazy-infinite-test under a wall-clock
# deadline so infinite-seq hangs are caught as test failures.
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(def expected (get (dyn :args) 1))
(def actual (get (dyn :args) 2))
(when (and expected actual)
(def ctx (init {}))
(def prog (string "(= " expected " " actual ")"))
(def [ok val] (protect (eval-string ctx prog)))
(if ok
(printf "@@RESULT %q" val)
(printf "@@ERROR %q" val)))

View file

@ -40,6 +40,21 @@
(assert (deep= {:name 'x :private true} (var-meta v2)) "with-meta merges meta")
(assert (= 42 (var-get v2)) "with-meta preserves root binding"))
# generation counter — bumps on every root change (substrate for direct-link
# staleness detection and redefinition-aware dispatch caches)
(let [v (make-var 'g 1)]
(assert (= 0 (v :gen)) "fresh var starts at generation 0")
(bind-root v 2)
(assert (= 1 (v :gen)) "bind-root bumps generation")
(var-set v 3)
(assert (= 2 (v :gen)) "var-set (root) bumps generation")
(alter-var-root v inc)
(assert (= 3 (v :gen)) "alter-var-root bumps generation")
(assert (= 4 (var-get v)) "value still tracks through gen bumps"))
(let [v (make-var 'g 1)
v2 (with-meta v {:doc "x"})]
(assert (= (v :gen) (v2 :gen)) "with-meta carries generation"))
# var with namespace
(let [ns (make-ns 'my.ns)
v (make-var 'my.ns/x 1 {:ns ns})]

1
vendor/clojure-test-suite vendored Submodule

@ -0,0 +1 @@
Subproject commit e20ea0289e57fe5c8b78e66865176bb7af42939d