diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000..f10092a Binary files /dev/null and b/.DS_Store differ diff --git a/.calva/repl.calva-repl b/.calva/repl.calva-repl new file mode 100644 index 0000000..f586a0b --- /dev/null +++ b/.calva/repl.calva-repl @@ -0,0 +1,43 @@ +(when-let [requires (resolve 'clojure.main/repl-requires)] (clojure.core/apply clojure.core/require @requires)) +clj꞉user꞉>  +(defn read + [reader] + (let [line ((get (dyn :current-env) (symbol "file/read")) reader :line)] + (when line + (read-string line)))) +clj꞉user꞉>  +(defn foo []) +clj꞉user꞉>  +(foo) +clj꞉user꞉>  +(defn foo [x] + (into (range 10) [x])) +clj꞉user꞉>  +(foo) +; expected integer key for tuple in range [0, 0), got 0 +clj꞉user꞉>  +(foo 10) +clj꞉user꞉>  +(foo "a") +clj꞉user꞉>  +(foo :a) +clj꞉user꞉>  +(sh "ls") +; Unable to resolve symbol: sh +clj꞉user꞉>  +(jolt/sh "ls") +; Unable to resolve symbol: jolt/sh +clj꞉user꞉>  +(defn sh + [& args] + (let [cmd (apply str (interpose " " args)) + result (os/shell cmd)] + {:exit (result 0) :out (result 1) :err (result 2)})) +clj꞉user꞉>  +(defn shell + [& args] + (:out (apply sh args))) +clj꞉user꞉>  +(sh "ls") +; Unable to resolve symbol: os/shell +clj꞉user꞉>  diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml index c4986fc..0e712bc 100644 --- a/.github/workflows/tests.yml +++ b/.github/workflows/tests.yml @@ -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 diff --git a/.gitmodules b/.gitmodules index b878f26..959062d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -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 diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..bc2ae10 --- /dev/null +++ b/AGENTS.md @@ -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 # View issue details +bd update --claim # Claim work atomically +bd close # 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 + + +## 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 # View issue details +bd update --claim # Claim work +bd close # 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 + diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..cd553b9 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,70 @@ +# Project Instructions for AI Agents + +This file provides instructions and context for AI coding agents working on this project. + + +## 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 # View issue details +bd update --claim # Claim work +bd close # 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 + + + +## 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_ diff --git a/HANDOFF.md b/HANDOFF.md new file mode 100644 index 0000000..1b45044 --- /dev/null +++ b/HANDOFF.md @@ -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-` 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 + `, `bd create`, `bd update --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). diff --git a/README.md b/README.md index fa4adbb..22e1d32 100644 --- a/README.md +++ b/README.md @@ -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 diff --git a/doc/self-hosting-architecture.md b/doc/self-hosting-architecture.md new file mode 100644 index 0000000..e208b87 --- /dev/null +++ b/doc/self-hosting-architecture.md @@ -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." diff --git a/doc/self-hosting-compiler.md b/doc/self-hosting-compiler.md new file mode 100644 index 0000000..05d9ada --- /dev/null +++ b/doc/self-hosting-compiler.md @@ -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 3–4 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. diff --git a/jolt-core/clojure/core/00-kernel.clj b/jolt-core/clojure/core/00-kernel.clj new file mode 100644 index 0000000..93a16e4 --- /dev/null +++ b/jolt-core/clojure/core/00-kernel.clj @@ -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))) diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj new file mode 100644 index 0000000..aeb33f2 --- /dev/null +++ b/jolt-core/clojure/core/00-syntax.clj @@ -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))) diff --git a/jolt-core/clojure/core/10-seq.clj b/jolt-core/clojure/core/10-seq.clj new file mode 100644 index 0000000..9418b07 --- /dev/null +++ b/jolt-core/clojure/core/10-seq.clj @@ -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)))) \ No newline at end of file diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj new file mode 100644 index 0000000..ace99b4 --- /dev/null +++ b/jolt-core/clojure/core/20-coll.clj @@ -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)) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj new file mode 100644 index 0000000..1379e63 --- /dev/null +++ b/jolt-core/clojure/core/30-macros.clj @@ -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). diff --git a/jolt-core/clojure/core/40-lazy.clj b/jolt-core/clojure/core/40-lazy.clj new file mode 100644 index 0000000..4b981b7 --- /dev/null +++ b/jolt-core/clojure/core/40-lazy.clj @@ -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))))))) diff --git a/jolt-core/clojure/core/MIGRATION.md b/jolt-core/clojure/core/MIGRATION.md new file mode 100644 index 0000000..ef14f59 --- /dev/null +++ b/jolt-core/clojure/core/MIGRATION.md @@ -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). diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj new file mode 100644 index 0000000..d5d016d --- /dev/null +++ b/jolt-core/jolt/analyzer.clj @@ -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")))) diff --git a/jolt-core/jolt/ir.clj b/jolt-core/jolt/ir.clj new file mode 100644 index 0000000..af34cdb --- /dev/null +++ b/jolt-core/jolt/ir.clj @@ -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)) diff --git a/phase-5.md b/phase-5.md new file mode 100644 index 0000000..1c117c2 --- /dev/null +++ b/phase-5.md @@ -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 ~21–143. + +**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 diff --git a/src/jolt/aot.janet b/src/jolt/aot.janet new file mode 100644 index 0000000..0626a2e --- /dev/null +++ b/src/jolt/aot.janet @@ -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))) diff --git a/src/jolt/api.janet b/src/jolt/api.janet index 8f568ae..e3af642 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -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. diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet new file mode 100644 index 0000000..d1d1961 --- /dev/null +++ b/src/jolt/backend.janet @@ -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))))) diff --git a/src/jolt/clojure/data.clj b/src/jolt/clojure/data.clj new file mode 100644 index 0000000..b8ec180 --- /dev/null +++ b/src/jolt/clojure/data.clj @@ -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)))) diff --git a/src/jolt/clojure/edn.clj b/src/jolt/clojure/edn.clj index 505765e..ea271b3 100644 --- a/src/jolt/clojure/edn.clj +++ b/src/jolt/clojure/edn.clj @@ -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)))) diff --git a/src/jolt/clojure/set.clj b/src/jolt/clojure/set.clj index f480754..e9ad98a 100644 --- a/src/jolt/clojure/set.clj +++ b/src/jolt/clojure/set.clj @@ -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] diff --git a/src/jolt/clojure/zip.clj b/src/jolt/clojure/zip.clj index 528c4c8..914c90c 100644 --- a/src/jolt/clojure/zip.clj +++ b/src/jolt/clojure/zip.clj @@ -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)))))) diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index 3a3babe..d700472 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -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))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index ebf6b90..4301997 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -64,6 +64,35 @@ k))) (set-canonicalize-key! canon-key) +# All [k v] entries of a map (struct or phm), nil-valued keys included. Use this +# instead of (keys (phm-to-struct m)) — phm-to-struct drops keys whose value is +# nil, which is exactly what Clojure maps must keep. +(defn- map-entries-of [m] + (if (phm? m) (phm-entries m) (map (fn [k] [k (in m k)]) (keys m)))) + +# assoc one entry onto a map value (struct or phm), preserving a nil key/value and +# value-comparing collection keys (promotes a struct to a phm when needed). A +# single-entry core-assoc usable by fns defined before core-assoc itself. +(defn- map-assoc1 [m k v] + (cond + (phm? m) (phm-assoc m k v) + (or (nil? k) (nil? v) (table? k) (array? k)) + (do (var p (make-phm)) (each ek (keys m) (set p (phm-assoc p ek (in m ek)))) (phm-assoc p k v)) + (do (def t (merge @{} m)) (put t k v) (table/to-struct t)))) + +# Build a map from a flat [k v k v ...] array: a phm when any key/value is nil or +# a key is a collection (value hashing); a struct otherwise. One O(n) pass. +(defn- kvs->map [kvs] + (var need-phm false) (var i 0) + (while (< i (length kvs)) + (let [k (in kvs i) v (in kvs (+ i 1))] + (when (or (nil? k) (nil? v) (table? k) (array? k)) (set need-phm true))) + (+= i 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 realize-for-iteration [c] "Normalize a seqable to a Janet array/tuple for iteration: pvec -> array, set -> seq, lazy-seq -> realized array; others pass through. Warning: will @@ -95,6 +124,26 @@ items) c)) +# Syntax-quote form builders. The syntax-quote lowering (evaluator) emits calls to +# these so a `(...)/`[...] body is plain compilable code instead of an interpreted +# special form. A list FORM is a Janet array, a vector FORM a tuple (the reader's +# representation), so these build those types. Each concat part is either a 1-elem +# wrap (__sq1, a non-spliced item) or a spliced seq (~@), flattened in order. +(defn core-sq1 [x] @[x]) + +(defn core-sqcat [& parts] + (def r @[]) + (each p parts (each x (realize-for-iteration p) (array/push r x))) + r) + +(defn core-sqvec [& parts] + (def r @[]) + (each p parts (each x (realize-for-iteration p) (array/push r x))) + (tuple/slice r)) + +# Map builder: parts are alternating k v (no splicing in map syntax-quote). +(defn core-sqmap [& parts] (kvs->map (array ;parts))) + # ============================================================ # Predicates # ============================================================ @@ -147,15 +196,35 @@ (if (phm? coll) (= 0 (coll :cnt)) (if (pvec? coll) (= 0 (pv-count coll)) (if (plist? coll) (pl-empty? coll) - (if (lazy-seq? coll) (nil? (ls-first coll)) + # Cell-based, NOT (nil? (ls-first)): a lazy-seq whose first element is + # legitimately nil (e.g. a `nil` case-constant) is non-empty. + (if (lazy-seq? coll) + (let [cell (realize-ls coll)] + (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))) (if (struct? coll) (= 0 (length (keys coll))) (= 0 (length coll)))))))))) (defn core-every? [pred coll] - (var result true) - (each x (realize-for-iteration coll) - (if (not (pred x)) (do (set result false) (break)))) - result) + # Short-circuit on the first false — and pull lazily so an infinite seq with an + # early false (e.g. (every? pos? (range))) returns rather than hanging. Walks + # cells via realize-ls directly (core-first/lazy-from are defined later). + (if (lazy-seq? coll) + (do + (var cur coll) (var result true) (var go true) + (while (and result go) + (let [cell (realize-ls cur)] + (if (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell))) + (set go false) + (if (pred (in cell 0)) + (let [rt (in cell 1)] + (if (nil? rt) (set go false) (set cur (make-lazy-seq rt)))) + (set result false))))) + result) + (do + (var result true) + (each x (realize-for-iteration coll) + (if (not (pred x)) (do (set result false) (break)))) + result))) # ============================================================ # Math — Clojure semantics (variadic, / with one arg = reciprocal) @@ -194,7 +263,6 @@ (defn core-max [& args] (each x args (need-num x "max")) (apply max args)) (defn core-min [& args] (each x args (need-num x "min")) (apply min args)) -(defn core-abs [x] (if (neg? x) (- 0 x) x)) (defn core-rand [] (math/random)) (defn core-rand-int [n] (math/floor (* (math/random) n))) @@ -329,16 +397,17 @@ (each x xs (if (map-value? x) # conj a map -> merge its entries - (each k (if (phm? x) (keys (phm-to-struct x)) (keys x)) - (set result (phm-assoc result k (if (phm? x) (phm-get x k) (in x k))))) + (each e (map-entries-of x) + (set result (phm-assoc result (in e 0) (in e 1)))) (set result (phm-assoc result (vnth x 0) (vnth x 1))))) result) (do (var result coll) (each x xs (if (map-value? x) - (set result (merge result (if (phm? x) (phm-to-struct x) x))) - (set result (merge result {(vnth x 0) (vnth x 1)})))) + (each e (map-entries-of x) + (set result (map-assoc1 result (in e 0) (in e 1)))) + (set result (map-assoc1 result (vnth x 0) (vnth x 1))))) result))))))))))) (defn core-assoc [m & kvs] @@ -370,11 +439,14 @@ (if (= idx (length result)) (array/push result v) (put result idx v))) (+= i 2)) (if (tuple? m) (tuple/slice (tuple ;result)) result)) - # map (struct/table). If any key is a collection, a Janet struct/table keys - # it by identity — promote to a phm so such keys compare by value. + # map (struct/table). Promote to a phm when any new key is a collection (a + # Janet struct/table would key it by identity) or any new key/value is nil (a + # struct drops nil; phm preserves it, matching Clojure). m itself is a struct + # here (phm handled above), so only the new kvs can introduce these. (let [coll-key (do (var c false) (var i 0) (while (< i (length kvs)) - (when (let [k (in kvs i)] (or (table? k) (array? k))) (set c true)) + (let [k (in kvs i) v (in kvs (+ i 1))] + (when (or (table? k) (array? k) (nil? k) (nil? v)) (set c true))) (+= i 2)) c)] (if coll-key (do (var result (make-phm)) @@ -457,13 +529,17 @@ (defn core-get-in [m ks &opt default] (default default nil) (def ks (vview ks)) + # Walk with a fresh sentinel so a PRESENT key whose value is nil is distinguished + # from a missing key: only a genuinely-absent step falls back to default. + (def absent @{}) (var current m) (var i 0) + (var missing false) (while (< i (length ks)) - (if (nil? current) (break)) - (set current (core-get current (ks i))) + (let [nxt (core-get current (ks i) absent)] + (if (= nxt absent) (do (set missing true) (break)) (set current nxt))) (++ i)) - (if (nil? current) default current)) + (if missing default current)) (defn core-contains? [coll key] (if (core-transient? coll) @@ -544,9 +620,19 @@ (= 0 (length coll)) nil (in coll 0))) +(defn- seq-done? + "True when cursor c (a lazy-seq or a concrete collection) is exhausted. + Uses cell realization for lazy-seqs so nil elements don't end the seq early." + [c] + (if (lazy-seq? c) + (let [cell (realize-ls c)] + (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))) + (or (nil? c) (= 0 (length c))))) + (defn core-rest [coll] (cond - (lazy-seq? coll) (ls-rest coll) + # rest never returns nil — Clojure's rest yields () on an exhausted seq. + (lazy-seq? coll) (let [r (ls-rest coll)] (if (nil? r) @[] r)) (plist? coll) (pl-rest coll) (pvec? coll) (let [a (pv->array coll)] (if (<= (length a) 1) @[] (array/slice a 1))) (or (nil? coll) (= 0 (length coll))) @[] @@ -555,14 +641,19 @@ (array/slice coll 1))) (defn core-next [coll] + # next is rest, but nil when the rest is empty. seq-done? realizes one lazy + # cell so a lazy rest that turns out empty (length on the table won't tell us) + # collapses to nil, matching Clojure. (let [r (core-rest coll)] - (if (= 0 (length r)) nil r))) + (if (seq-done? r) nil r))) (defn core-cons [x coll] "Prepend x onto coll. For concrete collections this is an O(1) persistent cons node; for lazy-seqs it stays a lazy cell so laziness is preserved." (cond - (lazy-seq? coll) @[x (fn [] coll)] + # Lazy tail: return a LazySeq (NOT a bare cell), so a cons-of-a-cons stays a + # proper lazy-seq and the rest-thunk never leaks as a plain array element. + (lazy-seq? coll) (make-lazy-seq (fn [] @[x (fn [] coll)])) (or (nil? coll) (plist? coll) (array? coll) (tuple? coll)) (pl-cons x coll) # second arg must be seqable (a collection or string); reject scalars (not (or (core-coll? coll) (string? coll))) @@ -574,7 +665,10 @@ (core-sorted-map? coll) (let [e (sorted-map-entries coll)] (if (empty? e) nil (tuple ;e))) (core-sorted-set? coll) (let [i (coll :items)] (if (empty? i) nil (tuple ;i))) (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll)))) nil - (lazy-seq? coll) (ls-seq coll) + # Cell-based emptiness, NOT (nil? (ls-first)): a lazy-seq whose first element + # is legitimately nil is non-empty, so (seq (cons nil ...)) must not be nil. + (lazy-seq? coll) (let [cell (realize-ls coll)] + (if (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell))) nil coll)) (pvec? coll) (if (= 0 (pv-count coll)) nil (tuple ;(pv->array coll))) (plist? coll) (if (pl-empty? coll) nil (tuple ;(pl->array coll))) (buffer? coll) (if (= 0 (length coll)) nil (let [a @[]] (each x coll (array/push a x)) (tuple ;a))) @@ -629,8 +723,8 @@ (cond (nil? m) nil (or (phm? m) (struct? m)) - (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) - (set result (core-assoc result k (if (phm? m) (phm-get m k) (in m k))))) + (each e (map-entries-of m) + (set result (core-assoc result (in e 0) (in e 1)))) # a [k v] pair (map-entry / 2-vector), per conj (and (or (pvec? m) (tuple? m) (array? m)) (= 2 (if (pvec? m) (pv-count m) (length m)))) @@ -647,34 +741,50 @@ result))) (defn core-merge-with [f & maps] - (if (phm? (first maps)) - (do (var result (first maps)) (var mi 1) (while (< mi (length maps)) (let [m (maps mi)] - (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (let [existing (phm-get result k) - val (if (phm? m) (phm-get m k) (m k))] - (set result (phm-assoc result k (if (nil? existing) val (f existing val)))))) (++ mi))) result) - (do (var result @{}) (each m maps (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (let [existing (result k)] (put result k (if (nil? existing) (m k) (f existing (m k))))))) (table/to-struct result)))) + # Presence — not nil-of-value — decides whether to combine: a key present in the + # accumulator with a nil value still triggers (f existing v), matching Clojure. + (if (= 0 (length maps)) + nil + (do + (var result (first maps)) + (var mi 1) + (while (< mi (length maps)) + (let [m (maps mi)] + (when m + (each e (map-entries-of m) + (let [k (in e 0) v (in e 1)] + (set result + (if (core-contains? result k) + (core-assoc result k (f (core-get result k) v)) + (core-assoc result k v))))))) + (++ mi)) + result))) (defn core-keys [m] - (if (phm? m) (tuple ;(keys (phm-to-struct m))) (tuple ;(keys m)))) + # phm-entries (not phm-to-struct) so keys mapped to nil values are not dropped. + (if (phm? m) (tuple ;(map |(in $ 0) (phm-entries m))) (tuple ;(keys m)))) (defn core-vals [m] - (if (phm? m) (do (def s (phm-to-struct m)) (tuple ;(map |(s $) (keys s)))) (tuple ;(map |(m $) (keys m))))) + (if (phm? m) (tuple ;(map |(in $ 1) (phm-entries m))) (tuple ;(map |(m $) (keys m))))) (defn core-select-keys [m ks] - (var result @{}) + # Include a key when it is PRESENT (contains?), even if its value is nil — a + # struct/table would drop a nil value, so collect entries and build via kvs->map. + (def kvs @[]) (each k (realize-for-iteration ks) - (let [v (core-get m k)] - (if (not (nil? v)) (put result k v)))) - (if (struct? m) (table/to-struct result) result)) + (when (core-contains? m k) + (array/push kvs k) (array/push kvs (core-get m k)))) + (kvs->map kvs)) (defn core-zipmap [ks vs] (let [ks (realize-for-iteration ks) vs (realize-for-iteration vs)] - (var result @{}) + # collect pairs, then build once — a nil key/value must survive (kvs->map -> phm) + (def kvs @[]) (var i 0) (while (and (< i (length ks)) (< i (length vs))) - (put result (in ks i) (in vs i)) + (array/push kvs (in ks i)) (array/push kvs (in vs i)) (++ i)) - (table/to-struct result))) + (kvs->map kvs))) # ============================================================ # Transducers @@ -724,6 +834,30 @@ (var i -1) (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (do (++ i) (rf (a 0) (f i (a 1)))))))) +# Stateful windowing transducers. The 1-arg (completion) arity flushes a partial +# trailing window before delegating to rf's completion; matches Clojure. +(defn td-partition-all [n] + (fn [rf] + (var buf @[]) + (fn [& a] + (case (length a) + 0 (rf) + 1 (let [result (if (= 0 (length buf)) (a 0) + (let [v (tuple/slice (tuple ;buf))] + (set buf @[]) + (core-unreduced (rf (a 0) v))))] + (rf result)) + (do + (array/push buf (a 1)) + (if (= n (length buf)) + (let [v (tuple/slice (tuple ;buf))] + (set buf @[]) + (rf (a 0) v)) + (a 0))))))) + +# partition-by's transducer arity lives with its (lazy) collection arity in the +# overlay (10-seq tier), written in Clojure with volatiles. + (defn- reduce-with-reduced "Reduce coll with reducing fn rf and seed init, honoring `reduced`. Steps lazy seqs one cell at a time so a reducing fn that returns `reduced` (e.g. the @@ -775,20 +909,102 @@ (into-conj to (realize-for-iteration (in rest 0))))) (defn core-sequence - "(sequence coll) or (sequence xform coll) — eager here (returns a seq/tuple)." + "(sequence coll) -> a seq of coll. (sequence xform coll) -> a LAZY seq of coll + transformed by xform: elements are pulled and pushed through the transducer one + at a time, with outputs buffered and emitted lazily — so it works over infinite + input (matching Clojure). Honors `reduced` (early stop) and runs the completion + arity to flush stateful transducers (e.g. partition-all)." [a & rest] (if (= 0 (length rest)) (core-seq a) - (tuple ;(core-transduce a (fn [& x] (case (length x) 0 @[] 1 (x 0) (do (array/push (x 0) (x 1)) (x 0)))) @[] (in rest 0))))) + (let [xform a + coll (in rest 0) + buf @[] + state @{:stopped false :completed false} + rf (fn [& args] + (case (length args) + 0 buf + 1 (in args 0) + (do (array/push (in args 0) (in args 1)) (in args 0)))) + xf (xform rf)] + # Pull/complete until buf holds an output or the source is fully drained. + (defn ensure-buf [src] + (var s src) + (while (and (= 0 (length buf)) (not (state :stopped)) (not (seq-done? s))) + (let [r (xf buf (core-first s))] + (set s (core-rest s)) + (when (core-reduced? r) (put state :stopped true)))) + (when (and (= 0 (length buf)) (not (state :completed)) + (or (state :stopped) (seq-done? s))) + (put state :completed true) + (xf buf)) # completion arity — flushes any buffered state + s) + (defn gen [src] + (fn [] + (let [s (ensure-buf src)] + (if (= 0 (length buf)) nil + (let [val (in buf 0)] + (array/remove buf 0 1) + @[val (gen s)]))))) + # core-seq normalizes to a tuple / lazy-seq / nil — all walkable by + # core-first/rest/seq-done?. (Walking a raw pvec/set would misfire: + # seq-done? uses length, which counts a pvec table's KEYS, not elements.) + (make-lazy-seq (gen (core-seq coll)))))) -(defn- seq-done? - "True when cursor c (a lazy-seq or a concrete collection) is exhausted. - Uses cell realization for lazy-seqs so nil elements don't end the seq early." - [c] - (if (lazy-seq? c) - (let [cell (realize-ls c)] - (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))) - (or (nil? c) (= 0 (length c))))) + +(defn coll->cells [c] + "Convert a seqable to a lazy-seq cell chain: nil or [first, rest-thunk]. + A cons cell is a MUTABLE array `@[val rest-thunk]` (produced by `cons`/the lazy + transformers); user collections (tuples, pvecs, lists) are immutable. We rely + on that distinction: only a mutable 2-array whose tail is a function is treated + as an already-built cell — a user vector like `[first last]` (tail is the fn + `last`) is data and must NOT be misread as a cell. User data is recursed through + immutable tuples so its tails never reach the cell-detection branch." + (if (nil? c) nil + (if (pvec? c) (coll->cells (tuple ;(pv->array c))) + (if (plist? c) (coll->cells (tuple ;(pl->array c))) + (if (function? c) + (let [r (c)] + (if (and (array? r) (= 2 (length r)) (function? (in r 1))) + r + (coll->cells r))) + (if (lazy-seq? c) + (let [cell (realize-ls c)] + (if (= :jolt/pending cell) nil cell)) + (if (tuple? c) + # user sequential data: every element is a value, no cell-detection. + (if (= 0 (length c)) nil + @[(in c 0) (fn [] (coll->cells (tuple/slice c 1)))]) + (if (array? c) + # mutable array: a genuine cons cell, or an eager seq result. + (if (= 0 (length c)) nil + (if (and (= 2 (length c)) (function? (in c 1))) + c # already a cell [val, rest-thunk] + @[(in c 0) (fn [] (coll->cells (array/slice c 1)))])) + # Other concrete seqables (set/map/string/buffer): coerce to a tuple + # seq via core-seq, then recurse. (lazy/indexed handled above.) + (if (or (set? c) (phm? c) (buffer? c) (string? c) + (and (struct? c) (nil? (get c :jolt/type)))) + (coll->cells (core-seq c)) + nil))))))))) + +(defn lazy-from + "Coerce any seqable to a uniform lazy view without forcing. + Returns nil if coll is nil or empty, the LazySeq unchanged if already lazy, + or a new LazySeq that walks element by element." + [coll] + (if (nil? coll) nil + (if (lazy-seq? coll) coll + (do + # Reject non-seqable scalars (number/boolean/keyword, and tagged structs + # like char/symbol) so a lazy transformer over bad input throws when + # realized — matching Clojure — instead of silently yielding empty. + (when (or (number? coll) (boolean? coll) (keyword? coll) + (and (struct? coll) (not (nil? (get coll :jolt/type))))) + (error (string "Don't know how to create ISeq from: " (type coll)))) + (let [cell (coll->cells coll)] + (if (nil? cell) nil + (make-lazy-seq (fn [] cell)))))))) (defn core-map [f & colls] (def f (as-fn f)) @@ -796,18 +1012,14 @@ (td-map f) # transducer arity (if (= 1 (length colls)) (let [coll (colls 0)] - (if (lazy-seq? coll) - # Lazy input: stay lazy so infinite/self-referential seqs work. - (do - (defn mstep [c] - (fn [] - (if (seq-done? c) nil - @[(f (core-first c)) (mstep (core-rest c))]))) - (make-lazy-seq (mstep coll))) - # Concrete collection: eager (preserves tuple/array representation). - (let [c (if (set? coll) (phs-seq coll) (realize-for-iteration coll)) - result (do (var res @[]) (each x c (array/push res (f x))) res)] - (if (jvec? coll) (make-vec result) result)))) + # Option A: always lazy, even over concrete collections (matches Clojure — + # map returns a seq, not a vector). + (do + (defn mstep [c] + (fn [] + (if (seq-done? c) nil + @[(f (core-first c)) (mstep (core-rest c))]))) + (make-lazy-seq (mstep (lazy-from coll))))) # Multi-collection: lazy-seq with per-element independent state (let [init-cs (array/new-filled (length colls) nil) init-idxs (array/new-filled (length colls) 0) @@ -834,12 +1046,15 @@ (while (< i (length cs)) (let [cur (in cs i) ridx (in idxs i) real (in reals i)] (if (not (nil? cur)) - (let [val (ls-first cur)] - (if (nil? val) (do (set ok false) (break)) - (do (array/push args val) + # Detect exhaustion with seq-done?, NOT (nil? (ls-first)): a + # lazy-seq can legitimately contain nil elements, and treating the + # first nil as end-of-seq truncates (e.g. mapping over a previous + # map result that holds nils). + (if (seq-done? cur) (do (set ok false) (break)) + (do (array/push args (ls-first cur)) (put next-cs i (ls-rest cur)) (put next-idxs i (+ ridx 1)) - (put next-reals i nil)))) + (put next-reals i nil))) (let [c (if (nil? real) (let [rc (realize-for-iteration (in colls i))] (put next-reals i rc) rc) @@ -859,8 +1074,7 @@ (def pred (as-fn pred)) (if (= 0 (length rest)) (td-filter pred) (let [coll (in rest 0)] - (if (lazy-seq? coll) - # lazy input -> lazy output (supports infinite seqs) + # Option A: always lazy (matches Clojure — filter returns a seq). (do (defn fstep [c] (fn [] @@ -870,12 +1084,7 @@ (if (pred x) (do (set hit @[x (core-rest cur)]) (set found true)) (set cur (core-rest cur))))) (if found @[(in hit 0) (fstep (in hit 1))] nil))) - (make-lazy-seq (fstep coll))) - (do - (var result @[]) - (each x (if (set? coll) (phs-seq coll) (realize-for-iteration coll)) - (if (pred x) (array/push result x))) - (if (jvec? coll) (make-vec result) result)))))) + (make-lazy-seq (fstep (lazy-from coll))))))) (defn core-remove [pred & rest] (def pred (as-fn pred)) @@ -906,115 +1115,64 @@ (defn core-take [n & rest] (if (= 0 (length rest)) (td-take n) (let [coll (in rest 0)] - (if (lazy-seq? coll) - (do - (var result @[]) - (var cur coll) - (var i 0) - (while (and (< i n) (not (nil? (ls-first cur)))) - (array/push result (ls-first cur)) - (set cur (ls-rest cur)) - (++ i)) - result) - (let [c (realize-for-iteration coll)] - (var result @[]) - (var i 0) - (while (and (< i n) (< i (length c))) - (array/push result (in c i)) - (++ i)) - (if (jvec? coll) (make-vec result) result)))))) + # Option A: lazy take (returns a seq, not a vector, even over a vector). + (defn tstep [c i] + (fn [] + (if (or (>= i n) (seq-done? c)) nil + @[(core-first c) (tstep (core-rest c) (+ i 1))]))) + (make-lazy-seq (tstep (lazy-from coll) 0))))) (defn core-drop [n & rest] (if (= 0 (length rest)) (td-drop n) (let [coll (in rest 0)] - (if (lazy-seq? coll) - (do - (var cur coll) - (var i 0) - (while (and (< i n) (ls-first cur)) - (set cur (ls-rest cur)) - (++ i)) - (if (nil? (ls-first cur)) nil cur)) - (let [c (realize-for-iteration coll) - dropped (array/slice c (min n (length c)))] - (if (jvec? coll) (make-vec dropped) dropped)))))) + # Option A: lazy drop — skip n (forcing only those), return the lazy tail. + (make-lazy-seq + (fn [] + (var cur (lazy-from coll)) + (var i 0) + (while (and (< i n) (not (seq-done? cur))) + (set cur (core-rest cur)) + (++ i)) + (coll->cells cur)))))) -(defn core-second [coll] (core-first (core-rest coll))) -(defn core-ffirst [coll] (core-first (core-first coll))) -(defn core-nfirst [coll] (core-next (core-first coll))) -(defn core-fnext [coll] (core-first (core-next coll))) -(defn core-nnext [coll] (core-next (core-next coll))) - -(defn core-last [coll] - (let [c (realize-for-iteration coll)] - (if (= 0 (length c)) nil (in c (- (length c) 1))))) - -(defn core-drop-last [a & rest] - (let [n (if (= 0 (length rest)) 1 a) - coll (if (= 0 (length rest)) a (in rest 0)) - c (realize-for-iteration coll) - end (max 0 (- (length c) n))] - (tuple ;(array/slice c 0 end)))) - -(defn core-take-last [n coll] - (let [c (realize-for-iteration coll) - start (max 0 (- (length c) n))] - (if (= 0 (length c)) nil (tuple ;(array/slice c start))))) +# ffirst/nfirst/fnext/nnext/last/butlast (seq tier) and second/peek/subvec/mapv/ +# update (kernel tier) now live in the Clojure clojure.core tiers under +# jolt-core/clojure/core/. The kernel tier is bootstrap-compiled before the +# self-hosted analyzer is built, so the structural fns the analyzer uses come +# from Clojure, not Janet — see api/load-core-overlay! and core/00-kernel.clj. (defn core-take-while [pred & rest] (def pred (as-fn pred)) (if (= 0 (length rest)) (td-take-while pred) (let [coll (in rest 0)] - (if (lazy-seq? coll) - (do - (var result @[]) (var cur coll) (var go true) - (while (and go (not (seq-done? cur))) - (let [x (core-first cur)] - (if (pred x) (do (array/push result x) (set cur (core-rest cur))) - (set go false)))) - result) - (do - (var result @[]) - (each x (realize-for-iteration coll) (if (pred x) (array/push result x) (break))) - (if (jvec? coll) (make-vec result) result)))))) + # Option A: lazy take-while. + (defn twstep [c] + (fn [] + (if (seq-done? c) nil + (let [x (core-first c)] + (if (pred x) @[x (twstep (core-rest c))] nil))))) + (make-lazy-seq (twstep (lazy-from coll)))))) (defn core-drop-while [pred & rest] (def pred (as-fn pred)) (if (= 0 (length rest)) (td-drop-while pred) - (let [coll (in rest 0) - c (realize-for-iteration coll)] - (var start 0) - (while (and (< start (length c)) (pred (c start))) - (++ start)) - (if (tuple? c) - (tuple/slice c start) - (array/slice c start))))) - -(defn coll->cells [c] - "Convert a seqable to lazy-seq cell chain: nil or [first, rest-thunk]. - If the value is a function, call it and use the result. - If the result is already a cell (array of [val, function]), return it directly." - (if (nil? c) nil - (if (pvec? c) (coll->cells (pv->array c)) - (if (plist? c) (coll->cells (pl->array c)) - (if (function? c) - (let [r (c)] - (if (and (indexed? r) (= 2 (length r)) (function? (in r 1))) - r - (coll->cells r))) - (if (lazy-seq? c) - (let [cell (realize-ls c)] - (if (= :jolt/pending cell) nil cell)) - (if (indexed? c) - (if (= 0 (length c)) nil - (if (and (= 2 (length c)) (function? (in c 1))) - c # already a cell [val, rest-thunk] - (let [f (in c 0) - rest (if (> (length c) 1) - (if (tuple? c) (tuple/slice c 1) (array/slice c 1)) - nil)] - @[f (fn [] (coll->cells rest))]))) - nil))))))) + (let [coll (in rest 0)] + (if (lazy-seq? coll) + (do + (defn dwstep [c] + (fn [] + (var cur c) + (while (and (not (seq-done? cur)) (pred (ls-first cur))) + (set cur (ls-rest cur))) + (if (seq-done? cur) nil (realize-ls cur)))) + (make-lazy-seq (dwstep coll))) + (let [c (realize-for-iteration coll)] + (var start 0) + (while (and (< start (length c)) (pred (c start))) + (++ start)) + (if (tuple? c) + (tuple/slice c start) + (array/slice c start))))))) (defn core-concat [& colls] "Truly lazy concatenation. `step` returns a 0-arg thunk that is only forced @@ -1022,22 +1180,25 @@ construction time. This is essential for self-referential lazy seqs (e.g. (def fib (lazy-cat [0 1] (map + (rest fib) fib)))): the later colls must not be forced until after the surrounding `def` has bound the var." - (defn step [cs] - (fn [] - (if (= 0 (length cs)) - nil - (let [c (in cs 0) - remaining (array/slice cs 1) - cell (coll->cells c)] - (if (nil? cell) - # current coll is empty: advance to the next one - ((step remaining)) - (let [val (in cell 0) - rest-fn (in cell 1)] - @[val (step (if (nil? rest-fn) - remaining - (array/insert remaining 0 rest-fn)))])))))) - (make-lazy-seq (step (if (tuple? colls) (array/slice colls) colls)))) + (if (= 0 (length colls)) @[] + (let [colls (if (tuple? colls) (array/slice colls) colls)] + (defn step [cs] + (fn [] + (if (= 0 (length cs)) + nil + (let [c (in cs 0) + remaining (array/slice cs 1) + cell (coll->cells c)] + (if (nil? cell) + # current coll is empty: advance to the next one + ((step remaining)) + (let [val (in cell 0) + rest-fn (in cell 1)] + @[val (step (if (nil? rest-fn) + remaining + (array/insert remaining 0 rest-fn)))])))))) + (make-lazy-seq (step colls))))) + (defn core-mapcat "(mapcat f & colls) — map then concat. (mapcat f) returns a transducer." @@ -1053,16 +1214,44 @@ (each x (realize-for-iteration (f (a 1))) (set acc (rf acc x))) acc)))) - # map, then concat; a non-seqable result counts as a single element (this - # leniency is what jolt's `for` expansion relies on for :let on the last - # binding, whose body yields a scalar rather than a seq). - (let [mapped (realize-for-iteration (core-apply core-map f colls)) - seqs (map (fn [item] - (if (or (tuple? item) (array? item) (pvec? item) - (lazy-seq? item) (set? item)) - item (tuple item))) - mapped)] - (core-apply core-concat seqs)))) + # collection arity: direct lazy implementation. Pull one element + # from each input coll, apply f, then yield elements from f's result. + # No apply-forcing — walk input colls lazily element-by-element. + (do + (var n (length colls)) + (var init-cs @[]) + (var i 0) + (while (< i n) + (array/push init-cs (lazy-from (in colls i))) + (++ i)) + (defn step [cs res] + (fn [] + (var cursors cs) (var cur-res res) (var hit nil) (var ok false) + (while (not ok) + (if (nil? cur-res) + (do + (var args @[]) (var next-cs @[]) (var exhausted false) (var j 0) + (while (and (< j n) (not exhausted)) + (let [c (in cursors j)] + (if (seq-done? c) (set exhausted true) + (do + (array/push args (ls-first c)) + (array/push next-cs (ls-rest c))))) + (++ j)) + (if exhausted (break)) + (let [r (apply f args)] + (set cursors next-cs) + (set cur-res (if (or (nil? r) (tuple? r) (array? r) + (lazy-seq? r) (pvec? r) (set? r) (plist? r)) + (lazy-from r) + (lazy-from (tuple r)))))) + (if (seq-done? cur-res) + (set cur-res nil) + (let [val (ls-first cur-res) rest (ls-rest cur-res)] + (set hit @[val (step cursors rest)]) + (set ok true))))) + (if ok hit nil))) + (make-lazy-seq (step init-cs nil))))) (defn core-reverse [coll] (if (nil? coll) @[] @@ -1070,9 +1259,10 @@ (do (var result @[]) (var cur coll) - (while (not (nil? (ls-first cur))) - (array/push result (ls-first cur)) - (set cur (ls-rest cur))) + # seq-done?, not (nil? (ls-first)): a nil element must not end the walk. + (while (not (seq-done? cur)) + (array/push result (core-first cur)) + (set cur (core-rest cur))) (var reversed @[]) (var i (dec (length result))) (while (>= i 0) @@ -1088,37 +1278,39 @@ result)))) (defn core-nth - "Return the nth element of a sequential collection." - [coll idx &opt default] + "Return the nth element of a sequential collection. With a not-found arg, return + it when idx is out of bounds (even if it's nil); without one, throw — matching + Clojure, where (nth coll i nil) returns nil rather than throwing." + [coll idx & rest] + (def has-default (> (length rest) 0)) + (def default (if has-default (in rest 0) nil)) + (defn oob [n] (if has-default default (error (string "Index " idx " out of bounds, length: " n)))) (if (nil? coll) default # (nth nil i) -> nil / default, never throws (if (core-transient? coll) - (let [a (coll :arr)] (if (and (>= idx 0) (< idx (length a))) (in a idx) default)) + (let [a (coll :arr)] (if (and (>= idx 0) (< idx (length a))) (in a idx) (oob (length a)))) (if (plist? coll) (let [a (pl->array coll)] - (if (and (>= idx 0) (< idx (length a))) (in a idx) - (if (nil? default) (error (string "Index " idx " out of bounds, length: " (length a))) default))) + (if (and (>= idx 0) (< idx (length a))) (in a idx) (oob (length a)))) (if (pvec? coll) (if (and (>= idx 0) (< idx (pv-count coll))) (pv-nth coll idx) - (if (nil? default) (error (string "Index " idx " out of bounds, length: " (pv-count coll))) default)) + (oob (pv-count coll))) (if (lazy-seq? coll) - (do - (var cur coll) - (var i 0) - (while (and (< i idx) (ls-first cur)) - (set cur (ls-rest cur)) - (++ i)) - (if (ls-first cur) (ls-first cur) - (if (nil? default) - (error (string "Index " idx " out of bounds")) - default))) + # Walk with seq-done?, NOT (ls-first cur): a lazy element may legitimately be + # false or nil, which truthiness would mistake for end-of-seq. + (if (< idx 0) (oob 0) + (do + (var cur coll) + (var i 0) + (while (and (< i idx) (not (seq-done? cur))) + (set cur (core-rest cur)) + (++ i)) + (if (seq-done? cur) (oob i) (core-first cur)))) (do (var c (realize-for-iteration coll)) (if (and (>= idx 0) (< idx (length c))) (if (string? c) (make-char (in c idx)) (in c idx)) - (if (nil? default) - (error (string "Index " idx " out of bounds, length: " (length c))) - default))))))))) + (oob (length c)))))))))) (defn core-sort "(sort coll) or (sort comparator coll). Comparator may return a boolean or a @@ -1151,41 +1343,23 @@ (tuple/slice (tuple ;arr)))))) (defn core-distinct [coll] - (if (nil? coll) @[] - (if (lazy-seq? coll) - (do - (var seen @{}) - (var result @[]) - (var cur coll) - (while (not (nil? (ls-first cur))) - (let [x (ls-first cur)] - (if (nil? (seen x)) - (do (put seen x true) (array/push result x)))) - (set cur (ls-rest cur))) - result) - (do - (var seen @{}) - (var result @[]) - (each x (realize-for-iteration coll) - (if (nil? (seen x)) - (do (put seen x true) (array/push result x)))) - (if (jvec? coll) (make-vec result) result))))) + # Option A: always lazy. seen-set is captured once and shared across the chain. + (let [seen @{}] + (defn dstep [c] + (fn [] + (var cur c) (var found false) (var result nil) + (while (and (not found) (not (seq-done? cur))) + (let [x (core-first cur)] + (set cur (core-rest cur)) + (when (nil? (seen x)) + (put seen x true) + (set found true) + (set result x)))) + (if found @[result (dstep cur)] nil))) + (make-lazy-seq (dstep (lazy-from coll))))) -(defn core-group-by [f coll] - (def f (as-fn f)) - # phm base so collection keys group by value - (var result (make-phm)) - (each x (realize-for-iteration coll) - (let [k (f x)] - (set result (phm-assoc result k (array/push (phm-get result k @[]) x))))) - result) - -(defn core-frequencies [coll] - # phm base so collection elements are counted by value - (var result (make-phm)) - (each x (realize-for-iteration coll) - (set result (phm-assoc result x (+ 1 (phm-get result x 0))))) - result) +# group-by / frequencies now live in the Clojure collection tier +# (core/20-coll.clj). (defn core-partition "(partition n coll) or (partition n step coll). Only complete partitions of @@ -1193,14 +1367,22 @@ [n & rest] (let [has-step (> (length rest) 1) step (if has-step (first rest) n) - coll (realize-for-iteration (if has-step (in rest 1) (first rest)))] - (var result @[]) (var i 0) - (while (<= (+ i n) (length coll)) - (var part @[]) (var j 0) - (while (< j n) (array/push part (in coll (+ i j))) (++ j)) - (array/push result (tuple/slice (tuple ;part))) - (+= i step)) - result)) + coll (if has-step (in rest 1) (first rest))] + # Option A: always lazy. + (defn pstep [c] + (fn [] + (if (seq-done? c) nil + (do + (var part @[]) (var cur c) (var i 0) + (while (and (< i n) (not (seq-done? cur))) + (array/push part (core-first cur)) + (set cur (core-rest cur)) + (++ i)) + (if (= i n) + (let [next-cur (if (= step n) cur (lazy-from (core-drop (- step n) cur)))] + @[(tuple/slice (tuple ;part)) (pstep next-cur)]) + nil))))) + (make-lazy-seq (pstep (lazy-from coll))))) (defn core-partition-by [f coll] (def f (as-fn f)) @@ -1218,53 +1400,48 @@ (if (> (length part) 0) (array/push result (tuple/slice (tuple ;part)))) result) -(defn core-partition-all [n coll] - (let [c (realize-for-iteration coll)] - (var result @[]) (var i 0) - (while (< i (length c)) - (var part @[]) (var j 0) - (while (and (< j n) (< (+ i j) (length c))) - (array/push part (in c (+ i j))) (++ j)) - (array/push result (tuple/slice (tuple ;part))) - (+= i n)) - result)) +(defn core-partition-all [n & rest] + (if (= 0 (length rest)) (td-partition-all n) + (let [coll (in rest 0)] + # Option A: always lazy. + (defn pstep [c] + (fn [] + (if (seq-done? c) nil + (do + (var part @[]) (var cur c) (var i 0) + (while (and (< i n) (not (seq-done? cur))) + (array/push part (core-first cur)) + (set cur (core-rest cur)) + (++ i)) + @[(tuple/slice (tuple ;part)) (pstep cur)])))) + (make-lazy-seq (pstep (lazy-from coll)))))) -(defn core-reductions - "(reductions f coll) or (reductions f init coll) -> seq of intermediate accs." - [f init-or-coll &opt maybe-coll] - (let [has-init (not (nil? maybe-coll)) - coll (realize-for-iteration (if has-init maybe-coll init-or-coll)) - result @[]] - (if has-init - (do (var acc init-or-coll) (array/push result acc) - (each x coll (set acc (f acc x)) (array/push result acc))) - (when (> (length coll) 0) - (var acc (in coll 0)) (array/push result acc) - (var i 1) - (while (< i (length coll)) (set acc (f acc (in coll i))) (array/push result acc) (++ i)))) - (tuple/slice (tuple ;result)))) - -(defn core-dedupe [coll] - (let [c (realize-for-iteration coll) result @[]] - (var prev :jolt/none) - (each x c - (when (or (= prev :jolt/none) (not (deep= x prev))) - (array/push result x)) - (set prev x)) - (tuple/slice (tuple ;result)))) (defn core-keep-indexed [f coll] - (let [c (realize-for-iteration coll) result @[]] - (var i 0) - (each x c (let [v (f i x)] (when (not (nil? v)) (array/push result v))) (++ i)) - (tuple/slice (tuple ;result)))) + (def f (as-fn f)) + # Option A: always lazy. + (defn kstep [c i] + (fn [] + (var cur c) (var idx i) (var found false) (var result nil) + (while (and (not found) (not (seq-done? cur))) + (let [v (f idx (core-first cur))] + (++ idx) + (set cur (core-rest cur)) + (when (not (nil? v)) + (set found true) + (set result v)))) + (if found @[result (kstep cur idx)] nil))) + (make-lazy-seq (kstep (lazy-from coll) 0))) (defn core-map-indexed [f & rest] (if (= 0 (length rest)) (td-map-indexed f) - (let [c (realize-for-iteration (in rest 0)) result @[]] - (var i 0) - (each x c (array/push result (f i x)) (++ i)) - (tuple/slice (tuple ;result))))) + (let [coll (in rest 0)] + # Option A: always lazy. + (defn mstep [c i] + (fn [] + (if (seq-done? c) nil + @[(f i (core-first c)) (mstep (core-rest c) (+ i 1))]))) + (make-lazy-seq (mstep (lazy-from coll) 0))))) (defn core-cycle [coll] (let [c (realize-for-iteration coll)] @@ -1274,25 +1451,11 @@ (defn cstep [i] (fn [] @[(in c (% i (length c))) (cstep (+ i 1))])) (make-lazy-seq (cstep 0)))))) -(defn core-reduce-kv [f init m] - (var acc init) - (cond - (phm? m) (each k (keys (phm-to-struct m)) (set acc (f acc k (phm-get m k)))) - (or (struct? m) (table? m)) (each k (keys m) (set acc (f acc k (get m k)))) - (indexed? m) (do (var i 0) (each x m (set acc (f acc i x)) (++ i)))) - acc) - -# peek/pop are defined only on stacks (vectors -> last end, lists -> front); -# Clojure throws on sets/maps/seqs/strings/scalars. -(defn core-peek [coll] - (cond - (nil? coll) nil - (plist? coll) (if (pl-empty? coll) nil (pl-first coll)) # list: first - (pvec? coll) (if (= 0 (pv-count coll)) nil (pv-nth coll (- (pv-count coll) 1))) # vector: last - (tuple? coll) (if (= 0 (length coll)) nil (in coll (- (length coll) 1))) # vector: last - (array? coll) (if (= 0 (length coll)) nil (in coll 0)) # list: first - (error (string "peek not supported on " (type coll))))) +# reduce-kv now lives in the Clojure collection tier (core/20-coll.clj). +# pop is defined only on stacks (vectors -> last end, lists -> front); Clojure +# throws on sets/maps/seqs/strings/scalars. (peek lives in the Clojure kernel +# tier — core/00-kernel.clj.) (defn core-pop [coll] (cond (nil? coll) nil @@ -1302,22 +1465,7 @@ (array? coll) (if (= 0 (length coll)) (error "Can't pop empty list") (array/slice coll 1)) (error (string "pop not supported on " (type coll))))) -# Clojure coerces subvec indices with (int ...): floats truncate and NaN -> 0; -# only non-numbers and out-of-range values throw. -(defn- subvec-idx [x] - (cond - (not (number? x)) (error "subvec index must be a number") - (not= x x) 0 # NaN -> 0 - (math/trunc x))) -(defn core-subvec [v start &opt end] - (when (not (or (pvec? v) (tuple? v) (array? v))) - (error (string "subvec requires a vector, got " (type v)))) - (let [a (vview v) - s (subvec-idx start) - e (if (nil? end) (length a) (subvec-idx end))] - (when (not (and (>= s 0) (<= s e) (<= e (length a)))) - (error (string "subvec indices out of range: " s " " e " (length " (length a) ")"))) - (make-vec (tuple/slice a s e)))) +# subvec lives in the Clojure kernel tier — core/00-kernel.clj. (defn core-trampoline [f & args] (var result (apply f args)) @@ -1393,11 +1541,6 @@ (and (keyword? x) (not (nil? (string/find "/" (string x)))))) (defn core-simple-keyword? [x] (and (keyword? x) (nil? (string/find "/" (string x))))) -(defn core-ident? [x] (or (core-keyword? x) (core-symbol? x))) -(defn core-qualified-ident? [x] - (or (core-qualified-symbol? x) (core-qualified-keyword? x))) -(defn core-simple-ident? [x] - (or (core-simple-symbol? x) (core-simple-keyword? x))) # Jolt has no inst/uri/uuid host types, so these are always false; inst-ms has # nothing valid to read. (defn core-inst? [x] false) @@ -1405,8 +1548,7 @@ (defn core-uri? [x] false) (defn core-uuid? [x] false) (defn core-bytes? [x] (buffer? x)) -(defn core-tagged-literal? [x] - (and (table? x) (= :jolt/tagged-literal (get x :jolt/type)))) +# tagged-literal? now lives in the Clojure collection tier (tagged-value predicate). (defn core-meta [x] "Returns the metadata of x, or nil." @@ -1417,11 +1559,7 @@ (table? x) (or (get x :jolt/meta) (get x :meta)) nil)) -(defn core-every-pred [& preds] - (fn [& xs] - (var ok true) - (each p preds (each x xs (when (not (truthy? (p x))) (set ok false)))) - ok)) +# every-pred now lives in the Clojure collection tier (core/20-coll.clj). (def core-comp (fn [& fs] @@ -1442,9 +1580,7 @@ (defn core-partial [f & args] (fn [& more] (apply f (array/concat (array/slice args) more)))) -(defn core-juxt [& fs] - (fn [& args] - (tuple ;(map |(apply $ args) fs)))) +# juxt now lives in the Clojure collection tier (core/20-coll.clj). (defn core-memoize [f] (var cache @{}) @@ -1478,21 +1614,6 @@ (defn core-disj [s & ks] (if (set? s) (apply phs-disj s ks) (error "disj expects a set"))) -(defn core-lazy-seq [& body] - @[{:jolt/type :symbol :ns nil :name "make-lazy-seq"} - @[{:jolt/type :symbol :ns nil :name "fn*"} [] - @[{:jolt/type :symbol :ns nil :name "coll->cells"} - @[{:jolt/type :symbol :ns nil :name "do"} ;body]]]]) - -(defn core-lazy-cat [& colls] - "Macro: (lazy-cat & colls) — concatenate lazy sequences, wrapping each coll in lazy-seq. - concat is now lazy, so no outer make-lazy-seq wrapping is needed." - (def concat-form @[]) - (array/push concat-form {:jolt/type :symbol :ns nil :name "concat"}) - (each c colls - (array/push concat-form @[{:jolt/type :symbol :ns nil :name "lazy-seq"} c])) - concat-form) - (defn core-set [coll] (apply core-hash-set (realize-for-iteration coll))) @@ -1709,18 +1830,9 @@ # numeric arrays use Janet arrays. aget/aset/alength/aclone work over both. # ============================================================ -(defn core-alength [arr] (length arr)) - -(defn core-aget [arr & idxs] - # multi-dim: aget arr i j ... walks nested arrays - (var v arr) (each i idxs (set v (in v i))) v) - -(defn core-aset [arr & more] - # (aset arr i v) or (aset arr i j ... v): last arg is the value - (let [n (length more) val (in more (- n 1))] - (var target arr) (var k 0) - (while (< k (- n 2)) (set target (in target (in more k))) (++ k)) - (put target (in more (- n 2)) val) val)) +# alength / aget / aset now live in the Clojure collection tier — count/nth reads +# and an aset write through jolt.host/ref-put!. The typed/object array constructors +# below stay native (they build the mutable backing). (defn core-aclone [arr] (if (buffer? arr) (buffer/slice arr) (array/slice arr))) @@ -1797,7 +1909,7 @@ (defn core-chunk-buffer [capacity] @[]) (defn core-chunk-append [b x] (array/push b x) b) (defn core-chunk [b] b) -(defn core-chunked-seq? [x] false) +# chunked-seq? now lives in the Clojure collection tier (always false on Jolt). (defn core-chunk-first [s] (core-first s)) (defn core-chunk-rest [s] (core-rest s)) (defn core-chunk-next [s] (core-next s)) @@ -1810,15 +1922,13 @@ (case (length a) 0 (rf) 1 (rf (a 0)) (do (var acc (a 0)) (each x (realize-for-iteration (a 1)) (set acc (rf acc x))) acc)))) -(defn core-rationalize [x] x) (defn core-random-sample [prob & rest] (if (= 0 (length rest)) (core-filter (fn [_] (< (math/random) prob))) (core-filter (fn [_] (< (math/random) prob)) (in rest 0)))) (defn core-reader-conditional [form splicing?] @{:jolt/type :jolt/reader-conditional :form form :splicing? splicing?}) -(defn core-reader-conditional? [x] - (and (table? x) (= :jolt/reader-conditional (get x :jolt/type)))) +# reader-conditional? now lives in the Clojure collection tier (tagged-value predicate). (defn core-sorted-map-by [cmp & kvs] (apply core-sorted-map kvs)) (defn core-sorted-set-by [cmp & xs] (apply core-sorted-set xs)) (defn core-array-seq [arr & _] (core-seq arr)) @@ -1833,8 +1943,6 @@ (defn core-clojure-version [] "1.11.0-jolt") (defn core-munge [s] (string/replace-all "-" "_" (string s))) -(defn core-namespace-munge [s] - (string/replace-all "-" "_" (string s))) (defn core-test [v] (let [t (and (core-meta v) (get (core-meta v) :test))] (if t (do (t) :ok) :no-test))) @@ -1905,8 +2013,7 @@ (+= i 2)) atm) -(defn core-atom? [x] - (and (table? x) (= :jolt/atom (x :jolt/type)))) +# atom? now lives in the Clojure collection tier (tagged-value predicate). # Futures — run the body on a real OS thread (ev/thread) for true parallelism. # Janet threads have separate heaps, so the thunk and the state it closes over are @@ -1943,10 +2050,8 @@ (def res (fut :res)) (if (= :error (in res 0)) (error (in res 1)) (in res 1))) -(defn core-future-done? [x] - (if (core-future? x) (truthy? (x :cached)) - (error "future-done? requires a future"))) -(defn core-future-cancelled? [x] (and (core-future? x) (truthy? (x :cancelled)))) +# future-done? / future-cancelled? now live in the Clojure collection tier (pure +# reads of :cached/:cancelled). core-future? stays — deref/future-cancel call it. # Janet OS threads can't be interrupted, so the worker still runs to completion # in the background; we can only mark the *future* cancelled (done) so deref # raises and realized?/future-done?/future-cancelled? reflect it. Returns false @@ -1962,10 +2067,6 @@ false)) # future macro: (future body...) -> (future-call (fn* [] body...)) -(defn core-future [& body] - @[{:jolt/type :symbol :ns nil :name "future-call"} - @[{:jolt/type :symbol :ns nil :name "fn*"} [] ;body]]) - (defn core-deref [ref & opts] (cond (and (table? ref) (= :jolt/atom (ref :jolt/type))) @@ -2018,46 +2119,10 @@ (atom-notify-watches atm old-val new-val) new-val) -(defn core-reset-vals! [atm val] - (let [old-val (atm :value)] - (atom-validate atm val) - (put atm :value val) - (atom-notify-watches atm old-val val) - [old-val val])) - -(defn core-swap-vals! [atm f & args] - (var old-val (atm :value)) - (var new-val (apply f old-val args)) - (atom-validate atm new-val) - (put atm :value new-val) - (atom-notify-watches atm old-val new-val) - [old-val new-val]) - -(defn core-compare-and-set! [atm old-val new-val] - (if (= old-val (atm :value)) - (do - (atom-validate atm new-val) - (put atm :value new-val) - (atom-notify-watches atm old-val new-val) - true) - false)) - -(defn core-set-validator! [atm validator-fn] - (put atm :validator validator-fn) - nil) - -(defn core-get-validator [atm] - (atm :validator)) - -(defn core-add-watch [atm key watch-fn] - (let [watches (atm :watches)] - (put watches key watch-fn) - atm)) - -(defn core-remove-watch [atm key] - (let [watches (atm :watches)] - (put watches key nil) - atm)) +# Atom peripheral ops (swap-vals!/reset-vals!/compare-and-set!/get-validator/ +# add-watch/remove-watch/set-validator!) now live in the Clojure collection tier — +# composed over the native atom ops + jolt.host/ref-put!. atom/swap!/reset!/deref +# and the atom-validate/atom-notify-watches helpers stay native (compiler-critical). # ============================================================ # Threading macros (as regular functions? No, as macros in Clojure) @@ -2079,396 +2144,9 @@ (put gensym_counter :val (+ n 1)) {:jolt/type :symbol :ns nil :name (string prefix-string n)}) -(defn core-cond - "Macro: (cond test1 expr1 test2 expr2 ... :else default) - -> (if test1 expr1 (if test2 expr2 ...))" - [& clauses] - (defn build [cls] - (if (= 0 (length cls)) - nil - (let [t (first cls)] - (if (= :else t) - (if (> (length cls) 1) (in cls 1) nil) - (if (< (length cls) 2) - (error "cond requires an even number of forms") - (let [e (in cls 1)] - @[{:jolt/type :symbol :ns nil :name "if"} - t e - (build (tuple/slice cls 2))])))))) - (build clauses)) -(defn core-case - "Macro: (case expr val1 result1 ... default) - Supports single values, lists of values (one-of-many), and symbols." - [expr & clauses] - (def g (gensym)) - (defn make-const [c] - # case constants are literals, never evaluated: quote symbols and list - # literals (read as arrays) so e.g. `sym` and a wrapped list `(a b c)` match - # by value rather than resolving/calling. - (if (or (and (struct? c) (= :symbol (c :jolt/type))) (array? c)) - @[{:jolt/type :symbol :ns nil :name "quote"} c] - c)) - (defn make-test [c] - (if (array? c) - (let [or-args @[{:jolt/type :symbol :ns nil :name "or"}]] - (each v c - (array/push or-args @[{:jolt/type :symbol :ns nil :name "="} g (make-const v)])) - or-args) - @[{:jolt/type :symbol :ns nil :name "="} g (make-const c)])) - (defn build [cls] - (if (= 0 (length cls)) - nil - (if (= 1 (length cls)) - (first cls) - (let [c (first cls) - r (first (tuple/slice cls 1))] - @[{:jolt/type :symbol :ns nil :name "if"} - (make-test c) - r - (build (tuple/slice cls 2))])))) - @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses)]) - -(defn core-when - "Macro: (when test & body) -> (if test (do body...))" - [test & body] - (def arr (array ;body)) - (array/insert arr 0 {:jolt/type :symbol :ns nil :name "do"}) - @[{:jolt/type :symbol :ns nil :name "if"} - test - arr]) - -(defn core-when-not - "Macro: (when-not test & body) -> (when (not test) & body)" - [test & body] - (def not-form @[{:jolt/type :symbol :ns nil :name "not"} test]) - @[{:jolt/type :symbol :ns nil :name "if"} not-form - @[{:jolt/type :symbol :ns nil :name "do"} ;body]]) - -(defn core-and - "Macro: (and) -> true, (and x) -> x, (and x y ...) -> (if x (and y ...) x)" - [& exprs] - (if (= 0 (length exprs)) true - (if (= 1 (length exprs)) (first exprs) - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "and__x"} (first exprs)] - @[{:jolt/type :symbol :ns nil :name "if"} - {:jolt/type :symbol :ns nil :name "and__x"} - @[{:jolt/type :symbol :ns nil :name "and"} ;(tuple/slice exprs 1)] - {:jolt/type :symbol :ns nil :name "and__x"}]]))) - -(defn core-or - "Macro: (or) -> nil, (or x) -> x, (or x y ...) -> (let [or__x x] (if or__x or__x (or y ...)))" - [& exprs] - (if (= 0 (length exprs)) nil - (if (= 1 (length exprs)) (first exprs) - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "or__x"} (first exprs)] - @[{:jolt/type :symbol :ns nil :name "if"} - {:jolt/type :symbol :ns nil :name "or__x"} - {:jolt/type :symbol :ns nil :name "or__x"} - @[{:jolt/type :symbol :ns nil :name "or"} ;(tuple/slice exprs 1)]]]))) - -(defn core-if-let - "Macro: (if-let [binding val-expr] then else?)" - [bindings then-form & else-forms] - (def form-sym (in bindings 0)) - (def val-form (in bindings 1)) - @[{:jolt/type :symbol :ns nil :name "let*"} - @[form-sym val-form] - @[{:jolt/type :symbol :ns nil :name "if"} - form-sym - then-form - ;else-forms]]) - -(defn core-when-let - "Macro: (when-let [binding val-expr] & body)" - [bindings & body] - (def form-sym (in bindings 0)) - (def val-form (in bindings 1)) - @[{:jolt/type :symbol :ns nil :name "let*"} - @[form-sym val-form] - @[{:jolt/type :symbol :ns nil :name "when"} - form-sym - ;body]]) - -(defn core-if-some - "Macro: (if-some [binding val-expr] then else?)" - [bindings then-form & else-forms] - (def form-sym (in bindings 0)) - (def val-form (in bindings 1)) - @[{:jolt/type :symbol :ns nil :name "let*"} - @[form-sym val-form] - @[{:jolt/type :symbol :ns nil :name "if"} - @[{:jolt/type :symbol :ns nil :name "some?"} form-sym] - then-form - ;else-forms]]) - -(defn core-when-some - "Macro: (when-some [binding val-expr] & body)" - [bindings & body] - (def form-sym (in bindings 0)) - (def val-form (in bindings 1)) - @[{:jolt/type :symbol :ns nil :name "let*"} - @[form-sym val-form] - @[{:jolt/type :symbol :ns nil :name "when"} - @[{:jolt/type :symbol :ns nil :name "some?"} form-sym] - ;body]]) - -(defn core-doto - "Macro: (doto obj (method args)...) → let obj, call methods, return obj" - [obj & forms] - (def sym (gensym "doto")) - (def result @[{:jolt/type :symbol :ns nil :name "let*"} - @[sym obj]]) - (each f forms - (if (array? f) - # (doto x (f a b)) -> (f x a b) (thread x as first arg, not a method call) - (array/push result @[(first f) sym ;(tuple/slice f 1)]) - (array/push result @[f sym]))) - (array/push result sym) - result) - -(defn core-if-not - "Macro: (if-not test then else?) -> (if (not test) then else?)" - [test then-form & else-forms] - @[{:jolt/type :symbol :ns nil :name "if"} - @[{:jolt/type :symbol :ns nil :name "not"} test] - then-form - ;else-forms]) - -(defn core-when-first - "Macro: (when-first [sym coll] & body) -> (when-let [sym (first coll)] body...)" - [bindings & body] - (def sym (in bindings 0)) - (def coll-form (in bindings 1)) - @[{:jolt/type :symbol :ns nil :name "when-let"} - @[sym @[{:jolt/type :symbol :ns nil :name "first"} coll-form]] - ;body]) - -(defn core-condp - "Macro: (condp pred expr clause1 val1 ... default)" - [pred expr & clauses] - (def g (gensym)) - (defn build [cls] - (if (= 0 (length cls)) - nil - (if (= 1 (length cls)) - (first cls) - (let [c (first cls) - v (first (tuple/slice cls 1))] - @[{:jolt/type :symbol :ns nil :name "if"} - (if (and (struct? c) (= :symbol (c :jolt/type)) (= ":>>" (c :name))) - @[v g] - @[pred c g]) - v - (build (tuple/slice cls 2))])))) - @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses)]) - -(defn core-dotimes - "Macro: (dotimes [sym n] & body) -> loop from 0 to n-1" - [bindings & body] - (def sym (in bindings 0)) - (def n-form (in bindings 1)) - (def i (gensym)) - @[{:jolt/type :symbol :ns nil :name "let*"} - @[i n-form] - @[{:jolt/type :symbol :ns nil :name "loop*"} - @[sym 0] - @[{:jolt/type :symbol :ns nil :name "if"} - @[{:jolt/type :symbol :ns nil :name "<"} sym i] - @[{:jolt/type :symbol :ns nil :name "do"} - ;body - @[{:jolt/type :symbol :ns nil :name "recur"} - @[{:jolt/type :symbol :ns nil :name "inc"} sym]]] - nil]]]) - -(defn core-while - "Macro: (while test & body) -> loop while test is truthy" - [test & body] - @[{:jolt/type :symbol :ns nil :name "loop*"} - @[] - @[{:jolt/type :symbol :ns nil :name "when"} - test - @[{:jolt/type :symbol :ns nil :name "do"} ;body] - @[{:jolt/type :symbol :ns nil :name "recur"}]]]) - -(defn core-for - "Macro: (for [binding-form coll :when test :let [bindings]] body) - List comprehension. Basic support for :when and :let." - [bindings body] - (defn parse-groups [bvec] - (var groups @[]) - (var i 0) - (while (< i (length bvec)) - (def bind (bvec i)) - (var coll (bvec (+ i 1))) - (def mods @[]) - (+= i 2) - (while (and (< i (length bvec)) (keyword? (bvec i))) - (case (bvec i) - :when (do (array/push mods @[{:jolt/type :symbol :ns nil :name "when"} (bvec (+ i 1))]) (+= i 2)) - :let (do (array/push mods @[{:jolt/type :symbol :ns nil :name "let"} (bvec (+ i 1))]) (+= i 2)) - # :while terminates iteration of this binding's collection - :while (do (set coll @[{:jolt/type :symbol :ns nil :name "take-while"} - @[{:jolt/type :symbol :ns nil :name "fn"} [bind] (bvec (+ i 1))] - coll]) - (+= i 2)) - (do (+= i 1)))) - (array/push groups @[bind coll mods])) - groups) - (defn wrap-mods [mods inner-form] - (if (= 0 (length mods)) - inner-form - (let [m (in mods (- (length mods) 1)) - rest-mods (array/slice mods 0 (- (length mods) 1)) - kind (get (m 0) :name)] - (wrap-mods rest-mods - (if (= kind "when") - @[{:jolt/type :symbol :ns nil :name "if"} (m 1) - @[{:jolt/type :symbol :ns nil :name "list"} inner-form] @[]] - @[{:jolt/type :symbol :ns nil :name "let*"} (m 1) inner-form]))))) - (defn build [group-idx groups] - (if (>= group-idx (length groups)) - body - (let [g (in groups group-idx) - my-bind (in g 0) - my-coll (in g 1) - my-mods (in g 2) - inner (build (+ group-idx 1) groups) - inner-form (wrap-mods my-mods inner) - is-last (= group-idx (- (length groups) 1)) - has-mods (> (length my-mods) 0)] - (if (and is-last (not has-mods)) - @[{:jolt/type :symbol :ns nil :name "map"} - @[{:jolt/type :symbol :ns nil :name "fn"} [my-bind] inner-form] - my-coll] - @[{:jolt/type :symbol :ns nil :name "mapcat"} - @[{:jolt/type :symbol :ns nil :name "fn"} [my-bind] inner-form] - my-coll])))) - (if (>= (length bindings) 2) - (build 0 (parse-groups bindings)) - body)) - -(defn core-thread-first - "Macro: (-> x & forms) — thread first" - [x & forms] - (if (= 0 (length forms)) x - (let [f (first forms) - rest-forms (tuple/slice forms 1)] - (if (array? f) - (apply core-thread-first [(let [arr (array/slice f)] - (array/insert arr 1 x) - arr) ;rest-forms]) - (apply core-thread-first [@[f x] ;rest-forms]))))) - -(defn core-thread-last - "Macro: (->> x & forms) — thread last" - [x & forms] - (if (= 0 (length forms)) x - (let [f (first forms) - rest-forms (tuple/slice forms 1)] - (if (array? f) - (apply core-thread-last [(let [arr (array/slice f)] - (array/push arr x) - arr) ;rest-forms]) - (apply core-thread-last [@[f x] ;rest-forms]))))) - -(defn core-some-> - "Macro: (some-> expr & forms) — thread first, stop at nil" - [expr & forms] - (if (= 0 (length forms)) expr - (let [f (first forms) - rest-forms (tuple/slice forms 1)] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} expr] - @[{:jolt/type :symbol :ns nil :name "if"} - @[{:jolt/type :symbol :ns nil :name "some?"} - {:jolt/type :symbol :ns nil :name "some->__x"}] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} - (if (array? f) - (let [arr (array/slice f)] - (array/insert arr 1 {:jolt/type :symbol :ns nil :name "some->__x"}) - arr) - @[f {:jolt/type :symbol :ns nil :name "some->__x"}])] - (apply core-some-> [{:jolt/type :symbol :ns nil :name "some->__x"} ;rest-forms])] - nil]]))) - -(defn core-some->> - "Macro: (some->> expr & forms) — thread last, stop at nil" - [expr & forms] - (if (= 0 (length forms)) expr - (let [f (first forms) - rest-forms (tuple/slice forms 1)] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} expr] - @[{:jolt/type :symbol :ns nil :name "if"} - @[{:jolt/type :symbol :ns nil :name "some?"} - {:jolt/type :symbol :ns nil :name "some->__x"}] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} - (if (array? f) - (let [arr (array/slice f)] - (array/push arr {:jolt/type :symbol :ns nil :name "some->__x"}) - arr) - @[f {:jolt/type :symbol :ns nil :name "some->__x"}])] - (apply core-some->> [{:jolt/type :symbol :ns nil :name "some->__x"} ;rest-forms])] - nil]]))) - -(defn core-cond-> - "Macro: (cond-> expr test form ...) — thread first only when test is true" - [expr & clauses] - (def g (gensym)) - (defn build [cls result-form] - (if (= 0 (length cls)) - result-form - (let [t (first cls) - f (in cls 1) - f-call (if (array? f) - (let [arr (array/slice f)] - (array/insert arr 1 result-form) - arr) - @[f result-form])] - (build (tuple/slice cls 2) - @[{:jolt/type :symbol :ns nil :name "if"} - t - f-call - result-form])))) - @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses g)]) - -(defn core-cond->> - "Macro: (cond->> expr test form ...) — thread last only when test is true" - [expr & clauses] - (def g (gensym)) - (defn build [cls result-form] - (if (= 0 (length cls)) - result-form - (let [t (first cls) - f (in cls 1) - f-call (if (array? f) - (let [arr (array/slice f)] - (array/push arr result-form) - arr) - @[f result-form])] - (build (tuple/slice cls 2) - @[{:jolt/type :symbol :ns nil :name "if"} - t - f-call - result-form])))) - @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses g)]) - -(defn core-as-> - "Macro: (as-> expr name & forms) — bind name to expr, thread through forms" - [expr name & forms] - (defn build [fs acc] - (if (= 0 (length fs)) - acc - (let [f (first fs)] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[name acc] - (build (tuple/slice fs 1) f)]))) - (build forms expr)) +# if-let/when-let/if-some/when-some now live in the Clojure overlay +# (core/30-macros.clj) as defmacros. (defn core-push-thread-bindings [b] (push-thread-bindings b)) (defn core-pop-thread-bindings [] (pop-thread-bindings)) @@ -2482,65 +2160,6 @@ (defn core-intern [ns-name sym-name val] val) -(defn core-binding - "Macro: (binding [var val ...] body...) - Uses array-map (plain struct) to store binding frame - to avoid PHM get() incompatibility with var-get." - [bindings & body] - (def frame-pairs @[]) - (var i 0) - (let [n (length bindings)] - (while (< i n) - (array/push frame-pairs - @[{:jolt/type :symbol :ns nil :name "var"} (in bindings i)]) - (array/push frame-pairs (in bindings (+ i 1))) - (+= i 2))) - (def hm-form (array/insert frame-pairs 0 - {:jolt/type :symbol :ns nil :name "array-map"})) - @[{:jolt/type :symbol :ns nil :name "let*"} - [{:jolt/type :symbol :ns nil :name "frame"} hm-form] - @[{:jolt/type :symbol :ns nil :name "push-thread-bindings"} - {:jolt/type :symbol :ns nil :name "frame"}] - @[{:jolt/type :symbol :ns nil :name "try"} - @[{:jolt/type :symbol :ns nil :name "do"} ;body] - @[{:jolt/type :symbol :ns nil :name "finally"} - @[{:jolt/type :symbol :ns nil :name "pop-thread-bindings"}]]]]) - - -(defn- defn->def - "Shared expansion for defn/defn-: (name doc-string? attr-map? params body...) - or (name doc-string? attr-map? ([params] body)... attr-map?) -> (def name (fn* ...))." - [fn-name rest] - (var items (array/slice rest)) - # strip optional docstring - (when (and (> (length items) 0) (string? (first items))) - (set items (array/slice items 1))) - # strip optional attr-map (a map literal, i.e. struct/table that isn't a symbol) - (when (and (> (length items) 0) - (let [x (first items)] - (and (or (struct? x) (table? x)) - (not (and (struct? x) (= :symbol (get x :jolt/type))))))) - (set items (array/slice items 1))) - (def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"}]) - (if (and (> (length items) 0) (array? (first items)) (indexed? (first (first items)))) - # multi-arity: each remaining item is an ([params] body...) clause - (each pair items (array/push fn-form pair)) - # single-arity: items = [params-vector body...] - (do - (array/push fn-form (first items)) - (each b (tuple/slice items 1) (array/push fn-form b)))) - @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]) - -(defn core-defn - "Macro: (defn name doc-string? attr-map? [args] body...) (or multi-arity) - -> (def name (fn* ...))" - [fn-name & rest] - (defn->def fn-name rest)) - -# defn- — same as defn (private not enforced in Jolt) -(defn core-defn- [fn-name & rest] - (defn->def fn-name rest)) - # Hierarchy stubs for sci bootstrap (def core-make-hierarchy make-hierarchy) (defn core-derive @@ -2596,9 +2215,10 @@ (var new-obj @{}) (each k (keys obj) (put new-obj k (get obj k))) - # table/setproto requires a table, convert struct meta to table + # table/setproto requires a table, convert struct meta to table. meta may + # be nil (Clojure allows (with-meta obj nil) to clear metadata). (var meta-tab @{}) - (each k (keys meta) (put meta-tab k (get meta k))) + (when meta (each k (keys meta) (put meta-tab k (get meta k)))) (table/setproto new-obj meta-tab) (put new-obj :jolt/meta meta) new-obj))) @@ -2611,12 +2231,8 @@ # Volatiles — typed box so deref/volatile? can recognize them. (defn core-volatile! [v] @{:jolt/type :jolt/volatile :val v}) -(defn core-volatile? [x] (and (table? x) (= :jolt/volatile (x :jolt/type)))) -(defn core-vswap! [vol f & args] - (def new-val (apply f (vol :val) args)) - (put vol :val new-val) - new-val) -(defn core-vreset! [vol val] (put vol :val val) val) +# volatile? / vreset! / vswap! now live in the Clojure collection tier — vreset! +# over jolt.host/ref-put!, vswap! over vreset! + get. The constructor stays native. # Delays — created lazily by the `delay` macro; forced once via force/deref. (defn core-make-delay [thunk] @{:jolt/type :jolt/delay :fn thunk :realized false :val nil}) @@ -2635,139 +2251,29 @@ # Clojure's realized? is only defined on IPending; reject anything else. (error (string "realized? not supported on " (type x))))) -# delay macro: (delay body...) -> (make-delay (fn* [] body...)) -(defn core-delay [& body] - @[{:jolt/type :symbol :ns nil :name "make-delay"} - @[{:jolt/type :symbol :ns nil :name "fn*"} [] ;body]]) # Proxy stub — returns nil form (macro, args not evaluated) -(defn core-proxy [& args] nil) - # Thread stubs (def core-Thread (fn [& args] (struct ;[:jolt/type :jolt/thread]))) (def core-ThreadLocal (fn [& args] (struct ;[:jolt/type :jolt/thread-local]))) (def core-IllegalStateException (fn [& args] (struct ;[:jolt/type :jolt/exception]))) -# definterface stub — JVM-only, emits def form -(defn core-definterface [name-sym & body] - @[{:jolt/type :symbol :ns nil :name "def"} - name-sym - @{}]) - -# comment macro — ignores body, returns nil -(defn core-comment [& body] - nil) - -# defrecord — creates a proper type via deftype + factory functions -(defn core-defrecord [name-sym fields-vec & body] - (def type-name (name-sym :name)) - (def type-name-dot (string type-name ".")) - (def arrow-name (string "->" type-name)) - (def map-name (string "map->" type-name)) - - # (deftype TypeName [fields...]) - (def dt-form @[{:jolt/type :symbol :ns nil :name "deftype"} name-sym fields-vec]) - - # Arrow factory: (def ->TypeName (fn [field1 field2 ...] (TypeName. field1 field2 ...))) - (def arrow-call @[{:jolt/type :symbol :ns nil :name type-name-dot}]) - (each f fields-vec (array/push arrow-call f)) - (def arrow-sym {:jolt/type :symbol :ns nil :name arrow-name}) - (def arrow-body @[{:jolt/type :symbol :ns nil :name "fn"} fields-vec arrow-call]) - - # map-> factory: (def map->TypeName (fn [m] (->TypeName (get m :field1) (get m :field2) ...))) - (def map-call @[{:jolt/type :symbol :ns nil :name arrow-name}]) - (each f fields-vec - (array/push map-call @[{:jolt/type :symbol :ns nil :name "get"} {:jolt/type :symbol :ns nil :name (string "m")} (keyword (f :name))])) - (def map-sym {:jolt/type :symbol :ns nil :name map-name}) - # params must be a tuple (a vector), not an array — fn* treats an array - # first-arg as multi-arity clauses - (def map-body @[{:jolt/type :symbol :ns nil :name "fn"} [{:jolt/type :symbol :ns nil :name "m"}] map-call]) - - (def out @[{:jolt/type :symbol :ns nil :name "do"} - dt-form - @[{:jolt/type :symbol :ns nil :name "def"} arrow-sym arrow-body] - @[{:jolt/type :symbol :ns nil :name "def"} map-sym map-body]]) - # Process inline protocol/interface implementations: - # (defrecord T [fs] Proto (m [this] body) ... Proto2 (m2 [this] body)) - # Emit an extend-type per protocol. Each method body is wrapped in a let that - # binds the record's fields from the instance (first method param), matching - # Clojure's field-in-scope semantics for deftype/defrecord methods. - (var i 0) - (while (< i (length body)) - (def elem (in body i)) - (if (and (struct? elem) (= :symbol (elem :jolt/type))) - # protocol name; collect following method specs - (let [proto-sym elem - et @[{:jolt/type :symbol :ns nil :name "extend-type"} name-sym proto-sym]] - (++ i) - (while (and (< i (length body)) (not (and (struct? (in body i)) (= :symbol ((in body i) :jolt/type))))) - (let [spec (in body i) - mname (spec 0) - argv (spec 1) - mbody (tuple/slice spec 2) - instance (in argv 0) - # (let [f0 (core-get instance :f0) ...] body...) - field-binds @[] - _ (each f fields-vec - (array/push field-binds f) - (array/push field-binds @[{:jolt/type :symbol :ns nil :name "get"} - instance (keyword (f :name))])) - wrapped @[{:jolt/type :symbol :ns nil :name "let"} - (tuple/slice (tuple ;field-binds)) ;mbody]] - (array/push et @[mname argv wrapped])) - (++ i)) - (array/push out et)) - (++ i))) - out) # letfn — mutually-recursive local fns. Expands to let* of fn* bindings; jolt # closures capture the (shared, mutable) bindings table, so forward references # between the fns resolve at call time. -(defn core-letfn [specs & body] - (def binds @[]) - (each spec specs - (let [fname (spec 0) - rest (tuple/slice spec 1)] - (array/push binds fname) - # rest is either ([args] body...) for single-arity or a list of - # ([args] body) clauses for multi-arity; (fn* ;rest) handles both. - (array/push binds @[{:jolt/type :symbol :ns nil :name "fn*"} ;rest]))) - @[{:jolt/type :symbol :ns nil :name "let*"} (tuple/slice (tuple ;binds)) ;body]) # doseq — like `for` but eager and returns nil. Reuse `for`, force realization # with `count`, discard the result. -(defn core-doseq [bindings & body] - (def for-body @[{:jolt/type :symbol :ns nil :name "do"} ;body nil]) - @[{:jolt/type :symbol :ns nil :name "do"} - @[{:jolt/type :symbol :ns nil :name "count"} - @[{:jolt/type :symbol :ns nil :name "for"} bindings for-body]] - nil]) - # assert — (assert x) / (assert x message). Throws when x is falsy. -(defn core-assert [x & more] - (def msg-form - (if (> (length more) 0) - (first more) - (let [b @""] (pr-render b x) (string "Assert failed: " (string b))))) - @[{:jolt/type :symbol :ns nil :name "if"} - x - nil - @[{:jolt/type :symbol :ns nil :name "throw"} - @[{:jolt/type :symbol :ns nil :name "ex-info"} msg-form {}]]]) # resolve stub — returns nil (symbols not found in Jolt's clojure.core) (defn core-resolve [sym] nil) # shadowed by the resolve special form (needs ctx) -(defn core-ns-name [ns] - # ns object -> its name as a symbol (works whether ns is a table/struct/phm) - (let [nm (core-get ns :name)] - (if nm {:jolt/type :symbol :ns nil :name (string nm)} nil))) - -# update — works on both structs and tables -(defn core-update [m k f & args] - (def f (as-fn f)) - (core-assoc m k (apply f (core-get m k) args))) +# ns-name now lives in the Clojure collection tier (pure over get + symbol). +# update lives in the Clojure kernel tier — core/00-kernel.clj. update-in stays +# (it's recursive and has internal callers). (defn- ks-rest [ks] (if (tuple? ks) (tuple/slice ks 1) (array/slice ks 1))) @@ -2803,142 +2309,15 @@ (defn core-avoid-method-too-large [& args] @{}) # declare macro — accepts symbols, does nothing (forward declaration) -(defn core-declare [& syms] - @[{:jolt/type :symbol :ns nil :name "do"}]) -(defn core-fn - "Macro: (fn [args] body) → (fn* [args] body)" - [& args] - (def result @[]) - (array/push result {:jolt/type :symbol :ns nil :name "fn*"}) - (each a args (array/push result a)) - result) - -(defn core-let - "Macro: (let [bindings] body) → (let* [bindings] body)" - [bindings & body] - (def result @[]) - (array/push result {:jolt/type :symbol :ns nil :name "let*"}) - (array/push result bindings) - (each b body (array/push result b)) - result) - -(defn core-loop - "Macro: (loop [bindings] body) → (loop* [bindings] body)" - [bindings & body] - (def result @[]) - (array/push result {:jolt/type :symbol :ns nil :name "loop*"}) - (array/push result bindings) - (each b body (array/push result b)) - result) - -# Protocol implementation — methods dispatch via type registry -(defn core-defprotocol [protocol-name & sigs] - (def result @[]) - (array/push result {:jolt/type :symbol :ns nil :name "do"}) - (def methods @{}) - (each sig sigs - (def method-name (first sig)) - (def arglists (tuple/slice sig 1)) - (put methods (keyword (if (struct? method-name) (method-name :name) method-name)) {:name method-name :arglists arglists})) - (def proto-def @[]) - (array/push proto-def {:jolt/type :symbol :ns nil :name "def"}) - (array/push proto-def protocol-name) - (array/push proto-def @{:jolt/type :jolt/protocol - :name {:jolt/type :symbol :ns nil :name (protocol-name :name)} - :methods methods}) - (array/push result proto-def) - (each sig sigs - (def method-name (first sig)) - (def method-def @[]) - (array/push method-def {:jolt/type :symbol :ns nil :name "def"}) - (array/push method-def method-name) - (def fn-form @[]) - (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) - (array/push fn-form [{:jolt/type :symbol :ns nil :name "this"} {:jolt/type :symbol :ns nil :name "&"} {:jolt/type :symbol :ns nil :name "rest-args"}]) - (array/push fn-form @[ - {:jolt/type :symbol :ns nil :name "protocol-dispatch"} - protocol-name - method-name - {:jolt/type :symbol :ns nil :name "this"} - {:jolt/type :symbol :ns nil :name "rest-args"}]) - (array/push method-def fn-form) - (array/push result method-def)) - result) - -(defn core-extend-type [type-sym proto-sym & impls] - (def result @[{:jolt/type :symbol :ns nil :name "do"}]) - (each method-spec impls - (def method-name (method-spec 0)) - (def arg-vec (method-spec 1)) - (def body (tuple/slice method-spec 2)) - (def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body]) - (array/push result @[ - {:jolt/type :symbol :ns nil :name "register-method"} - type-sym - proto-sym - method-name - fn-form])) - result) - -(defn core-extend-protocol [proto-sym & type-impls] - (def result @[{:jolt/type :symbol :ns nil :name "do"}]) - (var i 0) - (while (< i (length type-impls)) - (let [type-sym (type-impls i) - methods (type-impls (+ i 1))] - # methods is a single method spec array or an array of method specs - # If the first element is a symbol (method name), treat as single spec - (if (and (struct? (methods 0)) (= :symbol ((methods 0) :jolt/type))) - (let [method-spec methods] - (def method-name (method-spec 0)) - (def arg-vec (method-spec 1)) - (def body (tuple/slice method-spec 2)) - (def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body]) - (array/push result @[ - {:jolt/type :symbol :ns nil :name "register-method"} - type-sym - proto-sym - method-name - fn-form])) - (each method-spec methods - (def method-name (method-spec 0)) - (def arg-vec (method-spec 1)) - (def body (tuple/slice method-spec 2)) - (def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body]) - (array/push result @[ - {:jolt/type :symbol :ns nil :name "register-method"} - type-sym - proto-sym - method-name - fn-form])))) - (+= i 2)) - result) - -(def core-extend (fn [& args] nil)) - -(defn core-reify [& forms] - # forms interleaves protocol-name symbols with method specs (name [args] body); - # collect every method spec (a list), tracking the first protocol for the tag. - (def result @[{:jolt/type :symbol :ns nil :name "do"}]) - (def methods @{}) - (var proto-sym nil) - (var i 0) - (while (< i (length forms)) - (def elem (in forms i)) - (if (and (struct? elem) (= :symbol (elem :jolt/type))) - (do (when (nil? proto-sym) (set proto-sym elem)) (++ i)) - (let [method-name (in elem 0) - arg-vec (in elem 1) - body (tuple/slice elem 2)] - (put methods (keyword (if (struct? method-name) (method-name :name) method-name)) - @{:fn* true :args arg-vec :body body}) - (++ i)))) - (array/push result @[ - {:jolt/type :symbol :ns nil :name "make-reified"} - proto-sym - methods]) - result) +# Build a protocol value (a self-evaluating tagged table). Exposed so the overlay +# `defprotocol` can construct one via a fn call rather than embedding a tagged +# struct literal (which the interpreter would try to re-evaluate). `methods` is a +# {kw {:name str}} map; only :name is consulted (by satisfies?). +(defn core-make-protocol [name-str methods] + @{:jolt/type :jolt/protocol + :name {:jolt/type :symbol :ns nil :name name-str} + :methods methods}) (def core-satisfies? (fn [proto-sym obj] false)) @@ -2989,16 +2368,6 @@ {:jolt/type :symbol :ns ns :name nm}) (error "symbol expects 1 or 2 args"))) -(defn core-split-at [n coll] - (let [c (realize-for-iteration coll) m (min n (length c))] - [(tuple/slice (tuple ;(array/slice c 0 m))) (tuple/slice (tuple ;(array/slice c m)))])) - -(defn core-split-with [pred coll] - (let [c (realize-for-iteration coll)] - (var i 0) - (while (and (< i (length c)) (truthy? (pred (in c i)))) (++ i)) - [(tuple/slice (tuple ;(array/slice c 0 i))) (tuple/slice (tuple ;(array/slice c i)))])) - (defn- td-take-nth [n] (fn [rf] (var i 0) @@ -3007,39 +2376,19 @@ (if keep (rf (a 0) (a 1)) (a 0))))))) (defn core-take-nth [n & rest] (if (= 0 (length rest)) (td-take-nth n) - (let [c (realize-for-iteration (in rest 0)) r @[]] - (var i 0) (while (< i (length c)) (array/push r (in c i)) (+= i n)) - (tuple/slice (tuple ;r))))) + (let [coll (in rest 0)] + # Option A: always lazy. + (defn tstep [c] + (fn [] + (if (seq-done? c) nil + (let [drop-n (lazy-from (core-drop n c))] + (if (seq-done? drop-n) @[(core-first c) nil] + @[(core-first c) (tstep drop-n)]))))) + (make-lazy-seq (tstep (lazy-from coll)))))) -(defn core-nthrest [coll n] - (when (not (number? n)) (error "nthrest requires a numeric count")) - (if (nil? coll) nil - (let [c (realize-for-iteration coll) - start (max 0 (min n (length c)))] # negative n -> whole coll - (tuple/slice (tuple ;(array/slice c start)))))) +# filterv now lives in the Clojure collection tier (core/20-coll.clj). -(defn core-nthnext [coll n] - (when (not (number? n)) (error "nthnext requires a numeric count")) - (let [r (core-nthrest coll n)] (if (or (nil? r) (= 0 (length r))) nil r))) - -(defn core-butlast [coll] - (let [c (realize-for-iteration coll)] - (if (<= (length c) 1) nil (tuple/slice (tuple ;(array/slice c 0 (- (length c) 1))))))) - -(defn core-filterv [pred coll] - (def pred (as-fn pred)) - (let [r @[]] (each x (realize-for-iteration coll) (when (truthy? (pred x)) (array/push r x))) - (make-vec r))) - -(defn core-mapv [f & colls] - (def f (as-fn f)) - (let [r @[]] - (if (= 1 (length colls)) - (each x (realize-for-iteration (colls 0)) (array/push r (f x))) - (let [cs (map realize-for-iteration colls) - n (min ;(map length cs))] - (var i 0) (while (< i n) (array/push r (apply f (map (fn [c] (in c i)) cs))) (++ i)))) - (make-vec r))) +# mapv lives in the Clojure kernel tier — core/00-kernel.clj. (defn- td-interpose [sep] (fn [rf] @@ -3049,19 +2398,15 @@ (do (set started true) (rf (a 0) (a 1)))))))) (defn core-interpose [sep & rest] (if (= 0 (length rest)) (td-interpose sep) - (let [items (realize-for-iteration (in rest 0)) r @[]] - (var first? true) - (each x items (if first? (set first? false) (array/push r sep)) (array/push r x)) - (tuple ;r)))) - -(defn core-some-search - "(some pred coll) — first truthy (pred x), else nil." - [pred coll] - (def pred (as-fn pred)) - (var result nil) - (each x (realize-for-iteration coll) - (let [r (pred x)] (when (truthy? r) (set result r) (break)))) - result) + (let [coll (in rest 0)] + # Option A: always lazy. + (defn istep [c need-sep] + (fn [] + (if (seq-done? c) nil + (if need-sep + @[sep (istep c false)] + @[(core-first c) (istep (core-rest c) true)])))) + (make-lazy-seq (istep (lazy-from coll) false))))) (defn core-keep "(keep f coll) — (f x) for each x, dropping nils. (keep f) is a transducer." @@ -3069,30 +2414,20 @@ (def f (as-fn f)) (if (= 0 (length rest)) (td-keep f) - (let [r @[]] - (each x (realize-for-iteration (in rest 0)) - (let [v (f x)] (when (not (nil? v)) (array/push r v)))) - (tuple ;r)))) + (let [coll (in rest 0)] + # Option A: always lazy. + (defn kstep [c] + (fn [] + (var cur c) (var found false) (var result nil) + (while (and (not found) (not (seq-done? cur))) + (let [v (f (core-first cur))] + (set cur (core-rest cur)) + (when (not (nil? v)) + (set found true) + (set result v)))) + (if found @[result (kstep cur)] nil))) + (make-lazy-seq (kstep (lazy-from coll)))))) -(defn core-interleave - "(interleave & colls) — take one from each in turn until the shortest ends." - [& colls] - (if (= 0 (length colls)) (tuple) - (let [cs (map realize-for-iteration colls) - n (min ;(map length cs)) - r @[]] - (var i 0) - (while (< i n) (each c cs (array/push r (in c i))) (++ i)) - (tuple ;r)))) - -(defn core-flatten - "(flatten coll) — fully flatten nested sequentials into one seq." - [coll] - (def r @[]) - (defn seqish? [x] (or (tuple? x) (array? x) (pvec? x) (lazy-seq? x))) - (defn step [x] (each e (realize-for-iteration x) (if (seqish? e) (step e) (array/push r e)))) - (when (seqish? coll) (step coll)) - (tuple ;r)) (defn core-empty [coll] (cond @@ -3106,8 +2441,7 @@ (table? coll) @{} nil)) -(defn core-not-empty [coll] - (if (or (nil? coll) (= 0 (core-count coll))) nil coll)) +# not-empty now lives in the Clojure collection tier (core/20-coll.clj). # rseq is defined only on vectors and sorted collections (Reversible). (defn core-rseq [coll] @@ -3128,16 +2462,7 @@ (-- i)) (tuple/slice (tuple ;c)))) -(defn core-replace [smap coll] - (let [c (realize-for-iteration coll) r @[]] - (each x c (array/push r (let [v (core-get smap x :jolt/nf)] (if (= v :jolt/nf) x v)))) - (tuple/slice (tuple ;r)))) - -(defn core-some-fn [& preds] - (fn [& xs] - (var hit nil) - (each p preds (each x xs (when (and (nil? hit) (truthy? (p x))) (set hit (p x))))) - hit)) +# some-fn now lives in the Clojure collection tier (core/20-coll.clj). (defn core-sequential? [x] (or (tuple? x) (array? x) (pvec? x) (plist? x) (lazy-seq? x))) # Associative = maps and (real) vectors only. pvec is a literal/built vector; @@ -3150,10 +2475,6 @@ (and (struct? x) (= :symbol (x :jolt/type))))) (defn core-indexed? [x] (or (tuple? x) (array? x) (pvec? x))) -(defn core-distinct? [& xs] - (var seen @{}) (var ok true) - (each x xs (if (get seen x) (set ok false) (put seen x true))) - ok) # With a single item, Clojure returns it WITHOUT calling f. On ties, the last # extremal item wins (>=/<= update), matching Clojure. @@ -3162,53 +2483,17 @@ # asymmetry reproduces the JVM's NaN-ordering behavior. Janet's < / > are used # directly (NaN comparisons are false, never throwing). # keys must be numbers (NaN allowed) — like Clojure, which compares them with . -(defn core-min-key [f & xs] - (def f (as-fn f)) - (when (= 0 (length xs)) (error "min-key requires at least one value")) - (if (= 1 (length xs)) (first xs) - (do (var v (in xs 0)) (var kv (need-num (f v) "min-key")) - (let [y (in xs 1) ky (need-num (f y) "min-key")] (when (not (< kv ky)) (set v y) (set kv ky))) - (var i 2) - (while (< i (length xs)) - (let [w (in xs i) kw (need-num (f w) "min-key")] (when (<= kw kv) (set v w) (set kv kw))) - (++ i)) - v))) +# min-key / max-key now live in the Clojure collection tier (core/20-coll.clj). -(defn core-max-key [f & xs] - (def f (as-fn f)) - (when (= 0 (length xs)) (error "max-key requires at least one value")) - (if (= 1 (length xs)) (first xs) - (do (var v (in xs 0)) (var kv (need-num (f v) "max-key")) - (let [y (in xs 1) ky (need-num (f y) "max-key")] (when (not (> kv ky)) (set v y) (set kv ky))) - (var i 2) - (while (< i (length xs)) - (let [w (in xs i) kw (need-num (f w) "max-key")] (when (>= kw kv) (set v w) (set kv kw))) - (++ i)) - v))) - -(defn core-not-every? [pred coll] - (def pred (as-fn pred)) - (not (do (var ok true) (each x (realize-for-iteration coll) (when (not (truthy? (pred x))) (set ok false))) ok))) - -(defn core-not-any? [pred coll] - (def pred (as-fn pred)) - (do (var none true) (each x (realize-for-iteration coll) (when (truthy? (pred x)) (set none false))) none)) - -(defn core-vary-meta [obj f & args] - (let [m (core-meta obj)] (core-with-meta obj (apply f m args)))) +# vary-meta / namespace-munge now live in the Clojure collection tier +# (core/20-coll.clj) — pure compositions of meta/with-meta and str/map. # Exceptions (ex-info / ex-data / ex-message) (defn core-ex-info [msg data & more] @{:jolt/type :jolt/ex-info :message msg :data data :cause (if (> (length more) 0) (in more 0) nil)}) -(defn core-ex-info? [x] (and (table? x) (= :jolt/ex-info (x :jolt/type)))) -(defn- unwrap-ex [e] - (if (and (or (table? e) (struct? e)) (= :jolt/exception (get e :jolt/type))) (get e :value) e)) -(defn core-ex-data [e] - (let [e (unwrap-ex e)] (if (core-ex-info? e) (e :data) nil))) -(defn core-ex-message [e] - (let [e (unwrap-ex e)] - (cond (core-ex-info? e) (e :message) (string? e) e nil))) +# ex-data / ex-message / ex-cause now live in the Clojure collection tier +# (core/20-coll.clj) — pure over get on the tagged value the constructor builds. # String split/replace that accept either a literal string or a regex value. (defn core-str-split [pat s] @@ -3261,14 +2546,6 @@ (var parts @[]) (each x xs (array/push parts (str-render-one x))) (string/join parts " ")) (defn core-memfn [& args] (error "memfn: JVM method handles are not supported in Jolt")) -(defn core-seq-to-map-for-destructuring [s] - # used by {:keys [...]} destructuring over a seq of k/v pairs - (if (core-sequential? s) - (let [items (realize-for-iteration s) m @{}] - (var i 0) - (while (< (+ i 1) (length items)) (put m (in items i) (in items (+ i 1))) (+= i 2)) - (table/to-struct m)) - s)) (defn core-eduction [& args] # (eduction xform* coll): apply the composed transducers eagerly to coll (let [n (length args) @@ -3281,7 +2558,6 @@ (defn core-construct-proxy [c & args] (error "construct-proxy: not supported in Jolt")) (defn core-init-proxy [proxy mappings] proxy) (defn core-get-proxy-class [& interfaces] (error "get-proxy-class: not supported in Jolt")) -(defn core-undefined? [x] false) (def- char-escapes {10 "\\n" 9 "\\t" 13 "\\r" 12 "\\f" 8 "\\b" 34 "\\\"" 92 "\\\\"}) @@ -3326,17 +2602,6 @@ (defn core-dorun [a & rest] (let [coll (if (= 0 (length rest)) a (in rest 0))] (realize-for-iteration coll) nil)) -(defn core-run! [f coll] - (each x (realize-for-iteration coll) (f x)) nil) - -(defn core-tree-seq [branch? children root] - (def out @[]) - (defn walk [node] - (array/push out node) - (when (truthy? (branch? node)) - (each c (realize-for-iteration (children node)) (walk c)))) - (walk root) - (tuple ;out)) # Map entries (represented as 2-element vectors) # key/val require a map entry (a 2-element vector/tuple in Jolt); Clojure throws @@ -3354,11 +2619,6 @@ (let [c (realize-for-iteration coll)] (in c (math/floor (* (math/random) (length c)))))) -(defn core-replicate [n x] (tuple ;(map (fn [_] x) (range n)))) - -(defn core-bounded-count [n coll] - (let [c (realize-for-iteration coll)] (min n (length c)))) - (defn core-counted? [x] (or (pvec? x) (plist? x) (phm? x) (set? x) (tuple? x) (array? x) (string? x))) # Reversible (supports rseq) = vectors and sorted collections. @@ -3368,17 +2628,11 @@ (struct? x) (lazy-seq? x) (string? x) (and (table? x) (or (get x :jolt/type) (get x :jolt/deftype))))) -# Numeric predicates (Jolt has no ratios/bigdec, so those are always false) -(defn core-nat-int? [x] (and (intval? x) (>= x 0))) -(defn core-pos-int? [x] (and (intval? x) (> x 0))) -(defn core-neg-int? [x] (and (intval? x) (< x 0))) +# Numeric predicates (Jolt has no ratios/bigdec). nat-int?/pos-int?/neg-int?/ +# ratio?/decimal?/rational? live in the Clojure collection tier (core/20-coll.clj). (defn core-double? [x] (and (number? x) (not (intval? x)))) (defn core-float? [x] (and (number? x) (not (intval? x)))) -(defn core-ratio? [x] false) -(defn core-decimal? [x] false) -(defn core-rational? [x] (intval? x)) (defn core-infinite? [x] (and (number? x) (= (math/abs x) math/inf))) -(defn core-NaN? [x] (if (number? x) (not= x x) (error "NaN? requires a number"))) # Jolt has no ratio type, so numerator/denominator have no valid input (Clojure # requires a Ratio and throws otherwise). (defn core-numerator [x] (error "numerator requires a ratio (Jolt has no ratios)")) @@ -3401,19 +2655,12 @@ (defn core-special-symbol? [x] (and (core-symbol? x) (= true (get special-syms (x :name))))) -(defn core-record? [x] (and (table? x) (not (nil? (get x :jolt/deftype))))) +# record? now lives in the Clojure collection tier (tagged-value predicate). # Promise: single-threaded box backed by an atom (deref returns nil until set). (defn core-promise [] (core-atom nil)) (defn core-deliver [p v] (core-reset! p v) p) -(defn core-comparator [pred] - (fn [a b] (cond (truthy? (pred a b)) -1 (truthy? (pred b a)) 1 true 0))) -(defn core-completing [rf & cf] - (let [c (if (> (length cf) 0) (in cf 0) (fn [x] x))] - (fn [& a] (case (length a) 0 (rf) 1 (c (in a 0)) (rf (in a 0) (in a 1)))))) -(defn core-keyword-identical? [a b] (= a b)) -(defn core-object? [x] false) (defn core-tagged-literal [tag form] @{:jolt/type :jolt/tagged-literal :tag tag :form form}) (defn core-ensure-reduced [x] (if (core-reduced? x) x (core-reduced x))) (defn core-halt-when [pred & rest] @@ -3466,8 +2713,8 @@ (put (t :tbl) (canon-key (vnth x 0)) @[(vnth x 0) (vnth x 1)]) # a map: merge all its entries (or (phm? x) (and (struct? x) (nil? (get x :jolt/type)))) - (each k (if (phm? x) (keys (phm-to-struct x)) (keys x)) - (put (t :tbl) (canon-key k) @[k (if (phm? x) (phm-get x k) (in x k))])) + (each e (map-entries-of x) + (put (t :tbl) (canon-key (in e 0)) @[(in e 0) (in e 1)])) (error "conj! on a transient map requires a [key value] pair or a map"))) t) @@ -3553,7 +2800,6 @@ (defn core-hash-unordered-coll [coll] (var h 0) (each x (realize-for-iteration coll) (set h (band (+ h (h24 x)) 0xffffff))) h) -(defn core-ex-cause [e] (and (table? e) (get e :cause))) (defn core-prefers [mm-var] (or (get mm-var :jolt/prefers) {})) (defn core-random-uuid [] @@ -3605,7 +2851,6 @@ "quot" core-quot "max" core-max "min" core-min - "abs" core-abs "rand" core-rand "rand-int" core-rand-int "=" core-= @@ -3622,26 +2867,22 @@ "contains?" core-contains? "count" core-count "partition-all" core-partition-all - "reductions" core-reductions - "dedupe" core-dedupe "keep-indexed" core-keep-indexed "map-indexed" core-map-indexed "cycle" core-cycle - "reduce-kv" core-reduce-kv - "peek" core-peek "pop" core-pop - "subvec" core-subvec "trampoline" core-trampoline "format" core-format - "letfn" core-letfn - "doseq" core-doseq - "assert" core-assert "first" core-first "rest" core-rest "next" core-next "cons" core-cons "seq" core-seq "vec" core-vec + "__sq1" core-sq1 + "__sqcat" core-sqcat + "__sqvec" core-sqvec + "__sqmap" core-sqmap "into" core-into "merge" core-merge "merge-with" core-merge-with @@ -3655,47 +2896,27 @@ "remove" core-remove "reduce" core-reduce "apply" core-apply - "second" core-second "doall" core-doall "dorun" core-dorun - "run!" core-run! - "tree-seq" core-tree-seq "key" core-key "val" core-val "map-entry?" core-map-entry? "rand-nth" core-rand-nth - "replicate" core-replicate - "bounded-count" core-bounded-count "counted?" core-counted? "reversible?" core-reversible? "seqable?" core-seqable? - "nat-int?" core-nat-int? - "pos-int?" core-pos-int? - "neg-int?" core-neg-int? "double?" core-double? "float?" core-float? - "ratio?" core-ratio? - "decimal?" core-decimal? - "rational?" core-rational? "infinite?" core-infinite? - "NaN?" core-NaN? "numerator" core-numerator "denominator" core-denominator "list*" core-list* "special-symbol?" core-special-symbol? - "record?" core-record? "promise" core-promise "deliver" core-deliver - "future" core-future "future-call" core-future-call "future?" core-future? - "future-done?" core-future-done? "future-cancel" core-future-cancel - "future-cancelled?" core-future-cancelled? - "comparator" core-comparator - "completing" core-completing - "keyword-identical?" core-keyword-identical? - "object?" core-object? "tagged-literal" core-tagged-literal "ensure-reduced" core-ensure-reduced "unreduced" core-unreduced @@ -3727,23 +2948,11 @@ "hash-combine" core-hash-combine "hash-ordered-coll" core-hash-ordered-coll "hash-unordered-coll" core-hash-unordered-coll - "ex-cause" core-ex-cause "prefers" core-prefers "random-uuid" core-random-uuid - "ffirst" core-ffirst - "nfirst" core-nfirst - "fnext" core-fnext - "nnext" core-nnext - "last" core-last - "drop-last" core-drop-last - "take-last" core-take-last "interpose" core-interpose "mapcat" core-mapcat - "some" core-some-search "keep" core-keep - "interleave" core-interleave - "flatten" core-flatten - "every-pred" core-every-pred "find" core-find "transduce" core-transduce "sequence" core-sequence @@ -3757,41 +2966,21 @@ "sorted?" core-sorted-map? "reduced" core-reduced "reduced?" core-reduced? - "split-at" core-split-at - "split-with" core-split-with "take-nth" core-take-nth - "nthrest" core-nthrest - "nthnext" core-nthnext - "butlast" core-butlast - "filterv" core-filterv - "mapv" core-mapv "empty" core-empty - "not-empty" core-not-empty "rseq" core-rseq "shuffle" core-shuffle - "replace" core-replace - "some-fn" core-some-fn "sequential?" core-sequential? "associative?" core-associative? "ifn?" core-ifn? "indexed?" core-indexed? - "distinct?" core-distinct? - "min-key" core-min-key - "max-key" core-max-key - "not-every?" core-not-every? - "not-any?" core-not-any? - "vary-meta" core-vary-meta "ex-info" core-ex-info - "ex-data" core-ex-data - "ex-message" core-ex-message "prn-str" core-prn-str "println-str" core-println-str - "volatile?" core-volatile? "force" core-force "realized?" core-realized? "delay?" core-delay? "make-delay" core-make-delay - "delay" core-delay "take" core-take "drop" core-drop "take-while" core-take-while @@ -3802,8 +2991,6 @@ "sort" core-sort "sort-by" core-sort-by "distinct" core-distinct - "group-by" core-group-by - "frequencies" core-frequencies "partition" core-partition "partition-by" core-partition-by "range" core-range @@ -3815,7 +3002,6 @@ "complement" core-complement "comp" core-comp "partial" core-partial - "juxt" core-juxt "memoize" core-memoize "vector" core-vector "hash-map" core-hash-map @@ -3825,10 +3011,10 @@ "list" core-list "set?" core-set? "disj" core-disj - "lazy-seq" core-lazy-seq - "lazy-cat" core-lazy-cat "coll->cells" coll->cells "make-lazy-seq" make-lazy-seq + "lazy-cons" lazy-cons + "lazy-from" lazy-from "str" core-str "name" core-name "subs" core-subs @@ -3854,9 +3040,6 @@ "prn" core-prn "pr-str" core-pr-str # Java-style arrays (buffers for bytes, arrays otherwise) - "alength" core-alength - "aget" core-aget - "aset" core-aset "aclone" core-aclone "object-array" core-object-array "int-array" core-int-array @@ -3900,7 +3083,6 @@ "chunk-buffer" core-chunk-buffer "chunk-append" core-chunk-append "chunk" core-chunk - "chunked-seq?" core-chunked-seq? "chunk-first" core-chunk-first "chunk-rest" core-chunk-rest "chunk-next" core-chunk-next @@ -3908,10 +3090,8 @@ "boolean" core-boolean "cat" core-cat "disj!" core-disj! - "rationalize" core-rationalize "random-sample" core-random-sample "reader-conditional" core-reader-conditional - "reader-conditional?" core-reader-conditional? "sorted-map-by" core-sorted-map-by "sorted-set-by" core-sorted-set-by "array-seq" core-array-seq @@ -3920,7 +3100,6 @@ "class" core-class "clojure-version" core-clojure-version "munge" core-munge - "namespace-munge" core-namespace-munge "test" core-test "enumeration-seq" core-enumeration-seq "iterator-seq" core-iterator-seq @@ -3936,14 +3115,12 @@ "==" core-numeric= "print-str" core-print-str "memfn" core-memfn - "seq-to-map-for-destructuring" core-seq-to-map-for-destructuring "eduction" core-eduction "->Eduction" core->Eduction "proxy-super" core-proxy-super "construct-proxy" core-construct-proxy "init-proxy" core-init-proxy "get-proxy-class" core-get-proxy-class - "undefined?" core-undefined? "char-escape-string" core-char-escape-string "char-name-string" core-char-name-string "subseq" core-subseq @@ -3976,44 +3153,10 @@ # Hash "hash" core-hash "atom" core-atom - "atom?" core-atom? "deref" core-deref "reset!" core-reset! "swap!" core-swap! - "swap-vals!" core-swap-vals! - "reset-vals!" core-reset-vals! - "compare-and-set!" core-compare-and-set! - "set-validator!" core-set-validator! - "get-validator" core-get-validator - "add-watch" core-add-watch - "remove-watch" core-remove-watch "not" core-not - "and" core-and - "or" core-or - "cond" core-cond - "case" core-case - "for" core-for - "when" core-when - "when-not" core-when-not - "if-not" core-if-not - "when-first" core-when-first - "if-let" core-if-let - "when-let" core-when-let - "if-some" core-if-some - "when-some" core-when-some - "doto" core-doto - "condp" core-condp - "dotimes" core-dotimes - "while" core-while - "->" core-thread-first - "->>" core-thread-last - "some->" core-some-> - "some->>" core-some->> - "cond->" core-cond-> - "cond->>" core-cond->> - "as->" core-as-> - "defn" core-defn - "defn-" core-defn- "derive" core-derive "isa?" core-isa? "parents" core-parents @@ -4027,32 +3170,16 @@ "remove-all-methods" core-remove-all-methods "prefer-method" core-prefer-method "Object" core-Object - "declare" core-declare - "fn" core-fn - "let" core-let - "loop" core-loop - "defprotocol" core-defprotocol - "extend-type" core-extend-type - "extend-protocol" core-extend-protocol - "extend" core-extend - "reify" core-reify + "make-protocol" core-make-protocol "satisfies?" core-satisfies? "extends?" core-extends? "implements?" core-implements? "type->str" core-type->str "volatile!" core-volatile! - "vswap!" core-vswap! - "vreset!" core-vreset! - "proxy" core-proxy "Thread" core-Thread "ThreadLocal" core-ThreadLocal "IllegalStateException" core-IllegalStateException - "definterface" core-definterface - "defrecord" core-defrecord - "comment" core-comment "resolve" core-resolve - "ns-name" core-ns-name - "update" core-update "update-in" core-update-in "assoc-in" core-assoc-in "fnil" core-fnil @@ -4065,15 +3192,11 @@ "simple-symbol?" core-simple-symbol? "qualified-keyword?" core-qualified-keyword? "simple-keyword?" core-simple-keyword? - "ident?" core-ident? - "qualified-ident?" core-qualified-ident? - "simple-ident?" core-simple-ident? "inst?" core-inst? "inst-ms" core-inst-ms "uri?" core-uri? "uuid?" core-uuid? "bytes?" core-bytes? - "tagged-literal?" core-tagged-literal? "meta" core-meta "var-get" core-var-get "var-set" core-var-set @@ -4083,7 +3206,6 @@ "alter-meta!" core-alter-meta! "reset-meta!" core-reset-meta! "intern" core-intern - "binding" core-binding "push-thread-bindings" core-push-thread-bindings "pop-thread-bindings" core-pop-thread-bindings # Dynamic vars — stubs for SCI bootstrap @@ -4096,9 +3218,10 @@ "*assert" true}) (defn core-macro-names - "Set of core binding names that are macros." + "Set of core binding names that are macros. Empty now that every core macro + lives in the Clojure overlay (clojure.core.*-syntax / *-macros tiers)." [] - @{"and" true "or" true "cond" true "case" true "for" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true "binding" true "lazy-seq" true "lazy-cat" true "if-not" true "when-first" true "condp" true "dotimes" true "while" true "some->" true "some->>" true "cond->" true "cond->>" true "as->" true "->" true "->>" true "letfn" true "doseq" true "delay" true "assert" true "future" true}) + @{}) (def init-core! (fn [& args] diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index f86eb87..4c8bcc9 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -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)) @[] diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet new file mode 100644 index 0000000..ff1b37e --- /dev/null +++ b/src/jolt/host_iface.janet @@ -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) diff --git a/src/jolt/loader.janet b/src/jolt/loader.janet index b2197a3..a2b9d07 100644 --- a/src/jolt/loader.janet +++ b/src/jolt/loader.janet @@ -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) diff --git a/src/jolt/main.janet b/src/jolt/main.janet index a9a1f5d..e80ea42 100644 --- a/src/jolt/main.janet +++ b/src/jolt/main.janet @@ -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] diff --git a/src/jolt/phm.janet b/src/jolt/phm.janet index a4a24bd..886f4a6 100644 --- a/src/jolt/phm.janet +++ b/src/jolt/phm.janet @@ -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 # ============================================================ diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet index 45016fd..569ee18 100644 --- a/src/jolt/reader.janet +++ b/src/jolt/reader.janet @@ -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) diff --git a/src/jolt/stdlib_embed.janet b/src/jolt/stdlib_embed.janet index e63c239..6dd5eb6 100644 --- a/src/jolt/stdlib_embed.janet +++ b/src/jolt/stdlib_embed.janet @@ -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)) diff --git a/src/jolt/types.janet b/src/jolt/types.janet index 41ab0fe..11746b6 100644 --- a/src/jolt/types.janet +++ b/src/jolt/types.janet @@ -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." diff --git a/test/bench/core-bench.janet b/test/bench/core-bench.janet new file mode 100644 index 0000000..d995b10 --- /dev/null +++ b/test/bench/core-bench.janet @@ -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)) diff --git a/test/clojure-stdlib/clojure/data_test/diff.cljc b/test/clojure-stdlib/clojure/data_test/diff.cljc new file mode 100644 index 0000000..0b0415a --- /dev/null +++ b/test/clojure-stdlib/clojure/data_test/diff.cljc @@ -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))))) diff --git a/test/clojure-stdlib/clojure/edn_test/read_string.cljc b/test/clojure-stdlib/clojure/edn_test/read_string.cljc new file mode 100644 index 0000000..515af5e --- /dev/null +++ b/test/clojure-stdlib/clojure/edn_test/read_string.cljc @@ -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"))))) diff --git a/test/clojure-stdlib/clojure/walk_test/walk.cljc b/test/clojure-stdlib/clojure/walk_test/walk.cljc new file mode 100644 index 0000000..49a584e --- /dev/null +++ b/test/clojure-stdlib/clojure/walk_test/walk.cljc @@ -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]))))) diff --git a/test/clojure-stdlib/clojure/zip_test/zip.cljc b/test/clojure-stdlib/clojure/zip_test/zip.cljc new file mode 100644 index 0000000..076eb79 --- /dev/null +++ b/test/clojure-stdlib/clojure/zip_test/zip.cljc @@ -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) diff --git a/test/integration/aot-test.janet b/test/integration/aot-test.janet new file mode 100644 index 0000000..95c1588 --- /dev/null +++ b/test/integration/aot-test.janet @@ -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!") diff --git a/test/integration/bootstrap-fixpoint-test.janet b/test/integration/bootstrap-fixpoint-test.janet new file mode 100644 index 0000000..cf5a510 --- /dev/null +++ b/test/integration/bootstrap-fixpoint-test.janet @@ -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))) diff --git a/test/integration/clojure-stdlib-suite-test.janet b/test/integration/clojure-stdlib-suite-test.janet new file mode 100644 index 0000000..1b4417e --- /dev/null +++ b/test/integration/clojure-stdlib-suite-test.janet @@ -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")) diff --git a/test/integration/clojure-test-suite-test.janet b/test/integration/clojure-test-suite-test.janet index dc80557..07bf4ba 100644 --- a/test/integration/clojure-test-suite-test.janet +++ b/test/integration/clojure-test-suite-test.janet @@ -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 @[]))) diff --git a/test/integration/compile-mode-test.janet b/test/integration/compile-mode-test.janet index b83aa75..b663a42 100644 --- a/test/integration/compile-mode-test.janet +++ b/test/integration/compile-mode-test.janet @@ -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!") diff --git a/test/integration/conformance-test.janet b/test/integration/conformance-test.janet index f3de4e6..81fa206 100644 --- a/test/integration/conformance-test.janet +++ b/test/integration/conformance-test.janet @@ -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)) diff --git a/test/integration/direct-linking-test.janet b/test/integration/direct-linking-test.janet new file mode 100644 index 0000000..0bb1fe5 --- /dev/null +++ b/test/integration/direct-linking-test.janet @@ -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")) diff --git a/test/integration/dispatch-cache-test.janet b/test/integration/dispatch-cache-test.janet new file mode 100644 index 0000000..680a777 --- /dev/null +++ b/test/integration/dispatch-cache-test.janet @@ -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)")) diff --git a/test/integration/lazy-infinite-test.janet b/test/integration/lazy-infinite-test.janet new file mode 100644 index 0000000..a29a5dd --- /dev/null +++ b/test/integration/lazy-infinite-test.janet @@ -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)) diff --git a/test/integration/self-host-test.janet b/test/integration/self-host-test.janet new file mode 100644 index 0000000..3e0518d --- /dev/null +++ b/test/integration/self-host-test.janet @@ -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!") diff --git a/test/integration/staged-bootstrap-test.janet b/test/integration/staged-bootstrap-test.janet new file mode 100644 index 0000000..7f2a54c --- /dev/null +++ b/test/integration/staged-bootstrap-test.janet @@ -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)")) diff --git a/test/integration/suite-worker.janet b/test/integration/suite-worker.janet index bfa0b5b..8a515e5 100644 --- a/test/integration/suite-worker.janet +++ b/test/integration/suite-worker.janet @@ -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)")) diff --git a/test/spec/control-flow-spec.janet b/test/spec/control-flow-spec.janet index 7b25174..ed21b78 100644 --- a/test/spec/control-flow-spec.janet +++ b/test/spec/control-flow-spec.janet @@ -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))"] diff --git a/test/spec/destructuring-spec.janet b/test/spec/destructuring-spec.janet index 0f3393b..31d8afd 100644 --- a/test/spec/destructuring-spec.janet +++ b/test/spec/destructuring-spec.janet @@ -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]]" diff --git a/test/spec/exceptions-spec.janet b/test/spec/exceptions-spec.janet index 7df5e47..ce89a14 100644 --- a/test/spec/exceptions-spec.janet +++ b/test/spec/exceptions-spec.janet @@ -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\")"]) diff --git a/test/spec/host-interop-spec.janet b/test/spec/host-interop-spec.janet index 7de9922..b9a297d 100644 --- a/test/spec/host-interop-spec.janet +++ b/test/spec/host-interop-spec.janet @@ -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)"]) diff --git a/test/spec/macros-spec.janet b/test/spec/macros-spec.janet index cd409ad..e21f5c0 100644 --- a/test/spec/macros-spec.janet +++ b/test/spec/macros-spec.janet @@ -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)))"]) diff --git a/test/spec/maps-spec.janet b/test/spec/maps-spec.janet index b165f59..afc9fd7 100644 --- a/test/spec/maps-spec.janet +++ b/test/spec/maps-spec.janet @@ -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})"]) diff --git a/test/spec/metadata-spec.janet b/test/spec/metadata-spec.janet index b3df3b5..aa1b4b5 100644 --- a/test/spec/metadata-spec.janet +++ b/test/spec/metadata-spec.janet @@ -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: diff --git a/test/spec/predicates-spec.janet b/test/spec/predicates-spec.janet index 3ca0536..fd8ea0a 100644 --- a/test/spec/predicates-spec.janet +++ b/test/spec/predicates-spec.janet @@ -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])"] diff --git a/test/spec/sequences-spec.janet b/test/spec/sequences-spec.janet index 8f78525..c016906 100644 --- a/test/spec/sequences-spec.janet +++ b/test/spec/sequences-spec.janet @@ -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])"]) diff --git a/test/spec/strings-spec.janet b/test/spec/strings-spec.janet index e57b6e6..18f247d 100644 --- a/test/spec/strings-spec.janet +++ b/test/spec/strings-spec.janet @@ -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\")"]) diff --git a/test/spec/vectors-spec.janet b/test/spec/vectors-spec.janet index 8debf03..90572d8 100644 --- a/test/spec/vectors-spec.janet +++ b/test/spec/vectors-spec.janet @@ -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)"] diff --git a/test/support/lazy-eval.janet b/test/support/lazy-eval.janet new file mode 100644 index 0000000..f656ce6 --- /dev/null +++ b/test/support/lazy-eval.janet @@ -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))) diff --git a/test/unit/types-test.janet b/test/unit/types-test.janet index aa35266..4acd864 100644 --- a/test/unit/types-test.janet +++ b/test/unit/types-test.janet @@ -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})] diff --git a/vendor/clojure-test-suite b/vendor/clojure-test-suite new file mode 160000 index 0000000..e20ea02 --- /dev/null +++ b/vendor/clojure-test-suite @@ -0,0 +1 @@ +Subproject commit e20ea0289e57fe5c8b78e66865176bb7af42939d