Scrub dangling Janet references; drop dead Janet-coupled files
Rephrase comments that pointed at deleted Janet files (emit.janet, the seed
sources, 'the Janet back end punts ...') to present-tense descriptions of the
Chez behavior. Comment/docstring-only; the self-host fixpoint is unchanged
(comments don't affect the compiled seed).
Delete five files that were Janet-host shims with no Chez path: clojure.java.io
(provided natively by host/chez/io.ss), and jolt.{nrepl,png,interop,shell}
(the janet.* bridge, os/shell, janet.net — none exist on Chez).
jolt-cf1q.6
This commit is contained in:
parent
750ce05716
commit
48e2ef5910
53 changed files with 418 additions and 675 deletions
198
foundational-runtime-handoff.md
Normal file
198
foundational-runtime-handoff.md
Normal file
|
|
@ -0,0 +1,198 @@
|
||||||
|
# Foundational Runtime Epic — Handoff
|
||||||
|
|
||||||
|
**Epic:** jolt-5vsp · **Predecessor:** jolt-ffn (targeted specialization — concluded)
|
||||||
|
**Date:** 2026-06-16
|
||||||
|
|
||||||
|
This is a cold-start handoff. Read it top to bottom before touching code. Its
|
||||||
|
whole point is to keep the fresh session from re-running the experiments that
|
||||||
|
already came back flat, and to start from the one measurement that actually
|
||||||
|
tells us where to invest.
|
||||||
|
|
||||||
|
## Why this epic exists
|
||||||
|
|
||||||
|
The targeted-specialization epic (jolt-ffn) tried to close jolt's constant-factor
|
||||||
|
gap vs JVM Clojure with per-form compiler passes. Three independent attempts all
|
||||||
|
came back flat:
|
||||||
|
|
||||||
|
| Attempt | Bead | Result |
|
||||||
|
|---|---|---|
|
||||||
|
| Record field-read guard removal (bare field reads) | jolt-3ko | ~3% on dispatch (shipped #141 — kept for correctness, not speed) |
|
||||||
|
| Protocol inline cache (runtime, per-method) | jolt-ez5h | ~0% — the per-dispatch gen-check exactly cancels the find-protocol-method saving; `find` was never the bottleneck |
|
||||||
|
| Record-ctor descriptor-baking (fewer allocs/record) | jolt-p7fo | flat on binary-trees + broke the gate; reverted |
|
||||||
|
|
||||||
|
The conclusion: **the gap is structural to jolt-on-Janet, not a missing
|
||||||
|
optimization.** Targeted passes remove only the cheap parts; the structural floor
|
||||||
|
remains.
|
||||||
|
|
||||||
|
## The scorecard (jolt / JVM Clojure)
|
||||||
|
|
||||||
|
Regenerate any time with `JVM=1 bench/run.sh` (the absolute-reference mode).
|
||||||
|
|
||||||
|
| Axis | Bench | jolt/JVM |
|
||||||
|
|---|---|---|
|
||||||
|
| Pure float compute | `mandelbrot` | **~15× ← THE FLOOR** |
|
||||||
|
| Persistent collections (HAMT) | `collections` | ~28× |
|
||||||
|
| Recursion (call + arith) | `fib` | ~37× |
|
||||||
|
| Megamorphic dispatch | `dispatch` | ~76× |
|
||||||
|
| Monomorphic dispatch | `mono-dispatch` | ~109× |
|
||||||
|
| Allocation / GC | `binary-trees` | ~314× (≈150× at depth 10) |
|
||||||
|
|
||||||
|
`mandelbrot` is the floor: pure tight arithmetic loops — no dispatch, no
|
||||||
|
allocation, no collections — and native arith already fires (jolt-3pl). So ~15×
|
||||||
|
is what jolt's *execution substrate* costs on the simplest possible workload.
|
||||||
|
Every other axis adds structural overhead **on top** of that floor.
|
||||||
|
|
||||||
|
**Machine caveat:** the dev machine swaps heavily (~13 GB). Alloc-heavy benches
|
||||||
|
(`binary-trees`, `collections`) inflate badly; light benches (`mandelbrot`,
|
||||||
|
`fib`, `dispatch`) are trustworthy. Get absolute alloc numbers on a clean machine.
|
||||||
|
|
||||||
|
## The four structural walls
|
||||||
|
|
||||||
|
1. **Bytecode-VM execution.** jolt's backend emits **Janet** (a register-bytecode
|
||||||
|
VM) and runs it on the Janet interpreter loop — no JIT, no native code. Every
|
||||||
|
op is bytecode dispatch. This is the `mandelbrot` 15× floor.
|
||||||
|
2. **Mark-sweep GC.** Janet's GC scans all live objects each cycle (no
|
||||||
|
generations). Live-data + alloc-heavy workloads (`binary-trees` retains the
|
||||||
|
tree) pay O(live) per GC. The JVM's generational GC makes young-object churn
|
||||||
|
nearly free.
|
||||||
|
3. **Indirect calls.** Protocol dispatch and fn calls go through indirection
|
||||||
|
(closures, the protocol registry). The JVM inlines/devirtualizes. jolt's
|
||||||
|
devirt (jolt-41m) only fires on *statically*-proven monomorphic sites;
|
||||||
|
`reduce`/`mapv` over a collection doesn't give that proof, so the common
|
||||||
|
runtime-monomorphic case pays full dispatch (that's why `mono-dispatch` is
|
||||||
|
*worse* than megamorphic — the JVM inline-caches it to near-free, jolt doesn't).
|
||||||
|
4. **Boxed / generic representations.** Records are tuples `[descriptor field…]`;
|
||||||
|
field access goes through a tag guard unless the type is proven. Generic ops
|
||||||
|
carry runtime type checks. (Open question: are Janet *numbers* boxed? Verify
|
||||||
|
in the spike — it decides whether unboxing is a lever or already done.)
|
||||||
|
|
||||||
|
## Foundational levers (ranked)
|
||||||
|
|
||||||
|
1. **Native codegen — emit C, not Janet bytecode.** The Stalin approach. Compile
|
||||||
|
jolt IR → C → machine code via the system compiler. The *only* lever that
|
||||||
|
moves the 15× compute floor; could approach C/JVM speed on compute-bound code.
|
||||||
|
Massive (a new backend). Plausible incremental shape: a jolt-IR→C compiler for
|
||||||
|
*hot* fns with a fallback to the existing bytecode path for unsupported forms —
|
||||||
|
mirroring today's interpret/compile hybrid. Needs to confirm Janet's C-API /
|
||||||
|
native-module story can be targeted incrementally.
|
||||||
|
2. **Structural GC-pressure reduction.** Value-type small records (avoid heap),
|
||||||
|
transient/editable-node hot paths (RFC 0003 future work — pvec/phm/sorted are
|
||||||
|
now tries/HAMT/RB, so O(1) `transient`/`persistent!` via editable nodes is
|
||||||
|
open). Helps the alloc-bound axes (`binary-trees`, `collections`). Does **not**
|
||||||
|
touch the compute floor.
|
||||||
|
3. **Deeper devirt + body inline.** Propagate element/return types so devirt
|
||||||
|
fires on runtime-monomorphic collections, then inline the method body
|
||||||
|
(jolt-4x9 element types + jolt-t6r). Helps dispatch. Bounded ceiling (still
|
||||||
|
bytecode underneath).
|
||||||
|
|
||||||
|
## STATUS (2026-06-16) — lever 1 (native codegen) built and working
|
||||||
|
|
||||||
|
The spike ran and lever 1 is now implemented. Full writeups:
|
||||||
|
`docs/foundational-runtime-spike-results.md` (floor localization) and
|
||||||
|
`docs/foundational-runtime-lever1-native-codegen.md` (native codegen).
|
||||||
|
|
||||||
|
Done (all merged to main, PRs #143–#148):
|
||||||
|
- **Floor localized:** the 15.4× decomposes into a **Janet-VM floor ≈10.8× JVM**
|
||||||
|
(only native codegen moves it) + a **jolt loop-lowering ≈1.43×** (cheap backend
|
||||||
|
win, bead **jolt-v28u**). Janet numbers are already unboxed (not a lever).
|
||||||
|
- **Native codegen (jolt-ihdp, CLOSED):** `src/jolt/cgen.janet` translates
|
||||||
|
numeric-leaf fns (numeric in/out, native-op arithmetic + loop/recur/if/let/do)
|
||||||
|
to C. Wired into the backend `:def` emit under **`JOLT_CGEN=1`** (opt-in). The
|
||||||
|
`.so` is content-addressed + cached. **mandelbrot 224ms → 12.4ms (~18×)**,
|
||||||
|
beats JVM. Leaf-first falls out free (callers stay bytecode, call native fn).
|
||||||
|
- **Build-time AOT (jolt-a7ds, partial):** `:cgen-collect?` records leaf fns at
|
||||||
|
build, `aot-build` compiles them into one `.so` + manifest; `:cgen-prebuilt` +
|
||||||
|
`load-aot` install them at deploy with **no cc** (proven with cc off PATH).
|
||||||
|
|
||||||
|
Open work under epic jolt-5vsp:
|
||||||
|
- **jolt-a7ds** — fuse the prebuilt `.so` + manifest into the `jpm` exe for a
|
||||||
|
literal single binary (+ a `jolt cgen-build -m app` CLI). The heaviest piece;
|
||||||
|
into jpm executable-build, not the compiler.
|
||||||
|
- **jolt-v28u** — `while`-loop lowering for tail `recur` (cheap ~30%, independent
|
||||||
|
of cgen; helps ALL loops, not just cgen candidates).
|
||||||
|
- **jolt-l1l4** — widen cgen numeric grammar (mod/rem/bit-ops/min/max, mixed fns).
|
||||||
|
- **jolt-qx70** — hot-fn auto-detection (drop the global `JOLT_CGEN` knob).
|
||||||
|
- Lever 2 (GC-pressure) and lever 3 (deeper devirt) — untouched; see below.
|
||||||
|
|
||||||
|
The original spike instructions are preserved below for context.
|
||||||
|
|
||||||
|
**Localize the 15× floor.** Build three `mandelbrot` implementations and compare:
|
||||||
|
|
||||||
|
- **jolt-compiled** `mandelbrot` (already in `bench/mandelbrot.clj`),
|
||||||
|
- **hand-written Janet** `mandelbrot` (the same nested loop, idiomatic Janet —
|
||||||
|
write it directly, no jolt),
|
||||||
|
- **JVM Clojure** `mandelbrot`.
|
||||||
|
|
||||||
|
Two ratios fall out:
|
||||||
|
|
||||||
|
- **jolt-emitted-Janet vs hand-Janet** → how much overhead jolt's *backend* adds
|
||||||
|
over optimal Janet. To see jolt's emitted Janet, use the backend emit path
|
||||||
|
(`backend/emit-ir` on the analyzed `run`/`count-point` fns) — note `:arities`
|
||||||
|
etc. are jolt pvecs, so introspection is awkward; easier to read the emitted
|
||||||
|
Janet via the compile path or just A/B the timings.
|
||||||
|
- **hand-Janet vs JVM** → the Janet VM's own floor.
|
||||||
|
|
||||||
|
Decision:
|
||||||
|
|
||||||
|
- If **hand-Janet ≈ jolt** and hand-Janet is ~15× JVM → the floor is **Janet's
|
||||||
|
bytecode VM**. Native codegen (lever 1) is the only fix. Commit to the spike of
|
||||||
|
a jolt-IR→C path for one hot fn and measure.
|
||||||
|
- If **jolt ≫ hand-Janet** → jolt's backend emits suboptimal Janet; there's
|
||||||
|
headroom in the **backend** (cheaper, no new runtime). Find what it emits that
|
||||||
|
hand-Janet doesn't.
|
||||||
|
|
||||||
|
Also measure the **GC share** on `binary-trees` (Janet GC stats around the run —
|
||||||
|
`(gccollect)` / `gcinterval`, or count allocations) to size lever 2 honestly.
|
||||||
|
|
||||||
|
## Key files / mechanisms
|
||||||
|
|
||||||
|
- **Backend (IR → Janet emit):** `src/jolt/backend.janet`. `native-ops` (~L322)
|
||||||
|
emits native Janet arith; `emit-ir` (~L674) runs passes then emits. A native-C
|
||||||
|
backend would branch here.
|
||||||
|
- **Passes / inference:** `jolt-core/jolt/passes.clj` (`run-passes`),
|
||||||
|
`jolt-core/jolt/passes/types.clj` (inference; the `:fn` branch ~L527 now seeds
|
||||||
|
^Record param hints — #141), `jolt-core/jolt/passes/inline.clj`
|
||||||
|
(scalar-replace, `ctor-shape`).
|
||||||
|
- **Record representation:** `src/jolt/types_protocols.janet` — `make-record`
|
||||||
|
(~L145, the ~5-alloc/record path), `record-shape-for` (~L139, rebuilds its
|
||||||
|
cache key every call), `record-tag`. Records are tuples `[descriptor field…]`.
|
||||||
|
- **Dispatch + ctors:** `src/jolt/eval_runtime.janet` —
|
||||||
|
`protocol-dispatch-impl` (~L62), `make-deftype-ctor-impl` (~L382).
|
||||||
|
- **Config knobs:** `src/jolt/config.janet` — `JOLT_DIRECT_LINK`,
|
||||||
|
`JOLT_WHOLE_PROGRAM`, `JOLT_OPTIMIZE`, the `ctx-shaping-env-vars` list (any new
|
||||||
|
ctx-shaping env var MUST be added there and to `image-cache-path`).
|
||||||
|
- **Self-hosting design:** `docs/self-hosting-compiler.md` (the kernel/value-layer
|
||||||
|
boundary), `docs/rfc/0003-transients.md` (editable-node future work).
|
||||||
|
|
||||||
|
## How to build, run, measure
|
||||||
|
|
||||||
|
```sh
|
||||||
|
jpm build # build/jolt (ctx baked, ~20ms startup); from-source is ~8s cold
|
||||||
|
export PATH="$PWD/build:$PATH"
|
||||||
|
bench/run.sh # jolt only, WP on
|
||||||
|
JVM=1 bench/run.sh # jolt vs JVM scorecard (needs `clojure` on PATH)
|
||||||
|
bench/run.sh mandelbrot 400 # one bench, custom size
|
||||||
|
JOLT_WHOLE_PROGRAM=0 bench/run.sh # measure what WP buys
|
||||||
|
```
|
||||||
|
|
||||||
|
Gate: `jpm build; janet run-tests.janet` (parallel, ~100s; `JOLT_TEST_JOBS`
|
||||||
|
overrides). Bench memory hygiene (`bd memories bench-isolation-gotcha`): never run
|
||||||
|
a perf matrix while other CPU work runs — it starves later configs and produces
|
||||||
|
bogus numbers. Sandwich A/B/A.
|
||||||
|
|
||||||
|
## What NOT to repeat (already flat — see beads for detail)
|
||||||
|
|
||||||
|
- Runtime protocol inline cache (jolt-ez5h): gen-check cancels the saving.
|
||||||
|
- Field-read guard removal as a *speed* play (jolt-3ko): ~3%; machinery dominates.
|
||||||
|
(The #141 change is kept for correctness + the `with-meta`-on-symbols fix.)
|
||||||
|
- `make-record` descriptor-baking (jolt-p7fo): flat — `binary-trees` is dominated
|
||||||
|
by the live retained tree + GC, not the short-lived intermediate allocs.
|
||||||
|
|
||||||
|
## Open questions for the spike
|
||||||
|
|
||||||
|
- Are Janet numbers boxed? (Lever or already done.)
|
||||||
|
- Does Janet expose a native-module / C-codegen path jolt can target incrementally
|
||||||
|
(hot fns → C, rest → bytecode)?
|
||||||
|
- What fraction of `binary-trees` is GC vs execution?
|
||||||
|
- Is there a cheaper record representation (Janet struct vs tuple-with-descriptor)
|
||||||
|
that lowers field-read + alloc cost without a new backend?
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
;; No mature Chez fibers library exists, and this Chez is a threaded build, so a
|
;; No mature Chez fibers library exists, and this Chez is a threaded build, so a
|
||||||
;; `go` block is just an OS thread and a channel is a mutex+condition blocking
|
;; `go` block is just an OS thread and a channel is a mutex+condition blocking
|
||||||
;; queue: <! / >! are the blocking <!! / >!! (they "park" by blocking the thread).
|
;; queue: <! / >! are the blocking <!! / >!! (they "park" by blocking the thread).
|
||||||
;; Like the Janet stackful-fiber model, <! / >! work ANYWHERE (no CPS transform) —
|
;; <! / >! work ANYWHERE (no CPS transform) —
|
||||||
;; here because they are ordinary blocking calls. Real parallelism, shared heap.
|
;; here because they are ordinary blocking calls. Real parallelism, shared heap.
|
||||||
;; Trade-off: one OS thread per go block (fine for typical use / conformance, not
|
;; Trade-off: one OS thread per go block (fine for typical use / conformance, not
|
||||||
;; for thousands of simultaneous go blocks).
|
;; for thousands of simultaneous go blocks).
|
||||||
|
|
@ -13,7 +13,7 @@
|
||||||
;; buffers never block the putter. A transducer is applied on the put side.
|
;; buffers never block the putter. A transducer is applied on the put side.
|
||||||
;;
|
;;
|
||||||
;; The fns are def-var!'d into clojure.core.async; go/go-loop/thread are macros
|
;; The fns are def-var!'d into clojure.core.async; go/go-loop/thread are macros
|
||||||
;; (mark-macro!) expanding to go-spawn, mirroring src/jolt/async.janet. Loaded after
|
;; (mark-macro!) expanding to go-spawn. Loaded after
|
||||||
;; concurrency.ss (reuses ms->duration). Requires a threaded Chez build.
|
;; concurrency.ss (reuses ms->duration). Requires a threaded Chez build.
|
||||||
|
|
||||||
;; --- buffers ----------------------------------------------------------------
|
;; --- buffers ----------------------------------------------------------------
|
||||||
|
|
@ -49,7 +49,7 @@
|
||||||
|
|
||||||
;; A transducer is a jolt fn (xform); (xform add-rf) yields the channel's reducing
|
;; A transducer is a jolt fn (xform); (xform add-rf) yields the channel's reducing
|
||||||
;; fn. add-rf: 0-arg init, 1-arg completion, 2-arg step (enqueue the output). A
|
;; fn. add-rf: 0-arg init, 1-arg completion, 2-arg step (enqueue the output). A
|
||||||
;; `reduced` step result closes the channel. Mirrors async.janet make-add-rf.
|
;; `reduced` step result closes the channel.
|
||||||
(define (ac-make-add-rf ch)
|
(define (ac-make-add-rf ch)
|
||||||
(lambda args
|
(lambda args
|
||||||
(cond ((null? args) ch) ; init
|
(cond ((null? args) ch) ; init
|
||||||
|
|
@ -135,8 +135,8 @@
|
||||||
(else ac-poll-empty))))
|
(else ac-poll-empty))))
|
||||||
|
|
||||||
;; (alts! [ch ...]) — take from whichever channel is ready first; returns
|
;; (alts! [ch ...]) — take from whichever channel is ready first; returns
|
||||||
;; [value channel] (value nil if that channel closed). Take-only (like the Janet
|
;; [value channel] (value nil if that channel closed). Take-only.
|
||||||
;; impl). Polls with a 1ms backoff — no cross-channel wait-set yet.
|
;; Polls with a 1ms backoff — no cross-channel wait-set yet.
|
||||||
(define ac-1ms (make-time 'time-duration 1000000 0))
|
(define ac-1ms (make-time 'time-duration 1000000 0))
|
||||||
(define (jolt-async-alts chans)
|
(define (jolt-async-alts chans)
|
||||||
(let ((cs (seq->list (jolt-seq chans))))
|
(let ((cs (seq->list (jolt-seq chans))))
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
;; atoms (jolt-9ziu) — host-coupled mutable reference cells for the Chez host.
|
;; atoms (jolt-9ziu) — host-coupled mutable reference cells for the Chez host.
|
||||||
;;
|
;;
|
||||||
;; atom/deref/swap!/reset! stay in the Janet seed (not the clojure.core overlay),
|
;; atom/deref/swap!/reset! are host primitives (not the clojure.core overlay),
|
||||||
;; so the Chez runtime needs native shims, def-var!'d into clojure.core. They
|
;; so the Chez runtime provides native shims, def-var!'d into clojure.core. They
|
||||||
;; lower to var-deref in prelude mode. The hierarchy machinery
|
;; lower to var-deref in prelude mode. The hierarchy machinery
|
||||||
;; (global-hierarchy = (atom (make-hierarchy))) calls `atom` at the prelude's
|
;; (global-hierarchy = (atom (make-hierarchy))) calls `atom` at the prelude's
|
||||||
;; LOAD time, so without this shim the whole prelude fails to load.
|
;; LOAD time, so without this shim the whole prelude fails to load.
|
||||||
|
|
@ -42,7 +42,7 @@
|
||||||
(error #f "Invalid reference state"))))
|
(error #f "Invalid reference state"))))
|
||||||
|
|
||||||
;; notify each watch (k ref old new), in insertion order (alist is reverse-built,
|
;; notify each watch (k ref old new), in insertion order (alist is reverse-built,
|
||||||
;; so walk it reversed to match add order — matches the seed's :pairs iteration).
|
;; so walk it reversed to match add order).
|
||||||
(define (jolt-atom-notify a old new)
|
(define (jolt-atom-notify a old new)
|
||||||
(for-each (lambda (kv) (jolt-invoke (cdr kv) (car kv) a old new))
|
(for-each (lambda (kv) (jolt-invoke (cdr kv) (car kv) a old new))
|
||||||
(reverse (jolt-atom-watches a))))
|
(reverse (jolt-atom-watches a))))
|
||||||
|
|
@ -65,7 +65,7 @@
|
||||||
|
|
||||||
;; (swap! a f arg*): JVM-style CAS loop — read, compute f OUTSIDE the lock, then
|
;; (swap! a f arg*): JVM-style CAS loop — read, compute f OUTSIDE the lock, then
|
||||||
;; atomically compare-and-set; retry if another thread changed it. Validate the
|
;; atomically compare-and-set; retry if another thread changed it. Validate the
|
||||||
;; new value before storing, notify watches after (the seed order).
|
;; new value before storing, notify watches after.
|
||||||
(define (jolt-swap! a f . args)
|
(define (jolt-swap! a f . args)
|
||||||
(let retry ()
|
(let retry ()
|
||||||
(let* ((old (jolt-atom-val a))
|
(let* ((old (jolt-atom-val a))
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@
|
||||||
;; compiler image from the .clj/.ss sources using the ON-CHEZ compiler (emit-image.ss),
|
;; compiler image from the .clj/.ss sources using the ON-CHEZ compiler (emit-image.ss),
|
||||||
;; writing fresh artifacts. No Janet is invoked: read -> analyze -> emit all run on
|
;; writing fresh artifacts. No Janet is invoked: read -> analyze -> emit all run on
|
||||||
;; Chez. The seed is a JOINT fixpoint, so a rebuild from an up-to-date seed
|
;; Chez. The seed is a JOINT fixpoint, so a rebuild from an up-to-date seed
|
||||||
;; reproduces it byte-for-byte (test/chez/bootstrap-test.janet checks this); when
|
;; reproduces it byte-for-byte (`make selfhost` checks this); when
|
||||||
;; the sources change, run it twice to reconverge and re-mint the seed.
|
;; the sources change, run it twice to reconverge and re-mint the seed.
|
||||||
;;
|
;;
|
||||||
;; Run from the repo root:
|
;; Run from the repo root:
|
||||||
|
|
|
||||||
|
|
@ -205,7 +205,7 @@
|
||||||
((pset? coll) (pset-conj coll x))
|
((pset? coll) (pset-conj coll x))
|
||||||
;; a list/seq conjs by PREPENDING (seq.ss: cseq / empty-list). conj onto a
|
;; a list/seq conjs by PREPENDING (seq.ss: cseq / empty-list). conj onto a
|
||||||
;; list stays a list, conj onto a lazy/realized seq yields a seq cell (a
|
;; list stays a list, conj onto a lazy/realized seq yields a seq cell (a
|
||||||
;; Cons) — list?-preserving, matching the seed.
|
;; Cons) — list?-preserving.
|
||||||
((cseq? coll) (if (cseq-list? coll) (cseq-list x coll) (cseq-realized x coll)))
|
((cseq? coll) (if (cseq-list? coll) (cseq-list x coll) (cseq-realized x coll)))
|
||||||
((empty-list-t? coll) (cseq-list x jolt-nil))
|
((empty-list-t? coll) (cseq-list x jolt-nil))
|
||||||
((pmap? coll)
|
((pmap? coll)
|
||||||
|
|
|
||||||
|
|
@ -115,7 +115,7 @@
|
||||||
(loop (cdr fs) (jolt-compile-eval-form (car fs) ns)))))
|
(loop (cdr fs) (jolt-compile-eval-form (car fs) ns)))))
|
||||||
;; runtime defmacro: def the expander fn + mark the var a macro so subsequent
|
;; runtime defmacro: def the expander fn + mark the var a macro so subsequent
|
||||||
;; forms expand it (hc-macro? reads var-macro-table). Mirrors emit-image.ss
|
;; forms expand it (hc-macro? reads var-macro-table). Mirrors emit-image.ss
|
||||||
;; ei-emit-ns and the Janet seed eval-defmacro.
|
;; ei-emit-ns.
|
||||||
((ce-macro-form? form)
|
((ce-macro-form? form)
|
||||||
(let-values (((nm fn-form) (ce-defmacro->fn form)))
|
(let-values (((nm fn-form) (ce-defmacro->fn form)))
|
||||||
(def-var! ns nm (jolt-compile-eval-form fn-form ns))
|
(def-var! ns nm (jolt-compile-eval-form fn-form ns))
|
||||||
|
|
@ -132,7 +132,7 @@
|
||||||
|
|
||||||
;; clojure.core/load-string: read every form from the source string and compile+
|
;; clojure.core/load-string: read every form from the source string and compile+
|
||||||
;; eval each in the current ns, returning the last value (nil for blank input).
|
;; eval each in the current ns, returning the last value (nil for blank input).
|
||||||
;; Mirrors src/jolt/api.janet load-string (the parse-next loop). jolt-r8ku.
|
;; jolt-r8ku.
|
||||||
(define (jolt-load-string s)
|
(define (jolt-load-string s)
|
||||||
(let loop ((src s) (result jolt-nil))
|
(let loop ((src s) (result jolt-nil))
|
||||||
(let ((pn (jolt-parse-next src)))
|
(let ((pn (jolt-parse-next src)))
|
||||||
|
|
|
||||||
|
|
@ -45,7 +45,7 @@
|
||||||
(cond
|
(cond
|
||||||
((jolt-nil? a) jolt-nil)
|
((jolt-nil? a) jolt-nil)
|
||||||
((keyword? a) a)
|
((keyword? a) a)
|
||||||
;; a 1-arg string splits on the FIRST "/" into ns/name, like the seed
|
;; a 1-arg string splits on the FIRST "/" into ns/name:
|
||||||
;; (keyword "x/y") => :x/y with ns "x" — destructure's {:keys [x/y]} builds
|
;; (keyword "x/y") => :x/y with ns "x" — destructure's {:keys [x/y]} builds
|
||||||
;; the key this way, so without the split the namespaced key never matches.
|
;; the key this way, so without the split the namespaced key never matches.
|
||||||
((string? a)
|
((string? a)
|
||||||
|
|
@ -79,7 +79,7 @@
|
||||||
((= (length args) 2) (jolt-symbol (car args) (cadr args)))
|
((= (length args) 2) (jolt-symbol (car args) (cadr args)))
|
||||||
(else (error #f "symbol: wrong arity"))))
|
(else (error #f "symbol: wrong arity"))))
|
||||||
|
|
||||||
;; gensym: per-process counter, like the seed's gensym_counter.
|
;; gensym: per-process counter.
|
||||||
(define jolt-gensym-counter 0)
|
(define jolt-gensym-counter 0)
|
||||||
(define (jolt-gensym . prefix)
|
(define (jolt-gensym . prefix)
|
||||||
(let ((p (if (null? prefix) "G__" (car prefix))))
|
(let ((p (if (null? prefix) "G__" (car prefix))))
|
||||||
|
|
|
||||||
|
|
@ -3,11 +3,11 @@
|
||||||
;; to a :host-call; the Chez emit routes a non-shimmed :host-call through
|
;; to a :host-call; the Chez emit routes a non-shimmed :host-call through
|
||||||
;; record-method-dispatch. This file extends that dispatcher with the collection
|
;; record-method-dispatch. This file extends that dispatcher with the collection
|
||||||
;; arms the interpreter's dispatch-member covers but the record/string base does
|
;; arms the interpreter's dispatch-member covers but the record/string base does
|
||||||
;; not, mirroring src/jolt/interop/collections.janet precedence exactly:
|
;; not, with this precedence:
|
||||||
;;
|
;;
|
||||||
;; * collection interop wins first — count/seq/nth/get/valAt/containsKey on a
|
;; * collection interop wins first — count/seq/nth/get/valAt/containsKey on a
|
||||||
;; vector/map/set/seq/record (so (. {:count 9} count) is the entry count, 1,
|
;; vector/map/set/seq/record (so (. {:count 9} count) is the entry count, 1,
|
||||||
;; like the seed, NOT the :count field).
|
;; NOT the :count field).
|
||||||
;; * field access — a "-name" member reads the field (records and maps).
|
;; * field access — a "-name" member reads the field (records and maps).
|
||||||
;; * map member — a stored fn is a method (called with self + args); any
|
;; * map member — a stored fn is a method (called with self + args); any
|
||||||
;; other value is returned as a field.
|
;; other value is returned as a field.
|
||||||
|
|
@ -20,7 +20,7 @@
|
||||||
(define %dot-rmd record-method-dispatch)
|
(define %dot-rmd record-method-dispatch)
|
||||||
|
|
||||||
;; Vectors / maps / sets only (records are jolt-map? here). Raw seqs are excluded:
|
;; Vectors / maps / sets only (records are jolt-map? here). Raw seqs are excluded:
|
||||||
;; the seed's coll-interop accepts some seq representations and not others (a
|
;; coll-interop accepts some seq representations and not others (a
|
||||||
;; plain (seq v) returns nil from .count, a lazy-seq returns the count), an
|
;; plain (seq v) returns nil from .count, a lazy-seq returns the count), an
|
||||||
;; inconsistency Chez's normalized cseq can't mirror — so a raw seq target falls
|
;; inconsistency Chez's normalized cseq can't mirror — so a raw seq target falls
|
||||||
;; through to the base dispatcher rather than risk a divergence the corpus would
|
;; through to the base dispatcher rather than risk a divergence the corpus would
|
||||||
|
|
@ -40,7 +40,7 @@
|
||||||
((string=? name "containsKey") (list (jolt-contains? obj (car args))))
|
((string=? name "containsKey") (list (jolt-contains? obj (car args))))
|
||||||
(else #f)))
|
(else #f)))
|
||||||
|
|
||||||
;; Mirror the seed's universal object-methods (src/jolt/eval_resolve.janet): on a
|
;; Universal object-methods: on a
|
||||||
;; non-record map these win OVER a field lookup, like dispatch-member. getMessage
|
;; non-record map these win OVER a field lookup, like dispatch-member. getMessage
|
||||||
;; on an ex-info reads its :message (the one the corpus exercises); getCause reads
|
;; on an ex-info reads its :message (the one the corpus exercises); getCause reads
|
||||||
;; :cause; toString/hashCode/equals round out the set. Returns a boxed result or
|
;; :cause; toString/hashCode/equals round out the set. Returns a boxed result or
|
||||||
|
|
|
||||||
|
|
@ -9,7 +9,7 @@
|
||||||
;; The binding macro builds a frame as a jolt map (array-map of (var x) -> value);
|
;; The binding macro builds a frame as a jolt map (array-map of (var x) -> value);
|
||||||
;; push-thread-bindings folds it into the alist. Lookups walk frames by cell
|
;; push-thread-bindings folds it into the alist. Lookups walk frames by cell
|
||||||
;; IDENTITY (eq?) — vars are interned, so (var x) always yields the same cell, and
|
;; IDENTITY (eq?) — vars are interned, so (var x) always yields the same cell, and
|
||||||
;; this sidesteps the seed's persistent-hash-map-can't-find-a-var-key quirk.
|
;; this sidesteps a persistent-hash-map-can't-find-a-var-key quirk.
|
||||||
;;
|
;;
|
||||||
;; var reads (var-deref in compiled code, jolt-var-get / deref on a cell) consult
|
;; var reads (var-deref in compiled code, jolt-var-get / deref on a cell) consult
|
||||||
;; the stack before falling back to the cell root. Loaded LAST (after vars.ss and
|
;; the stack before falling back to the cell root. Loaded LAST (after vars.ss and
|
||||||
|
|
|
||||||
|
|
@ -1,9 +1,6 @@
|
||||||
;; emit-image.ss (jolt-cf1q.4 inc8) — the on-Chez compiler-image emitter.
|
;; emit-image.ss (jolt-cf1q.4 inc8) — the on-Chez compiler-image emitter.
|
||||||
;;
|
;;
|
||||||
;; This is the stage2/stage3 half of the self-hosting fixpoint. driver.janet's
|
;; This is the stage2/stage3 half of the self-hosting fixpoint. The
|
||||||
;; emit-compiler-image cross-compiles the compiler sources (jolt.ir +
|
|
||||||
;; jolt.analyzer + jolt.backend-scheme) to a Scheme def-var! image USING THE JANET
|
|
||||||
;; analyzer/emitter — that is stage1. This file does the SAME job but the
|
|
||||||
;; analyze->emit runs ON CHEZ (jolt-ce-analyze / jolt-ce-emit, loaded from a
|
;; analyze->emit runs ON CHEZ (jolt-ce-analyze / jolt-ce-emit, loaded from a
|
||||||
;; previously-built image): feed it stage1's image and it produces stage2; feed it
|
;; previously-built image): feed it stage1's image and it produces stage2; feed it
|
||||||
;; stage2 and it produces stage3. stage2 == stage3 byte-for-byte proves the
|
;; stage2 and it produces stage3. stage2 == stage3 byte-for-byte proves the
|
||||||
|
|
@ -12,8 +9,8 @@
|
||||||
;; Loaded after compile-eval.ss (needs jolt-ce-analyze/jolt-ce-emit/ce-scan-requires!,
|
;; Loaded after compile-eval.ss (needs jolt-ce-analyze/jolt-ce-emit/ce-scan-requires!,
|
||||||
;; make-analyze-ctx) and rt.ss (read-file-string, the reader's rdr-read-form).
|
;; make-analyze-ctx) and rt.ss (read-file-string, the reader's rdr-read-form).
|
||||||
|
|
||||||
;; Read every top-level form from a source string (a Chez read-all). Mirrors the
|
;; Read every top-level form from a source string (a Chez read-all).
|
||||||
;; Janet driver's parse-all; uses the same reader the spine reads single forms with.
|
;; Uses the same reader the spine reads single forms with.
|
||||||
(define (ei-read-all src)
|
(define (ei-read-all src)
|
||||||
(let ((end (string-length src)))
|
(let ((end (string-length src)))
|
||||||
(let loop ((i 0) (acc '()))
|
(let loop ((i 0) (acc '()))
|
||||||
|
|
@ -23,7 +20,7 @@
|
||||||
(loop j (cons form acc)))))))
|
(loop j (cons form acc)))))))
|
||||||
|
|
||||||
;; Is `f` an (ns ...) form? (Its only role in the image is alias registration; we
|
;; Is `f` an (ns ...) form? (Its only role in the image is alias registration; we
|
||||||
;; never emit it — the def-var!s carry explicit ns names. Matches driver.janet.)
|
;; never emit it — the def-var!s carry explicit ns names.)
|
||||||
(define (ei-ns-form? f)
|
(define (ei-ns-form? f)
|
||||||
(and (cseq? f) (cseq-list? f)
|
(and (cseq? f) (cseq-list? f)
|
||||||
(let ((items (seq->list f)))
|
(let ((items (seq->list f)))
|
||||||
|
|
@ -34,7 +31,6 @@
|
||||||
;; ce-defmacro->fn, loaded before this) — shared with the runtime defmacro spine.
|
;; ce-defmacro->fn, loaded before this) — shared with the runtime defmacro spine.
|
||||||
|
|
||||||
;; Cross-compile one namespace's source to a list of guard-wrapped Scheme strings.
|
;; Cross-compile one namespace's source to a list of guard-wrapped Scheme strings.
|
||||||
;; Mirrors driver.janet emit-ns-forms-list/emit-core-prelude + emit-form-scheme.
|
|
||||||
;; Each form is analyzed with a fresh ctx — resolution is via the runtime var-table
|
;; Each form is analyzed with a fresh ctx — resolution is via the runtime var-table
|
||||||
;; + alias tables, not ctx-accumulated state, so this matches the spine's per-form
|
;; + alias tables, not ctx-accumulated state, so this matches the spine's per-form
|
||||||
;; analyze. A defmacro emits its expander fn as (def-var! ns name <fn>) +
|
;; analyze. A defmacro emits its expander fn as (def-var! ns name <fn>) +
|
||||||
|
|
@ -69,19 +65,18 @@
|
||||||
(cons (string-append "(guard (e (#t #f))\n " scm ")") acc)
|
(cons (string-append "(guard (e (#t #f))\n " scm ")") acc)
|
||||||
acc)))))))))
|
acc)))))))))
|
||||||
|
|
||||||
;; Scheme string literal for a ns/name — uses the runtime's own writer so it
|
;; Scheme string literal for a ns/name — uses the runtime's own writer
|
||||||
;; matches the Janet driver's %j (printable ASCII identifiers only here).
|
;; (printable ASCII identifiers only here).
|
||||||
(define (ei-str-lit s) (with-output-to-string (lambda () (write s))))
|
(define (ei-str-lit s) (with-output-to-string (lambda () (write s))))
|
||||||
|
|
||||||
;; The compiler namespaces, in load order — same list as driver.janet
|
;; The compiler namespaces, in load order.
|
||||||
;; compiler-ns-files.
|
|
||||||
(define ei-compiler-ns-files
|
(define ei-compiler-ns-files
|
||||||
(list (cons "jolt.ir" "jolt-core/jolt/ir.clj")
|
(list (cons "jolt.ir" "jolt-core/jolt/ir.clj")
|
||||||
(cons "jolt.analyzer" "jolt-core/jolt/analyzer.clj")
|
(cons "jolt.analyzer" "jolt-core/jolt/analyzer.clj")
|
||||||
(cons "jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj")))
|
(cons "jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj")))
|
||||||
|
|
||||||
;; The clojure.core tiers + stdlib namespaces, in load order — same lists as
|
;; The clojure.core tiers + stdlib namespaces, in load order.
|
||||||
;; driver.janet core-tier-files / stdlib-ns-files. Re-emitting these on Chez is the
|
;; Re-emitting these on Chez is the
|
||||||
;; prelude half of the fixpoint (the whole emitted system reproducing itself).
|
;; prelude half of the fixpoint (the whole emitted system reproducing itself).
|
||||||
(define ei-prelude-ns-files
|
(define ei-prelude-ns-files
|
||||||
(append
|
(append
|
||||||
|
|
@ -94,8 +89,7 @@
|
||||||
(cons "clojure.set" "src/jolt/clojure/set.clj")
|
(cons "clojure.set" "src/jolt/clojure/set.clj")
|
||||||
(cons "clojure.pprint" "src/jolt/clojure/pprint.clj"))))
|
(cons "clojure.pprint" "src/jolt/clojure/pprint.clj"))))
|
||||||
|
|
||||||
;; Join a list of form strings with "\n", no trailing newline — byte-identical
|
;; Join a list of form strings with "\n", no trailing newline.
|
||||||
;; layout to the Janet driver's (string/join out "\n").
|
|
||||||
(define (ei-join forms)
|
(define (ei-join forms)
|
||||||
(let join ((fs forms) (out ""))
|
(let join ((fs forms) (out ""))
|
||||||
(cond
|
(cond
|
||||||
|
|
|
||||||
|
|
@ -1,20 +1,16 @@
|
||||||
;; host class tokens (jolt-13zk) — a bare class name (String, Keyword, File...)
|
;; host class tokens (jolt-13zk) — a bare class name (String, Keyword, File...)
|
||||||
;; evaluates to its JVM canonical-name STRING, the same value (class instance)
|
;; evaluates to its JVM canonical-name STRING, the same value (class instance)
|
||||||
;; returns, so (= String (class "x")) holds and a (defmethod m String ...) keys
|
;; returns, so (= String (class "x")) holds and a (defmethod m String ...) keys
|
||||||
;; against a (class …) dispatch (ring.util.request does this). Mirrors
|
;; against a (class …) dispatch (ring.util.request does this).
|
||||||
;; src/jolt/eval_resolve.janet's class-canonical-names + core_refs.janet's
|
;; The analyzer resolves these names to clojure.core vars, so the back end emits
|
||||||
;; core-class. The analyzer already resolves these names to clojure.core vars (the
|
|
||||||
;; seed ctx interns them via setup-class-ctors), so the back end emits
|
|
||||||
;; (var-deref "clojure.core" "String") — def-var!'ing the canonical strings here is
|
;; (var-deref "clojure.core" "String") — def-var!'ing the canonical strings here is
|
||||||
;; all that's needed at runtime. No analyzer change, so the Janet back end is
|
;; all that's needed at runtime.
|
||||||
;; untouched.
|
|
||||||
;;
|
;;
|
||||||
;; Loaded after natives-meta.ss (jolt-type) + the printer (jolt-str-render-one).
|
;; Loaded after natives-meta.ss (jolt-type) + the printer (jolt-str-render-one).
|
||||||
|
|
||||||
;; (class x) — Clojure's class of a value. Scalars map to their JVM class name,
|
;; (class x) — Clojure's class of a value. Scalars map to their JVM class name,
|
||||||
;; matching core-class. Collections/seqs have no JVM class on this host; the seed
|
;; matching core-class. Collections/seqs have no JVM class on this host;
|
||||||
;; leaks the Janet host type ("table"/"struct"/"tuple") there, which we don't
|
;; (str (type x)) is the clean host taxonomy and
|
||||||
;; reproduce (Janet is going away) — (str (type x)) is the clean host taxonomy and
|
|
||||||
;; is never compared against a class token in the corpus. Records yield their
|
;; is never compared against a class token in the corpus. Records yield their
|
||||||
;; ns-qualified class name (= (str (type x))). Total — never crashes.
|
;; ns-qualified class name (= (str (type x))). Total — never crashes.
|
||||||
(define (jolt-class x)
|
(define (jolt-class x)
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
;; host-contract.ss (jolt-hs9n, Phase 3 inc6) — the jolt.host contract on Chez.
|
;; host-contract.ss (jolt-hs9n, Phase 3 inc6) — the jolt.host contract on Chez.
|
||||||
;;
|
;;
|
||||||
;; The portable seam between jolt-core (analyzer/IR/emitter, cross-compiled to
|
;; The portable seam between jolt-core (analyzer/IR/emitter, cross-compiled to
|
||||||
;; Scheme) and the host. Mirrors src/jolt/host_iface.janet's `exports`: every
|
;; Scheme) and the host. Every
|
||||||
;; contract fn is def-var!'d into the "jolt.host" namespace so the cross-compiled
|
;; contract fn is def-var!'d into the "jolt.host" namespace so the cross-compiled
|
||||||
;; jolt.analyzer / jolt.backend-scheme — whose unqualified form-*/resolve-global/
|
;; jolt.analyzer / jolt.backend-scheme — whose unqualified form-*/resolve-global/
|
||||||
;; ... refs lower to (var-deref "jolt.host" ...) — resolve here at runtime.
|
;; ... refs lower to (var-deref "jolt.host" ...) — resolve here at runtime.
|
||||||
|
|
@ -149,8 +149,7 @@
|
||||||
;; def-var! of its cross-compiled expander fn plus (mark-macro! ns name), so the
|
;; def-var! of its cross-compiled expander fn plus (mark-macro! ns name), so the
|
||||||
;; var cell is flagged a macro (rt.ss var-macro-table). form-macro? checks the
|
;; var cell is flagged a macro (rt.ss var-macro-table). form-macro? checks the
|
||||||
;; flag; form-expand-1 applies the expander to the unevaluated arg forms (the rest
|
;; flag; form-expand-1 applies the expander to the unevaluated arg forms (the rest
|
||||||
;; of the list), and the analyzer re-analyzes the returned form. Mirrors
|
;; of the list), and the analyzer re-analyzes the returned form.
|
||||||
;; host_iface.janet h-macro?/h-expand-1.
|
|
||||||
(define (hc-macro? ctx sym)
|
(define (hc-macro? ctx sym)
|
||||||
(macro-var? (hc-resolve-cell ctx sym)))
|
(macro-var? (hc-resolve-cell ctx sym)))
|
||||||
(define (hc-expand-1 ctx form)
|
(define (hc-expand-1 ctx form)
|
||||||
|
|
@ -179,7 +178,7 @@
|
||||||
(define (hc-intern! ctx ns-name nm) (declare-var! ns-name nm) jolt-nil)
|
(define (hc-intern! ctx ns-name nm) (declare-var! ns-name nm) jolt-nil)
|
||||||
|
|
||||||
;; --- syntax-quote lowering (jolt-qjr0, inc7) ---------------------------------
|
;; --- syntax-quote lowering (jolt-qjr0, inc7) ---------------------------------
|
||||||
;; Mirrors src/jolt/eval_base.janet syntax-quote-lower/sq-symbol. Lowers a `form
|
;; Lowers a `form
|
||||||
;; to CONSTRUCTION CODE — Chez reader forms calling __sqcat/__sqvec/__sqmap/
|
;; to CONSTRUCTION CODE — Chez reader forms calling __sqcat/__sqvec/__sqmap/
|
||||||
;; __sqset/__sq1 + quote — that the analyzer re-analyzes, so a backtick compiles
|
;; __sqset/__sq1 + quote — that the analyzer re-analyzes, so a backtick compiles
|
||||||
;; with zero runtime cost (read -> macroexpand -> compile). Symbols resolve to
|
;; with zero runtime cost (read -> macroexpand -> compile). Symbols resolve to
|
||||||
|
|
|
||||||
|
|
@ -2,11 +2,11 @@
|
||||||
;;
|
;;
|
||||||
;; The analyzer lowers `Class/member` to a :host-static node and `(Class. ...)` /
|
;; The analyzer lowers `Class/member` to a :host-static node and `(Class. ...)` /
|
||||||
;; `(new Class ...)` to a :host-new node (jolt-core/jolt/analyzer.clj); the Chez
|
;; `(new Class ...)` to a :host-new node (jolt-core/jolt/analyzer.clj); the Chez
|
||||||
;; emit (emit.janet) lowers a value ref to (host-static-ref "Class" "member"), a
|
;; emit lowers a value ref to (host-static-ref "Class" "member"), a
|
||||||
;; call head to (host-static-call "Class" "member" args...), and a constructor to
|
;; call head to (host-static-call "Class" "member" args...), and a constructor to
|
||||||
;; (host-new "Class" args...). This file is the runtime registry those three
|
;; (host-new "Class" args...). This file is the runtime registry those three
|
||||||
;; resolve against — the Chez port of the seed's class-statics / class-ctors /
|
;; resolve against — the class-statics / class-ctors /
|
||||||
;; tagged-methods registries (src/jolt/interop/java_base.janet + host_io.janet),
|
;; tagged-methods registries,
|
||||||
;; restricted to the java.lang/util/net/io surface portable cljc code calls.
|
;; restricted to the java.lang/util/net/io surface portable cljc code calls.
|
||||||
;; (java.time formatting is a separate increment.)
|
;; (java.time formatting is a separate increment.)
|
||||||
;;
|
;;
|
||||||
|
|
@ -111,7 +111,7 @@
|
||||||
;; numeric tower (jolt-n6al): currentTimeMillis/nanoTime are exact longs (JVM).
|
;; numeric tower (jolt-n6al): currentTimeMillis/nanoTime are exact longs (JVM).
|
||||||
(define (->num x) x)
|
(define (->num x) x)
|
||||||
(define (jnum->exact n) (exact (truncate n)))
|
(define (jnum->exact n) (exact (truncate n)))
|
||||||
;; parse an integer string in radix; #f on failure (matches the seed's scan-number)
|
;; parse an integer string in radix; #f on failure
|
||||||
(define (parse-int-str s radix)
|
(define (parse-int-str s radix)
|
||||||
(let ((n (string->number (str-trim (if (string? s) s (jolt-str-render-one s))) radix)))
|
(let ((n (string->number (str-trim (if (string? s) s (jolt-str-render-one s))) radix)))
|
||||||
(and n (integer? n) (->num n))))
|
(and n (integer? n) (->num n))))
|
||||||
|
|
@ -488,7 +488,7 @@
|
||||||
(if (regex-t? obj)
|
(if (regex-t? obj)
|
||||||
(let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
|
(let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
|
||||||
(cond ((string=? method-name "split")
|
(cond ((string=? method-name "split")
|
||||||
;; .split returns a String[] — a seq, like the seed's array (prints
|
;; .split returns a String[] — a seq (prints
|
||||||
;; (a b c), not a vector). re-split with no limit; drop trailing
|
;; (a b c), not a vector). re-split with no limit; drop trailing
|
||||||
;; empties (JVM default).
|
;; empties (JVM default).
|
||||||
(let ((parts (re-split (regex-t-irx obj) (car rest) #f)))
|
(let ((parts (re-split (regex-t-irx obj) (car rest) #f)))
|
||||||
|
|
|
||||||
|
|
@ -11,7 +11,7 @@
|
||||||
;; these — a red-black tree + :ops table travel inside the htable.
|
;; these — a red-black tree + :ops table travel inside the htable.
|
||||||
;; 2. a sorted-coll arm on the collection dispatchers, set!-extended the same
|
;; 2. a sorted-coll arm on the collection dispatchers, set!-extended the same
|
||||||
;; way records.ss extends them for jrec: each op routes through the value's
|
;; way records.ss extends them for jrec: each op routes through the value's
|
||||||
;; own :ops table (the seed's dispatch pattern, core_coll.janet). first/rest/
|
;; own :ops table (the dispatch pattern). first/rest/
|
||||||
;; next/last fall out free once jolt-seq has a sorted arm (they seq first).
|
;; next/last fall out free once jolt-seq has a sorted arm (they seq first).
|
||||||
;;
|
;;
|
||||||
;; Loaded LAST (after records.ss / transients.ss / natives-meta.ss): it wraps the
|
;; Loaded LAST (after records.ss / transients.ss / natives-meta.ss): it wraps the
|
||||||
|
|
@ -118,7 +118,7 @@
|
||||||
(def-var! "clojure.core" "coll?" (lambda (x) (or (htable-sorted? x) (jrec? x) (jolt-coll-pred? x))))
|
(def-var! "clojure.core" "coll?" (lambda (x) (or (htable-sorted? x) (jrec? x) (jolt-coll-pred? x))))
|
||||||
|
|
||||||
;; --- equality / hash ---------------------------------------------------------
|
;; --- equality / hash ---------------------------------------------------------
|
||||||
;; A sorted coll canonicalizes like its unordered counterpart (core_types.janet):
|
;; A sorted coll canonicalizes like its unordered counterpart:
|
||||||
;; a sorted-map equals ANY map (hash or sorted) with the same entries, a
|
;; a sorted-map equals ANY map (hash or sorted) with the same entries, a
|
||||||
;; sorted-set ANY set with the same elements — the comparator is irrelevant to =.
|
;; sorted-set ANY set with the same elements — the comparator is irrelevant to =.
|
||||||
;; Convert to the plain persistent coll and delegate to the prior jolt=2 / hash.
|
;; Convert to the plain persistent coll and delegate to the prior jolt=2 / hash.
|
||||||
|
|
@ -140,8 +140,8 @@
|
||||||
|
|
||||||
;; --- printing ----------------------------------------------------------------
|
;; --- printing ----------------------------------------------------------------
|
||||||
;; sorted colls render in SORTED order (the value's :seq), not HAMT order — and
|
;; sorted colls render in SORTED order (the value's :seq), not HAMT order — and
|
||||||
;; a sorted-map prints "{k v, k v}" (", " between pairs) like the seed's
|
;; a sorted-map prints "{k v, k v}" (", " between pairs),
|
||||||
;; pr-render-pairs, NOT the space-only form the unordered pmap arm uses.
|
;; NOT the space-only form the unordered pmap arm uses.
|
||||||
(define (sorted-map-render sc render)
|
(define (sorted-map-render sc render)
|
||||||
(string-append "{"
|
(string-append "{"
|
||||||
(let loop ((es (seq->list (sc-call sc kw-op-seq))) (first #t) (acc ""))
|
(let loop ((es (seq->list (sc-call sc kw-op-seq))) (first #t) (acc ""))
|
||||||
|
|
|
||||||
|
|
@ -3,13 +3,12 @@
|
||||||
;; A #inst literal lowers (analyzer :inst node -> emit) to (jolt-inst-from-string
|
;; A #inst literal lowers (analyzer :inst node -> emit) to (jolt-inst-from-string
|
||||||
;; "…"); this file parses the RFC3339 string to epoch-ms and models the value as a
|
;; "…"); this file parses the RFC3339 string to epoch-ms and models the value as a
|
||||||
;; `jinst` record (one flonum field, ms). Equality / map-key hashing are by the
|
;; `jinst` record (one flonum field, ms). Equality / map-key hashing are by the
|
||||||
;; INSTANT (offset-normalized), matching the seed (types_ctx.janet parse-inst /
|
;; INSTANT (offset-normalized). The overlay inst?/inst-ms read (get x :jolt/type)/(get x :ms),
|
||||||
;; inst->rfc3339). The overlay inst?/inst-ms read (get x :jolt/type)/(get x :ms),
|
|
||||||
;; so jolt-get answers those off a jinst — the overlay fns then work unchanged.
|
;; so jolt-get answers those off a jinst — the overlay fns then work unchanged.
|
||||||
;;
|
;;
|
||||||
;; The java.time surface (DateTimeFormatter/Instant/ZoneId/LocalDateTime/
|
;; The java.time surface (DateTimeFormatter/Instant/ZoneId/LocalDateTime/
|
||||||
;; FormatStyle/Locale + the .format/.atZone/.toInstant/… methods) is the Chez port
|
;; FormatStyle/Locale + the .format/.atZone/.toInstant/… methods) is
|
||||||
;; of java_base.janet, registered through host-static.ss's class-statics / host-
|
;; registered through host-static.ss's class-statics / host-
|
||||||
;; methods registries — so this loads LAST in rt.ss, after host-static.ss and io.ss.
|
;; methods registries — so this loads LAST in rt.ss, after host-static.ss and io.ss.
|
||||||
|
|
||||||
;; --- civil <-> days since the Unix epoch (Howard Hinnant's algorithms) -------
|
;; --- civil <-> days since the Unix epoch (Howard Hinnant's algorithms) -------
|
||||||
|
|
@ -113,7 +112,7 @@
|
||||||
"T" (pad2 (list-ref f 3)) ":" (pad2 (list-ref f 4)) ":" (pad2 (list-ref f 5))
|
"T" (pad2 (list-ref f 3)) ":" (pad2 (list-ref f 4)) ":" (pad2 (list-ref f 5))
|
||||||
"." (pad3 (list-ref f 6)) "-00:00")))
|
"." (pad3 (list-ref f 6)) "-00:00")))
|
||||||
|
|
||||||
;; --- DateTimeFormatter pattern engine (port of java_base.janet format-ms) -----
|
;; --- DateTimeFormatter pattern engine -----
|
||||||
(define month-names (vector "January" "February" "March" "April" "May" "June" "July"
|
(define month-names (vector "January" "February" "March" "April" "May" "June" "July"
|
||||||
"August" "September" "October" "November" "December"))
|
"August" "September" "October" "November" "December"))
|
||||||
(define day-names (vector "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
|
(define day-names (vector "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
|
||||||
|
|
|
||||||
|
|
@ -1,12 +1,11 @@
|
||||||
;; java.io.File + host file I/O (jolt-yyud). The seed's clojure.java.io (io.clj)
|
;; java.io.File + host file I/O (jolt-yyud). A
|
||||||
;; is a Janet-backed shim (janet.*/janet.file) — not reusable here, so this is a
|
|
||||||
;; Chez-native implementation over Chez's filesystem primitives. A File is a
|
;; Chez-native implementation over Chez's filesystem primitives. A File is a
|
||||||
;; path-backed jfile record: (instance? java.io.File f) is true, str/slurp coerce
|
;; path-backed jfile record: (instance? java.io.File f) is true, str/slurp coerce
|
||||||
;; it to its path, and the File method surface (getName/getPath/exists/
|
;; it to its path, and the File method surface (getName/getPath/exists/
|
||||||
;; isDirectory/isFile/listFiles) dispatches through record-method-dispatch.
|
;; isDirectory/isFile/listFiles) dispatches through record-method-dispatch.
|
||||||
;;
|
;;
|
||||||
;; Mirrors src/jolt/core_io.janet (core-make-file/file?/slurp/spit/flush/dir?/
|
;; Provides make-file/file?/slurp/spit/flush/dir?/
|
||||||
;; list-dir) and the overlay file-seq (20-coll.clj), which calls __file?/__dir?/
|
;; list-dir for the overlay file-seq (20-coll.clj), which calls __file?/__dir?/
|
||||||
;; __list-dir + the .isDirectory/.listFiles/.isFile method surface.
|
;; __list-dir + the .isDirectory/.listFiles/.isFile method surface.
|
||||||
;;
|
;;
|
||||||
;; Reader/StringReader-coupled io (io/reader, line-seq over a file, .toURL,
|
;; Reader/StringReader-coupled io (io/reader, line-seq over a file, .toURL,
|
||||||
|
|
@ -47,7 +46,7 @@
|
||||||
|
|
||||||
;; --- java.net.URL (a jhost "url", state #(spec)) ----------------------------
|
;; --- java.net.URL (a jhost "url", state #(spec)) ----------------------------
|
||||||
;; A File.toURL value: .toString / .toExternalForm give the spec, .getPath /
|
;; A File.toURL value: .toString / .toExternalForm give the spec, .getPath /
|
||||||
;; .getFile strip the "file:" scheme. (Mirrors host_io.janet's :jolt/url.)
|
;; .getFile strip the "file:" scheme.
|
||||||
(define (make-url spec) (make-jhost "url" (vector spec)))
|
(define (make-url spec) (make-jhost "url" (vector spec)))
|
||||||
(define (url-spec u) (vector-ref (jhost-state u) 0))
|
(define (url-spec u) (vector-ref (jhost-state u) 0))
|
||||||
(define (url-strip-scheme spec)
|
(define (url-strip-scheme spec)
|
||||||
|
|
@ -91,7 +90,7 @@
|
||||||
(%io-rmd obj method-name rest-args))))
|
(%io-rmd obj method-name rest-args))))
|
||||||
|
|
||||||
;; .isDirectory / .listFiles emit to jolt-host-call (rt.ss), not record-method-
|
;; .isDirectory / .listFiles emit to jolt-host-call (rt.ss), not record-method-
|
||||||
;; dispatch (emit.janet supported-host-methods) — the Phase-1 shims there assume a
|
;; dispatch — the Phase-1 shims there assume a
|
||||||
;; path STRING target. Make them jfile-aware so file-seq's File branch works.
|
;; path STRING target. Make them jfile-aware so file-seq's File branch works.
|
||||||
(define %io-host-call jolt-host-call)
|
(define %io-host-call jolt-host-call)
|
||||||
(set! jolt-host-call
|
(set! jolt-host-call
|
||||||
|
|
@ -171,7 +170,7 @@
|
||||||
(set! jolt-str-render-one
|
(set! jolt-str-render-one
|
||||||
(lambda (v) (if (jfile? v) (jfile-path v) (%io-str-render v))))
|
(lambda (v) (if (jfile? v) (jfile-path v) (%io-str-render v))))
|
||||||
|
|
||||||
;; (type f) -> :jolt/file, matching the seed's tagged-file :jolt/type. Re-def-var!
|
;; (type f) -> :jolt/file (the tagged-file :jolt/type). Re-def-var!
|
||||||
;; "type": natives-meta.ss already bound the var to the old jolt-type value, so the
|
;; "type": natives-meta.ss already bound the var to the old jolt-type value, so the
|
||||||
;; set! alone (which updates the symbol for internal callers) wouldn't reach it.
|
;; set! alone (which updates the symbol for internal callers) wouldn't reach it.
|
||||||
(define io-kw-file (keyword "jolt" "file"))
|
(define io-kw-file (keyword "jolt" "file"))
|
||||||
|
|
@ -192,7 +191,7 @@
|
||||||
(%io-instance-check type-sym val)))))
|
(%io-instance-check type-sym val)))))
|
||||||
(def-var! "clojure.core" "instance-check" instance-check)
|
(def-var! "clojure.core" "instance-check" instance-check)
|
||||||
|
|
||||||
;; --- def-var! the seed-native names the overlay file-seq + str/slurp use ----
|
;; --- def-var! the native names the overlay file-seq + str/slurp use ----
|
||||||
(def-var! "clojure.core" "__make-file" jolt-make-file)
|
(def-var! "clojure.core" "__make-file" jolt-make-file)
|
||||||
(def-var! "clojure.core" "__file?" jolt-file?)
|
(def-var! "clojure.core" "__file?" jolt-file?)
|
||||||
(def-var! "clojure.core" "__dir?" jolt-dir?)
|
(def-var! "clojure.core" "__dir?" jolt-dir?)
|
||||||
|
|
@ -202,8 +201,8 @@
|
||||||
(def-var! "clojure.core" "flush" jolt-flush)
|
(def-var! "clojure.core" "flush" jolt-flush)
|
||||||
|
|
||||||
;; --- char-array: a seq of chars over a string (the JVM char[]). io/reader's
|
;; --- char-array: a seq of chars over a string (the JVM char[]). io/reader's
|
||||||
;; char[] branch + selmer's (char-array template) feed on this. Mirrors the seed
|
;; char[] branch + selmer's (char-array template) feed on this.
|
||||||
;; core-char-array (string -> chars). A leaf array native; lives here as io/reader
|
;; char-array (string -> chars). A leaf array native; lives here as io/reader
|
||||||
;; is its only Chez consumer so far.
|
;; is its only Chez consumer so far.
|
||||||
(define (jolt-char-array a . rest)
|
(define (jolt-char-array a . rest)
|
||||||
(cond
|
(cond
|
||||||
|
|
@ -215,7 +214,7 @@
|
||||||
|
|
||||||
;; --- with-open's close seam (__close): a map-like value closes via its :close
|
;; --- with-open's close seam (__close): a map-like value closes via its :close
|
||||||
;; fn; a jhost reader/writer/file via its .close method (a no-op here); anything
|
;; fn; a jhost reader/writer/file via its .close method (a no-op here); anything
|
||||||
;; else is an error. Mirrors core_extra.janet core-close-resource.
|
;; else is an error.
|
||||||
(define (jolt-close x)
|
(define (jolt-close x)
|
||||||
(cond
|
(cond
|
||||||
((jolt-nil? x) jolt-nil)
|
((jolt-nil? x) jolt-nil)
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,8 @@
|
||||||
;;
|
;;
|
||||||
;; The `lazy-seq` macro (00-syntax.clj) expands to
|
;; The `lazy-seq` macro (00-syntax.clj) expands to
|
||||||
;; (make-lazy-seq (fn* [] (coll->cells (do body))))
|
;; (make-lazy-seq (fn* [] (coll->cells (do body))))
|
||||||
;; and `lazy-cat` to (concat (lazy-seq c) ...). make-lazy-seq / coll->cells are
|
;; and `lazy-cat` to (concat (lazy-seq c) ...). make-lazy-seq / coll->cells had
|
||||||
;; seed natives (src/jolt/lazyseq.janet) with no Chez shim, so EVERY overlay fn
|
;; no Chez shim, so EVERY overlay fn
|
||||||
;; built on lazy-seq — repeat / iterate / cycle / dedupe / take-nth / keep /
|
;; built on lazy-seq — repeat / iterate / cycle / dedupe / take-nth / keep /
|
||||||
;; interpose / reductions / tree-seq (-> flatten) / lazy-cat — resolved the call
|
;; interpose / reductions / tree-seq (-> flatten) / lazy-cat — resolved the call
|
||||||
;; to jolt-nil and hit the apply-jolt-nil crash bucket.
|
;; to jolt-nil and hit the apply-jolt-nil crash bucket.
|
||||||
|
|
|
||||||
|
|
@ -1,15 +1,14 @@
|
||||||
;; clojure.math (jolt-22vo) — Chez host shim over native flonum math.
|
;; clojure.math (jolt-22vo) — Chez host shim over native flonum math.
|
||||||
;;
|
;;
|
||||||
;; On the Janet seed clojure.math is registered as native math/ bindings
|
;; clojure.math is registered as native bindings (jolt-h79), NOT a .clj file — so
|
||||||
;; (api.janet install-clojure-math!, jolt-h79), NOT a .clj file — so there's no
|
;; there's no source tier to emit. Chez provides its own def-var! shims here, one per
|
||||||
;; source tier to emit. Chez provides its own def-var! shims here, one per
|
;; clojure.math fn, over Chez's native procedures. The analyzer knows the
|
||||||
;; clojure.math fn, over Chez's native procedures. The analyzer already knows the
|
;; clojure.math ns exists, so a ref
|
||||||
;; clojure.math ns exists (init interns the same fns on the Janet side), so a ref
|
|
||||||
;; like clojure.math/sqrt lowers to a var-deref; these cells back it at runtime.
|
;; like clojure.math/sqrt lowers to a var-deref; these cells back it at runtime.
|
||||||
;;
|
;;
|
||||||
;; jolt is all-flonum, so every result is a flonum (inputs arrive as flonums; Chez
|
;; jolt is all-flonum, so every result is a flonum (inputs arrive as flonums; Chez
|
||||||
;; sqrt/sin/expt/... return flonums for flonum args). Semantics match the seed
|
;; sqrt/sin/expt/... return flonums for flonum args). Semantics match
|
||||||
;; (Clojure 1.11 clojure.math): round = floor(x+0.5), rint = round-half-even,
|
;; Clojure 1.11 clojure.math: round = floor(x+0.5), rint = round-half-even,
|
||||||
;; floor/ceil/floor-div return doubles, to-degrees/to-radians via PI.
|
;; floor/ceil/floor-div return doubles, to-degrees/to-radians via PI.
|
||||||
|
|
||||||
(define jolt-math-pi (acos -1.0))
|
(define jolt-math-pi (acos -1.0))
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,8 @@
|
||||||
;;
|
;;
|
||||||
;; defmulti/defmethod are macros that expand to ctx-capturing setup CALLS
|
;; defmulti/defmethod are macros that expand to ctx-capturing setup CALLS
|
||||||
;; (defmulti-setup / defmethod-setup, + the table ops get-method/methods/
|
;; (defmulti-setup / defmethod-setup, + the table ops get-method/methods/
|
||||||
;; remove-method/prefer-method/prefers). The Janet seed implements these against
|
;; remove-method/prefer-method/prefers), implemented here against
|
||||||
;; the evaluator's ns/var machinery (eval_runtime.janet); this is the Chez port.
|
;; the runtime's ns/var machinery.
|
||||||
;;
|
;;
|
||||||
;; A multimethod VALUE is a jolt-multifn record carrying its dispatch fn and a
|
;; A multimethod VALUE is a jolt-multifn record carrying its dispatch fn and a
|
||||||
;; mutable method table (dispatch-val -> method fn, keyed with jolt= so keyword/
|
;; mutable method table (dispatch-val -> method fn, keyed with jolt= so keyword/
|
||||||
|
|
|
||||||
|
|
@ -3,8 +3,7 @@
|
||||||
;; A jolt-array wraps a Chez mutable vector + a `kind` tag (for bytes?). The array
|
;; A jolt-array wraps a Chez mutable vector + a `kind` tag (for bytes?). The array
|
||||||
;; CONSTRUCTORS are native (they build the backing); the overlay's aget/aset/alength
|
;; CONSTRUCTORS are native (they build the backing); the overlay's aget/aset/alength
|
||||||
;; are pure over count / nth / jolt.host/ref-put!, so we extend those dispatchers
|
;; are pure over count / nth / jolt.host/ref-put!, so we extend those dispatchers
|
||||||
;; to see a jolt-array. Mirrors src/jolt/core_refs.janet (Janet uses its mutable
|
;; to see a jolt-array (backed by a Chez vector). Loaded after host-table.ss (ref-put!),
|
||||||
;; arrays/buffers; here a Chez vector). Loaded after host-table.ss (ref-put!),
|
|
||||||
;; transients.ss, seq.ss (the dispatchers it chains).
|
;; transients.ss, seq.ss (the dispatchers it chains).
|
||||||
|
|
||||||
(define-record-type jolt-array (fields (mutable vec) kind) (nongenerative jolt-array-v1))
|
(define-record-type jolt-array (fields (mutable vec) kind) (nongenerative jolt-array-v1))
|
||||||
|
|
|
||||||
|
|
@ -1,12 +1,10 @@
|
||||||
;; Collection constructors + rand (jolt-cf1q.3 Phase 2 inc A) — host-coupled seed
|
;; Collection constructors + rand (jolt-cf1q.3 Phase 2 inc A) — host-coupled
|
||||||
;; natives the overlay assumes as bare clojure.core vars but which were never
|
;; natives the overlay assumes as bare clojure.core vars but which were never
|
||||||
;; def-var!'d, so they resolved to jolt-nil and any call hit the apply-jolt-nil
|
;; def-var!'d, so they resolved to jolt-nil and any call hit the apply-jolt-nil
|
||||||
;; crash bucket. The persistent-collection constructors already exist in
|
;; crash bucket. The persistent-collection constructors already exist in
|
||||||
;; collections.ss (jolt-hash-map / jolt-hash-set / jolt-vector); this just binds
|
;; collections.ss (jolt-hash-map / jolt-hash-set / jolt-vector); this just binds
|
||||||
;; the public clojure.core names to them. Loaded after def-var! (rt.ss) + the
|
;; the public clojure.core names to them. Loaded after def-var! (rt.ss) + the
|
||||||
;; collections + seq tiers. Semantics match the Janet seed (core_coll.janet
|
;; collections + seq tiers. hash-map/array-map/hash-set/set/rand semantics.
|
||||||
;; core-hash-map/core-array-map/core-hash-set/core-set, core_types.janet
|
|
||||||
;; core-rand).
|
|
||||||
|
|
||||||
;; hash-map / hash-set: variadic kvs / elems straight onto the existing ctors.
|
;; hash-map / hash-set: variadic kvs / elems straight onto the existing ctors.
|
||||||
;; array-map: Clojure preserves insertion order, but jolt's `=` is structural and
|
;; array-map: Clojure preserves insertion order, but jolt's `=` is structural and
|
||||||
|
|
|
||||||
|
|
@ -47,8 +47,8 @@
|
||||||
|
|
||||||
;; (type x) — Clojure's (or (:type (meta x)) (class x)). With no JVM classes the
|
;; (type x) — Clojure's (or (:type (meta x)) (class x)). With no JVM classes the
|
||||||
;; "class" is a host taxonomy: a record yields its ns-qualified class-name SYMBOL
|
;; "class" is a host taxonomy: a record yields its ns-qualified class-name SYMBOL
|
||||||
;; (user.TyR), everything else a keyword (:number/:vector/:seq/…). Mirrors the
|
;; (user.TyR), everything else a keyword (:number/:vector/:seq/…).
|
||||||
;; seed's core-type (src/jolt/core_io.janet). MUST be total — a non-record value
|
;; MUST be total — a non-record value
|
||||||
;; falling through to a crash would read as a divergence, not the right keyword.
|
;; falling through to a crash would read as a divergence, not the right keyword.
|
||||||
;; Forward refs (jolt-lazyseq?, the sorted-htable / wrapper predicates) all bind by
|
;; Forward refs (jolt-lazyseq?, the sorted-htable / wrapper predicates) all bind by
|
||||||
;; call time (every host .ss loads before any user expr runs).
|
;; call time (every host .ss loads before any user expr runs).
|
||||||
|
|
@ -89,7 +89,7 @@
|
||||||
((keyword? x) ty-keyword)
|
((keyword? x) ty-keyword)
|
||||||
((symbol-t? x) ty-symbol)
|
((symbol-t? x) ty-symbol)
|
||||||
((char? x) ty-char)
|
((char? x) ty-char)
|
||||||
;; host wrappers — match the seed's :jolt/* tags (checked before the
|
;; host wrappers — keyed by their :jolt/* tags (checked before the
|
||||||
;; collection arms; none of these are pvec/pmap/pset).
|
;; collection arms; none of these are pvec/pmap/pset).
|
||||||
((jolt-atom? x) ty-atom)
|
((jolt-atom? x) ty-atom)
|
||||||
((jvol? x) ty-volatile)
|
((jvol? x) ty-volatile)
|
||||||
|
|
@ -99,7 +99,7 @@
|
||||||
((juuid? x) ty-uuid)
|
((juuid? x) ty-uuid)
|
||||||
((htable-sorted-set? x) ty-sorted-set)
|
((htable-sorted-set? x) ty-sorted-set)
|
||||||
((htable-sorted-map? x) ty-map)
|
((htable-sorted-map? x) ty-map)
|
||||||
;; collections — pvec INCLUDES map entries (:vector, like the seed's jvec?).
|
;; collections — pvec INCLUDES map entries (:vector).
|
||||||
((pvec? x) ty-vector)
|
((pvec? x) ty-vector)
|
||||||
((pmap? x) ; a :jolt/type-tagged map (ex-info) -> its tag
|
((pmap? x) ; a :jolt/type-tagged map (ex-info) -> its tag
|
||||||
(let ((t (jolt-get x ty-kw-jtype jolt-nil))) (if (jolt-nil? t) ty-map t)))
|
(let ((t (jolt-get x ty-kw-jtype jolt-nil))) (if (jolt-nil? t) ty-map t)))
|
||||||
|
|
|
||||||
|
|
@ -26,7 +26,7 @@
|
||||||
(loop (fx+ i 1)))))))
|
(loop (fx+ i 1)))))))
|
||||||
(define (jolt-random-uuid) (make-juuid (random-uuid-str)))
|
(define (jolt-random-uuid) (make-juuid (random-uuid-str)))
|
||||||
|
|
||||||
;; #uuid literal -> a uuid value (emit.janet lowers the :uuid node to this). The
|
;; #uuid literal -> a uuid value (the emitter lowers the :uuid node to this). The
|
||||||
;; reader already validated the shape; lowercase for value equality.
|
;; reader already validated the shape; lowercase for value equality.
|
||||||
(define (jolt-uuid-from-string s) (make-juuid (string-downcase s)))
|
(define (jolt-uuid-from-string s) (make-juuid (string-downcase s)))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
;; bit ops + string->number parsers (jolt-cf1q.3 Phase 2 inc C) — host-coupled
|
;; bit ops + string->number parsers (jolt-cf1q.3 Phase 2 inc C) — host-coupled
|
||||||
;; seed natives (core_refs.janet bit family, core_io.janet parse-long/double) that
|
;; natives (bit family, parse-long/double) that
|
||||||
;; resolved to jolt-nil. jolt models every number as a double, so bit ops coerce
|
;; resolved to jolt-nil. jolt models every number as a double, so bit ops coerce
|
||||||
;; to an exact integer, operate, and return a flonum. parse-* match the seed's
|
;; to an exact integer, operate, and return a flonum. parse-* use
|
||||||
;; strict shapes (Clojure 1.11: nil on malformed, throw on a non-string).
|
;; strict shapes (Clojure 1.11: nil on malformed, throw on a non-string).
|
||||||
|
|
||||||
;; bit ops return EXACT integers (= JVM long). ->int coerces the operand.
|
;; bit ops return EXACT integers (= JVM long). ->int coerces the operand.
|
||||||
|
|
|
||||||
|
|
@ -1,11 +1,10 @@
|
||||||
;; natives-parity.ss (jolt-cf1q.7) — native Chez shims for clojure.core fns that
|
;; natives-parity.ss (jolt-cf1q.7) — native Chez shims for clojure.core fns that
|
||||||
;; live in the Janet seed (src/jolt/core*.janet) but had no Chez shim, so on the
|
;; had no Chez shim, so they resolved to nil ("not a fn"). Pure-Chez, JVM-matching.
|
||||||
;; zero-Janet spine they resolved to nil ("not a fn"). Pure-Chez, JVM-matching.
|
|
||||||
;;
|
;;
|
||||||
;; Loaded after host-table.ss (htable-sorted?), transients.ss (jolt-transient?),
|
;; Loaded after host-table.ss (htable-sorted?), transients.ss (jolt-transient?),
|
||||||
;; values.ss (jolt-hash), seq.ss (jolt-seq/seq->list/list->cseq/jolt-invoke).
|
;; values.ss (jolt-hash), seq.ss (jolt-seq/seq->list/list->cseq/jolt-invoke).
|
||||||
|
|
||||||
;; --- hash family (mirrors core_extra.janet: 24-bit masked so int? holds) ------
|
;; --- hash family (24-bit masked so int? holds) ------
|
||||||
(define (np-h24 x) (bitwise-and (jolt-hash x) #xffffff))
|
(define (np-h24 x) (bitwise-and (jolt-hash x) #xffffff))
|
||||||
(define (np-hash x) (np-h24 x))
|
(define (np-hash x) (np-h24 x))
|
||||||
(define (np-hash-combine a b)
|
(define (np-hash-combine a b)
|
||||||
|
|
@ -26,7 +25,7 @@
|
||||||
(list->cseq (reverse (seq->list (jolt-seq coll))))
|
(list->cseq (reverse (seq->list (jolt-seq coll))))
|
||||||
(jolt-throw (jolt-ex-info "rseq requires a vector or sorted collection" (jolt-hash-map)))))
|
(jolt-throw (jolt-ex-info "rseq requires a vector or sorted collection" (jolt-hash-map)))))
|
||||||
|
|
||||||
;; --- cat transducer (mirrors core_refs.janet core-cat): each item of the input
|
;; --- cat transducer: each item of the input
|
||||||
;; is itself a collection, concatenated into the downstream reducing fn.
|
;; is itself a collection, concatenated into the downstream reducing fn.
|
||||||
(define (np-cat rf)
|
(define (np-cat rf)
|
||||||
(lambda a
|
(lambda a
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
;; seq-native shims (jolt-y6mv) — seed-native seq fns the overlay assumes are
|
;; seq-native shims (jolt-y6mv) — native seq fns the overlay assumes are
|
||||||
;; clojure.core natives but which live in the Janet seed (src/jolt/core_coll.janet),
|
;; clojure.core natives but which have no def-var! in the assembled prelude and
|
||||||
;; so they have no def-var! in the assembled prelude and resolve to jolt-nil on
|
;; resolve to jolt-nil on
|
||||||
;; Chez. This was the dominant prelude-parity crash bucket ('apply jolt-nil').
|
;; Chez. This was the dominant prelude-parity crash bucket ('apply jolt-nil').
|
||||||
;; Each is a pure fn over the existing seq layer (seq.ss) — collection arities
|
;; Each is a pure fn over the existing seq layer (seq.ss) — collection arities
|
||||||
;; only; the 1-arg transducer arities are jolt-kxsr. Loaded last (after
|
;; only; the 1-arg transducer arities are jolt-kxsr. Loaded last (after
|
||||||
|
|
@ -16,8 +16,7 @@
|
||||||
;; ============================================================================
|
;; ============================================================================
|
||||||
;; transducers (jolt-kxsr) — the 1-arg arity of map/filter/take/... returns a
|
;; transducers (jolt-kxsr) — the 1-arg arity of map/filter/take/... returns a
|
||||||
;; transducer (fn [rf] rf') where rf' is a reducing fn with arities
|
;; transducer (fn [rf] rf') where rf' is a reducing fn with arities
|
||||||
;; []=init, [acc]=complete, [acc x]=step. Ported from the seed's td-* factories
|
;; []=init, [acc]=complete, [acc x]=step. rf and the mapping/predicate fns are jolt values, so every
|
||||||
;; (core_coll.janet). rf and the mapping/predicate fns are jolt values, so every
|
|
||||||
;; call routes through jolt-invoke. A `reduced` step stops the fold — reduce-seq
|
;; call routes through jolt-invoke. A `reduced` step stops the fold — reduce-seq
|
||||||
;; (seq.ss) already short-circuits on a jolt-reduced.
|
;; (seq.ss) already short-circuits on a jolt-reduced.
|
||||||
;; ============================================================================
|
;; ============================================================================
|
||||||
|
|
@ -181,9 +180,8 @@
|
||||||
(if (jolt-nil? s) jolt-empty-list
|
(if (jolt-nil? s) jolt-empty-list
|
||||||
(list->cseq (list-sort less? (seq->list s))))))
|
(list->cseq (list-sort less? (seq->list s))))))
|
||||||
|
|
||||||
;; identical?: jolt reference identity. The seed defines it as (= a b) over its
|
;; identical?: jolt reference identity, defined as (= a b) over the
|
||||||
;; value model (core_types.janet core-identical?), where interned keywords/small
|
;; value model, where interned keywords/small values compare equal.
|
||||||
;; values compare equal — so jolt= is the faithful port.
|
|
||||||
(define (jolt-identical? a b) (jolt= a b))
|
(define (jolt-identical? a b) (jolt= a b))
|
||||||
|
|
||||||
;; Give the seq.ss native procedures their transducer (1-arg) arity — the emitter
|
;; Give the seq.ss native procedures their transducer (1-arg) arity — the emitter
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@
|
||||||
;;
|
;;
|
||||||
;; (.method s arg*) on a string target lowers to record-method-dispatch (emit.ss),
|
;; (.method s arg*) on a string target lowers to record-method-dispatch (emit.ss),
|
||||||
;; which falls through to jolt-string-method here when the target is a string.
|
;; which falls through to jolt-string-method here when the target is a string.
|
||||||
;; Ported from the seed surface (src/jolt/eval_resolve.janet string-methods): the
|
;; Covers the
|
||||||
;; portable java.lang.String/CharSequence methods cljc libraries actually call.
|
;; portable java.lang.String/CharSequence methods cljc libraries actually call.
|
||||||
;; Case mapping is ASCII (the whole engine is byte-oriented), indexOf returns -1
|
;; Case mapping is ASCII (the whole engine is byte-oriented), indexOf returns -1
|
||||||
;; on miss as on the JVM, indices come in as flonums, char results are Scheme
|
;; on miss as on the JVM, indices come in as flonums, char results are Scheme
|
||||||
|
|
@ -11,7 +11,7 @@
|
||||||
;; Loaded from rt.ss AFTER regex.ss (the regex methods reuse jolt-re-pattern /
|
;; Loaded from rt.ss AFTER regex.ss (the regex methods reuse jolt-re-pattern /
|
||||||
;; regex-t-irx) and records.ss (which calls jolt-string-method).
|
;; regex-t-irx) and records.ss (which calls jolt-string-method).
|
||||||
|
|
||||||
;; --- ASCII case mapping (match the seed's byte-oriented string/ascii-*) -------
|
;; --- ASCII case mapping (byte-oriented) -------
|
||||||
(define (ascii-up-char c)
|
(define (ascii-up-char c)
|
||||||
(if (and (char<=? #\a c) (char<=? c #\z))
|
(if (and (char<=? #\a c) (char<=? c #\z))
|
||||||
(integer->char (fx- (char->integer c) 32)) c))
|
(integer->char (fx- (char->integer c) 32)) c))
|
||||||
|
|
@ -131,9 +131,9 @@
|
||||||
(else (error #f (string-append "No method " method " for value")))))
|
(else (error #f (string-append "No method " method " for value")))))
|
||||||
|
|
||||||
;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) ---
|
;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) ---
|
||||||
;; clojure.string.clj (src/jolt/clojure/string.clj) is pure Clojure over these
|
;; clojure.string.clj is pure Clojure over these
|
||||||
;; seed natives (core.janet core-bindings); def-var!'d here so the emitted
|
;; natives; def-var!'d here so the emitted
|
||||||
;; clojure.string prelude tier's var-derefs resolve. Ported from the seed:
|
;; clojure.string prelude tier's var-derefs resolve:
|
||||||
;; string/ascii-* (ASCII), string/find (index or nil), core-str-* (regex|literal).
|
;; string/ascii-* (ASCII), string/find (index or nil), core-str-* (regex|literal).
|
||||||
|
|
||||||
;; (string/split sep s) -> parts, splitting on each non-overlapping sep.
|
;; (string/split sep s) -> parts, splitting on each non-overlapping sep.
|
||||||
|
|
@ -168,8 +168,8 @@
|
||||||
|
|
||||||
;; (re-split irx s limit) -> parts, splitting at each match. Keeps interior AND
|
;; (re-split irx s limit) -> parts, splitting at each match. Keeps interior AND
|
||||||
;; trailing empty strings (the clojure.string wrapper drops trailing for limit 0);
|
;; trailing empty strings (the clojure.string wrapper drops trailing for limit 0);
|
||||||
;; a positive limit yields at most `limit` parts (the rest kept unsplit). Mirrors
|
;; a positive limit yields at most `limit` parts (the rest kept unsplit).
|
||||||
;; the seed re-split (src/jolt/regex.janet); the clojure.string.clj split wrapper
|
;; The clojure.string.clj split wrapper
|
||||||
;; layers the trailing-empty trim on top.
|
;; layers the trailing-empty trim on top.
|
||||||
(define (re-split irx s limit)
|
(define (re-split irx s limit)
|
||||||
(let ((len (string-length s)))
|
(let ((len (string-length s)))
|
||||||
|
|
@ -224,14 +224,14 @@
|
||||||
|
|
||||||
;; One match's replacement text. A string gets $N expansion; a fn (jolt closure)
|
;; One match's replacement text. A string gets $N expansion; a fn (jolt closure)
|
||||||
;; is called with the match result (whole string, or [whole g1 ...] when grouped)
|
;; is called with the match result (whole string, or [whole g1 ...] when grouped)
|
||||||
;; and its result stringified (mirrors the seed replacement-for).
|
;; and its result stringified.
|
||||||
(define (replacement-text replacement m)
|
(define (replacement-text replacement m)
|
||||||
(cond
|
(cond
|
||||||
((string? replacement) (expand-dollar replacement m))
|
((string? replacement) (expand-dollar replacement m))
|
||||||
((procedure? replacement) (jolt-str-render-one (jolt-invoke replacement (irx-result m))))
|
((procedure? replacement) (jolt-str-render-one (jolt-invoke replacement (irx-result m))))
|
||||||
(else (jolt-str-render-one replacement))))
|
(else (jolt-str-render-one replacement))))
|
||||||
|
|
||||||
;; regex replace, first or all matches. Mirrors the seed re-replace-all/first.
|
;; regex replace, first or all matches.
|
||||||
(define (re-replace irx s replacement all?)
|
(define (re-replace irx s replacement all?)
|
||||||
(let ((len (string-length s)))
|
(let ((len (string-length s)))
|
||||||
(let loop ((start 0) (last 0) (acc '()))
|
(let loop ((start 0) (last 0) (acc '()))
|
||||||
|
|
|
||||||
|
|
@ -1,16 +1,16 @@
|
||||||
;; type predicates + simple accessors (jolt-9ziu) — host-coupled seed natives.
|
;; type predicates + simple accessors (jolt-9ziu) — host-coupled natives.
|
||||||
;;
|
;;
|
||||||
;; These are seed primitives (not clojure.core overlay fns), so they're never
|
;; These are host primitives (not clojure.core overlay fns), so they're never
|
||||||
;; def-var!'d by the assembled prelude; the Chez host must provide them. Semantics
|
;; def-var!'d by the assembled prelude; the Chez host must provide them.
|
||||||
;; match the Janet seed (src/jolt/core_types.janet): map?/vector?/set? are STRICT
|
;; map?/vector?/set? are STRICT
|
||||||
;; over the persistent-collection records, seq? is true only for real sequences,
|
;; over the persistent-collection records, seq? is true only for real sequences,
|
||||||
;; coll? is the union. Records (shape-recs) are Phase 2, so the record arms of the
|
;; coll? is the union. Records (shape-recs) are Phase 2, so the record arms of the
|
||||||
;; seed predicates are simply absent here for now.
|
;; predicates are simply absent here for now.
|
||||||
|
|
||||||
(define (jolt-map? x) (pmap? x))
|
(define (jolt-map? x) (pmap? x))
|
||||||
;; a map entry is a pvec under the hood AND is vector? — Clojure's MapEntry
|
;; a map entry is a pvec under the hood AND is vector? — Clojure's MapEntry
|
||||||
;; implements IPersistentVector, so (vector? (first {:a 1})) is true (the seed
|
;; implements IPersistentVector, so (vector? (first {:a 1})) is true
|
||||||
;; agrees; jolt-75sv corrected the earlier exclusion).
|
;; (jolt-75sv corrected the earlier exclusion).
|
||||||
(define (jolt-vector? x) (pvec? x))
|
(define (jolt-vector? x) (pvec? x))
|
||||||
(define (jolt-set? x) (pset? x))
|
(define (jolt-set? x) (pset? x))
|
||||||
(define (jolt-seq? x) (or (cseq? x) (empty-list-t? x)))
|
(define (jolt-seq? x) (or (cseq? x) (empty-list-t? x)))
|
||||||
|
|
|
||||||
|
|
@ -33,8 +33,8 @@
|
||||||
((and (flonum? x) (fl= x +inf.0)) "Infinity")
|
((and (flonum? x) (fl= x +inf.0)) "Infinity")
|
||||||
((and (flonum? x) (fl= x -inf.0)) "-Infinity")
|
((and (flonum? x) (fl= x -inf.0)) "-Infinity")
|
||||||
((and (flonum? x) (not (fl= x x))) "NaN")
|
((and (flonum? x) (not (fl= x x))) "NaN")
|
||||||
;; transients print as a cold tagged type (the seed routes this through a
|
;; transients print as a cold tagged type (print-method routes this through a
|
||||||
;; print-method multimethod; the readable fallback renders it directly).
|
;; multimethod; the readable fallback renders it directly).
|
||||||
;; forward refs to transients.ss (loaded later) — resolved at call time.
|
;; forward refs to transients.ss (loaded later) — resolved at call time.
|
||||||
((jolt-transient? x)
|
((jolt-transient? x)
|
||||||
(if (pvec? (jolt-transient-coll x)) "#<transient vector>" "#<transient map>"))
|
(if (pvec? (jolt-transient-coll x)) "#<transient vector>" "#<transient map>"))
|
||||||
|
|
|
||||||
|
|
@ -1,16 +1,16 @@
|
||||||
;; Chez-side Clojure data reader (jolt-r8ku, inc Y).
|
;; Chez-side Clojure data reader (jolt-r8ku, inc Y).
|
||||||
;;
|
;;
|
||||||
;; The data half of runtime read/eval: a recursive-descent reader that parses
|
;; The data half of runtime read/eval: a recursive-descent reader that parses
|
||||||
;; ONE Clojure form off a string and produces the same jolt runtime values the
|
;; ONE Clojure form off a string and produces jolt runtime values
|
||||||
;; Janet reader's parse-next yields (the analyzer/eval half — eval, load-string,
|
;; (the analyzer/eval half — eval, load-string,
|
||||||
;; runtime defmacro — stays Phase-3, it needs the compiler at runtime). Two host
|
;; runtime defmacro — stays Phase-3, it needs the compiler at runtime). Two host
|
||||||
;; seams hang off it, matching the Janet seed (eval_runtime.janet):
|
;; seams hang off it:
|
||||||
;; read-string : string -> first form (clojure.core seam, src 772)
|
;; read-string : string -> first form (clojure.core seam, src 772)
|
||||||
;; __parse-next : string -> [form rest] | nil (the *in* family seam, src 801)
|
;; __parse-next : string -> [form rest] | nil (the *in* family seam, src 801)
|
||||||
;; read / read+string / with-in-str / line-seq / clojure.edn are Clojure over
|
;; read / read+string / with-in-str / line-seq / clojure.edn are Clojure over
|
||||||
;; these (jolt-core/clojure/core/50-io.clj, src/jolt/clojure/edn.clj).
|
;; these (jolt-core/clojure/core/50-io.clj, src/jolt/clojure/edn.clj).
|
||||||
;;
|
;;
|
||||||
;; Form shapes are pinned to the Janet reader's output (probed against build/jolt):
|
;; Form shapes:
|
||||||
;; sets -> {:jolt/type :jolt/set :value [...]} (a FORM, not a set)
|
;; sets -> {:jolt/type :jolt/set :value [...]} (a FORM, not a set)
|
||||||
;; #tag frm -> {:jolt/type :jolt/tagged :tag :#tag :form ...} (NO data reader)
|
;; #tag frm -> {:jolt/type :jolt/tagged :tag :#tag :form ...} (NO data reader)
|
||||||
;; #"src" -> {:jolt/type :jolt/tagged :tag :regex :form "src"}
|
;; #"src" -> {:jolt/type :jolt/tagged :tag :regex :form "src"}
|
||||||
|
|
@ -61,7 +61,7 @@
|
||||||
|
|
||||||
;; --- numbers ----------------------------------------------------------------
|
;; --- numbers ----------------------------------------------------------------
|
||||||
;; A token is a number iff it (after an optional sign) starts with a digit and
|
;; A token is a number iff it (after an optional sign) starts with a digit and
|
||||||
;; parses. Ratios and big-N/M decimals follow the seed's all-double rendering
|
;; parses. Ratios and big-N/M decimals use all-double rendering
|
||||||
;; for division; ints/bignums stay exact (Chez's tower IS Clojure's).
|
;; for division; ints/bignums stay exact (Chez's tower IS Clojure's).
|
||||||
(define (rdr-string-index-char str c)
|
(define (rdr-string-index-char str c)
|
||||||
(let ((n (string-length str)))
|
(let ((n (string-length str)))
|
||||||
|
|
@ -287,10 +287,10 @@
|
||||||
(make-symbol-t (symbol-t-ns target) (symbol-t-name target)
|
(make-symbol-t (symbol-t-ns target) (symbol-t-name target)
|
||||||
(rdr-merge-meta (symbol-t-meta target) meta))
|
(rdr-merge-meta (symbol-t-meta target) meta))
|
||||||
;; non-symbol target (a collection): lower to a runtime (with-meta form meta)
|
;; non-symbol target (a collection): lower to a runtime (with-meta form meta)
|
||||||
;; the analyzer compiles like any invoke — same as the Janet reader, so e.g.
|
;; the analyzer compiles like any invoke, so e.g.
|
||||||
;; (meta ^{:tag :int} [1 2]) and ^:foo {} carry their meta at runtime. The meta
|
;; (meta ^{:tag :int} [1 2]) and ^:foo {} carry their meta at runtime. The meta
|
||||||
;; pmap doubles as its own map-literal form. Use the BARE `with-meta` symbol
|
;; pmap doubles as its own map-literal form. Use the BARE `with-meta` symbol
|
||||||
;; (ns #f) to match the Janet reader exactly — the fn/defn macros unwrap a
|
;; (ns #f) — the fn/defn macros unwrap a
|
||||||
;; (with-meta <arglist-vec> _) return-hint by matching the unqualified head,
|
;; (with-meta <arglist-vec> _) return-hint by matching the unqualified head,
|
||||||
;; so a qualified clojure.core/with-meta would slip past them (^bytes [b]).
|
;; so a qualified clojure.core/with-meta would slip past them (^bytes [b]).
|
||||||
(jolt-list (jolt-symbol #f "with-meta") target meta)))
|
(jolt-list (jolt-symbol #f "with-meta") target meta)))
|
||||||
|
|
@ -299,7 +299,7 @@
|
||||||
;; #(...) anonymous fn shorthand (jolt-qjr0): % -> p1, %N -> pN, %& -> rest. The
|
;; #(...) anonymous fn shorthand (jolt-qjr0): % -> p1, %N -> pN, %& -> rest. The
|
||||||
;; fixed arity is the MAX positional used (Clojure: #(do %2 %&) -> [p1 p2 & rest]).
|
;; fixed arity is the MAX positional used (Clojure: #(do %2 %&) -> [p1 p2 & rest]).
|
||||||
;; Param names carry a trailing "#" so a #() inside a syntax-quote still reads them
|
;; Param names carry a trailing "#" so a #() inside a syntax-quote still reads them
|
||||||
;; as auto-gensyms. Mirrors src/jolt/reader.janet read-anon-fn.
|
;; as auto-gensyms.
|
||||||
(define rdr-anon-counter 0)
|
(define rdr-anon-counter 0)
|
||||||
(define (rdr-anon-gensym)
|
(define (rdr-anon-gensym)
|
||||||
(set! rdr-anon-counter (+ rdr-anon-counter 1))
|
(set! rdr-anon-counter (+ rdr-anon-counter 1))
|
||||||
|
|
@ -427,7 +427,7 @@
|
||||||
|
|
||||||
;; --- keyword ----------------------------------------------------------------
|
;; --- keyword ----------------------------------------------------------------
|
||||||
(define (rdr-read-keyword s i end) ; i points just past the leading ':'
|
(define (rdr-read-keyword s i end) ; i points just past the leading ':'
|
||||||
;; ::kw auto-resolves; the seed drops the ns, so skip a second ':'
|
;; ::kw auto-resolves; drop the ns, so skip a second ':'
|
||||||
(let ((i (if (and (< i end) (char=? (string-ref s i) #\:)) (+ i 1) i)))
|
(let ((i (if (and (< i end) (char=? (string-ref s i) #\:)) (+ i 1) i)))
|
||||||
(let-values (((tok j) (rdr-read-token s i end)))
|
(let-values (((tok j) (rdr-read-token s i end)))
|
||||||
(let-values (((ns name) (rdr-sym-parts tok)))
|
(let-values (((ns name) (rdr-sym-parts tok)))
|
||||||
|
|
@ -494,7 +494,7 @@
|
||||||
|
|
||||||
;; --- the two host seams -----------------------------------------------------
|
;; --- the two host seams -----------------------------------------------------
|
||||||
;; clojure.core/read-string: first form, or nil for blank / comment-only input
|
;; clojure.core/read-string: first form, or nil for blank / comment-only input
|
||||||
;; (the seed's parse-string wart, matched deliberately).
|
;; (parse-string wart, matched deliberately).
|
||||||
(define (jolt-read-string s)
|
(define (jolt-read-string s)
|
||||||
(let-values (((form j) (rdr-read-form s 0 (string-length s))))
|
(let-values (((form j) (rdr-read-form s 0 (string-length s))))
|
||||||
(if (rdr-eof? form) jolt-nil form)))
|
(if (rdr-eof? form) jolt-nil form)))
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
;; records + protocols (jolt-cf1q.3 Phase 2 inc D) — the deftype/defrecord +
|
;; records + protocols (jolt-cf1q.3 Phase 2 inc D) — the deftype/defrecord +
|
||||||
;; defprotocol/extend-type subsystem. These are ctx-capturing seed natives
|
;; defprotocol/extend-type subsystem. These are ctx-capturing natives
|
||||||
;; (eval_runtime.janet) that resolved to jolt-nil on the prelude, so every record
|
;; that resolved to jolt-nil on the prelude, so every record
|
||||||
;; case hit the apply-jolt-nil crash bucket.
|
;; case hit the apply-jolt-nil crash bucket.
|
||||||
;;
|
;;
|
||||||
;; A record is a `jrec`: a type tag ("ns.Name") + an alist of (kw . val) in
|
;; A record is a `jrec`: a type tag ("ns.Name") + an alist of (kw . val) in
|
||||||
|
|
@ -138,7 +138,7 @@
|
||||||
|
|
||||||
(define (record-tag obj) (and (jrec? obj) (jrec-tag obj)))
|
(define (record-tag obj) (and (jrec? obj) (jrec-tag obj)))
|
||||||
|
|
||||||
;; ---- the seed-native handles the analyzer/overlay call ----------------------
|
;; ---- the native that handles the analyzer/overlay call ----------------------
|
||||||
;; make-deftype-ctor: (name-sym field-kws field-tags field-muts) -> ctor closure.
|
;; make-deftype-ctor: (name-sym field-kws field-tags field-muts) -> ctor closure.
|
||||||
;; The tag is baked at definition time in the type's ns (chez-current-ns).
|
;; The tag is baked at definition time in the type's ns (chez-current-ns).
|
||||||
(define (make-deftype-ctor name-sym field-kws . _ignored)
|
(define (make-deftype-ctor name-sym field-kws . _ignored)
|
||||||
|
|
@ -156,7 +156,7 @@
|
||||||
(keyword #f "name") (jolt-symbol jolt-nil name-str)
|
(keyword #f "name") (jolt-symbol jolt-nil name-str)
|
||||||
(keyword #f "methods") methods))
|
(keyword #f "methods") methods))
|
||||||
|
|
||||||
;; register-protocol-methods!: devirt hint in the seed; a no-op for Chez dispatch.
|
;; register-protocol-methods!: a no-op for Chez dispatch.
|
||||||
(define (register-protocol-methods! proto-name method-names) jolt-nil)
|
(define (register-protocol-methods! proto-name method-names) jolt-nil)
|
||||||
|
|
||||||
;; register-method: extend-type/extend register an impl. Host type names keep a
|
;; register-method: extend-type/extend register an impl. Host type names keep a
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
;; Phase 1 (jolt-cf1q.2) — regex on Chez via vendored irregex (jolt-i0s3).
|
;; Phase 1 (jolt-cf1q.2) — regex on Chez via vendored irregex (jolt-i0s3).
|
||||||
;;
|
;;
|
||||||
;; jolt's seed regex (src/jolt/regex.janet) compiles patterns to Janet's PEG
|
;; Chez has no regex at all. We vendor
|
||||||
;; engine; Chez has no regex at all. Rather than re-host that engine, we vendor
|
|
||||||
;; Alex Shinn's irregex (vendor/irregex, BSD) — a portable Scheme regex with
|
;; Alex Shinn's irregex (vendor/irregex, BSD) — a portable Scheme regex with
|
||||||
;; PCRE/Java-style STRING patterns — and wrap jolt's re-* surface over it.
|
;; PCRE/Java-style STRING patterns — and wrap jolt's re-* surface over it.
|
||||||
;;
|
;;
|
||||||
|
|
@ -14,7 +13,7 @@
|
||||||
;;
|
;;
|
||||||
;; The re-* fns are def-var!'d into clojure.core so prelude / -e code resolves
|
;; The re-* fns are def-var!'d into clojure.core so prelude / -e code resolves
|
||||||
;; them at runtime (they're NOT subset native-ops: irregex's Unicode/property-
|
;; them at runtime (they're NOT subset native-ops: irregex's Unicode/property-
|
||||||
;; class semantics differ from the seed's byte-PEG approximation, so they stay out
|
;; class semantics keep them out
|
||||||
;; of the subset-parity corpus). Loaded from rt.ss after def-var! is defined.
|
;; of the subset-parity corpus). Loaded from rt.ss after def-var! is defined.
|
||||||
|
|
||||||
;; irregex.scm is portable R[457]RS; two small adaptations for Chez's top level:
|
;; irregex.scm is portable R[457]RS; two small adaptations for Chez's top level:
|
||||||
|
|
@ -35,17 +34,16 @@
|
||||||
(load "vendor/irregex/irregex.scm")
|
(load "vendor/irregex/irregex.scm")
|
||||||
|
|
||||||
;; Unicode property classes \p{...} (jolt-y1zq): irregex's string syntax has no
|
;; Unicode property classes \p{...} (jolt-y1zq): irregex's string syntax has no
|
||||||
;; \p{...}, so translate the ones the seed's byte-PEG maps (src/jolt/regex.janet
|
;; \p{...}, so translate a fixed set of property names
|
||||||
;; prop-frag) to ASCII char classes before compiling. ASCII-only — the seed counts
|
;; to ASCII char classes before compiling. ASCII-only — \p{L} would need
|
||||||
;; UTF-8 high bytes as letters for \p{L}, which a Unicode-char Scheme string can't
|
;; UTF-8 high bytes counted as letters, which a Unicode-char Scheme string can't
|
||||||
;; reproduce byte-for-byte; the corpus tests ASCII inputs, where they agree. An
|
;; reproduce byte-for-byte; the corpus tests ASCII inputs, where they agree. An
|
||||||
;; unmapped name is left as-is (irregex errors, as before — no new behavior). The
|
;; unmapped name is left as-is (irregex errors, as before — no new behavior). The
|
||||||
;; ORIGINAL source is kept for printing; only the compiled pattern is translated.
|
;; ORIGINAL source is kept for printing; only the compiled pattern is translated.
|
||||||
(define (prop-class name)
|
(define (prop-class name)
|
||||||
(cond
|
(cond
|
||||||
;; L/Alpha: ASCII letters + any non-ASCII codepoint (the seed counts UTF-8 high
|
;; L/Alpha: ASCII letters + any non-ASCII codepoint (UTF-8 high
|
||||||
;; bytes as letters, so ^\p{L}+$ accepts accented words). N/Z stay ASCII-only,
|
;; bytes count as letters, so ^\p{L}+$ accepts accented words). N/Z stay ASCII-only.
|
||||||
;; matching the seed's byte-PEG.
|
|
||||||
((or (string=? name "L") (string=? name "Alpha")) "a-zA-Z\\x80-\\x{10FFFF}")
|
((or (string=? name "L") (string=? name "Alpha")) "a-zA-Z\\x80-\\x{10FFFF}")
|
||||||
((string=? name "Lu") "A-Z")
|
((string=? name "Lu") "A-Z")
|
||||||
((string=? name "Ll") "a-z")
|
((string=? name "Ll") "a-z")
|
||||||
|
|
@ -55,7 +53,7 @@
|
||||||
((string=? name "Pe") ")\\]}")
|
((string=? name "Pe") ")\\]}")
|
||||||
(else #f)))
|
(else #f)))
|
||||||
;; Tracks whether the cursor is inside a [...] char class: a \p{X} there emits the
|
;; Tracks whether the cursor is inside a [...] char class: a \p{X} there emits the
|
||||||
;; class CONTENT (the seed inlines it), standalone it emits a wrapping [X]. Escapes
|
;; class CONTENT (inlined), standalone it emits a wrapping [X]. Escapes
|
||||||
;; (\[, \]) don't toggle the class. \P (negation) only wraps when standalone.
|
;; (\[, \]) don't toggle the class. \P (negation) only wraps when standalone.
|
||||||
(define (translate-prop-classes src)
|
(define (translate-prop-classes src)
|
||||||
(let ((len (string-length src)) (out (open-output-string)))
|
(let ((len (string-length src)) (out (open-output-string)))
|
||||||
|
|
@ -120,7 +118,7 @@
|
||||||
|
|
||||||
;; All non-overlapping matches, left to right. Advance past each match end (or by
|
;; All non-overlapping matches, left to right. Advance past each match end (or by
|
||||||
;; one on a zero-width match). nil when there are no matches (Clojure: seq-able as
|
;; one on a zero-width match). nil when there are no matches (Clojure: seq-able as
|
||||||
;; nil, so (if-let [m (re-seq ...)] ...) works), matching the seed.
|
;; nil, so (if-let [m (re-seq ...)] ...) works).
|
||||||
(define (jolt-re-seq re s)
|
(define (jolt-re-seq re s)
|
||||||
(let ((irx (regex-t-irx (jolt-re-pattern re)))
|
(let ((irx (regex-t-irx (jolt-re-pattern re)))
|
||||||
(len (string-length s)))
|
(len (string-length s)))
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@
|
||||||
;; reference reads at call time, so redefinition / mutual recursion work);
|
;; reference reads at call time, so redefinition / mutual recursion work);
|
||||||
;; 2. the rt primitive shims the emitter names (jolt-inc/dec/not) and jolt's
|
;; 2. the rt primitive shims the emitter names (jolt-inc/dec/not) and jolt's
|
||||||
;; number printing (all jolt numbers model Clojure doubles; integer-valued
|
;; number printing (all jolt numbers model Clojure doubles; integer-valued
|
||||||
;; print without a trailing ".0", matching the Janet host).
|
;; print without a trailing ".0").
|
||||||
;;
|
;;
|
||||||
;; Emitted programs do `(load "host/chez/rt.ss")`; this loads values.ss in turn.
|
;; Emitted programs do `(load "host/chez/rt.ss")`; this loads values.ss in turn.
|
||||||
|
|
||||||
|
|
@ -14,15 +14,15 @@
|
||||||
(load "host/chez/collections.ss")
|
(load "host/chez/collections.ss")
|
||||||
(load "host/chez/seq.ss")
|
(load "host/chez/seq.ss")
|
||||||
|
|
||||||
;; --- rt arithmetic / logic shims (named in emit.janet's native-ops) ----------
|
;; --- rt arithmetic / logic shims (named in the emitter's native-ops) ----------
|
||||||
(define (jolt-inc x) (+ x 1))
|
(define (jolt-inc x) (+ x 1))
|
||||||
(define (jolt-dec x) (- x 1))
|
(define (jolt-dec x) (- x 1))
|
||||||
;; jolt `not`: only nil and false are falsey.
|
;; jolt `not`: only nil and false are falsey.
|
||||||
(define (jolt-not x) (if (jolt-truthy? x) #f #t))
|
(define (jolt-not x) (if (jolt-truthy? x) #f #t))
|
||||||
|
|
||||||
;; --- exceptions (jolt-vcsl) --------------------------------------------------
|
;; --- exceptions (jolt-vcsl) --------------------------------------------------
|
||||||
;; throw raises the jolt value RAW (no envelope), like the Janet compiled back
|
;; throw raises the jolt value RAW (no envelope);
|
||||||
;; end; catch (emitted as `guard`) binds it directly. Chez `raise` accepts any
|
;; catch (emitted as `guard`) binds it directly. Chez `raise` accepts any
|
||||||
;; object, so a thrown number/map/ex-info all work; uncaught -> non-zero exit.
|
;; object, so a thrown number/map/ex-info all work; uncaught -> non-zero exit.
|
||||||
(define (jolt-throw v) (raise v))
|
(define (jolt-throw v) (raise v))
|
||||||
;; ex-info builds the tagged map {:jolt/type :jolt/ex-info :message :data :cause}
|
;; ex-info builds the tagged map {:jolt/type :jolt/ex-info :message :data :cause}
|
||||||
|
|
@ -130,7 +130,7 @@
|
||||||
|
|
||||||
;; --- jolt number printing ----------------------------------------------------
|
;; --- jolt number printing ----------------------------------------------------
|
||||||
;; jolt models every number as a Clojure double: integer-valued values print
|
;; jolt models every number as a Clojure double: integer-valued values print
|
||||||
;; without a ".0" (the Janet host prints (* 1.0 5) as "5", (/ 1 2) as "0.5").
|
;; without a ".0" ((* 1.0 5) prints as "5", (/ 1 2) as "0.5").
|
||||||
(define (jolt-num->string x)
|
(define (jolt-num->string x)
|
||||||
(cond
|
(cond
|
||||||
;; the -e / element printer renders the infinities and NaN as inf/-inf/nan
|
;; the -e / element printer renders the infinities and NaN as inf/-inf/nan
|
||||||
|
|
@ -144,7 +144,7 @@
|
||||||
|
|
||||||
;; Program-final-value printer. jolt's `-e` prints in str-style: strings raw (no
|
;; Program-final-value printer. jolt's `-e` prints in str-style: strings raw (no
|
||||||
;; quotes), chars as `\c`/`\newline`, collections recursively. NOTE: maps/sets
|
;; quotes), chars as `\c`/`\newline`, collections recursively. NOTE: maps/sets
|
||||||
;; render in HAMT-iteration order, which does NOT match the Janet host's order —
|
;; render in HAMT-iteration order, which is not a stable insertion order —
|
||||||
;; so unordered values are compared via `=` (true/false), not printed form.
|
;; so unordered values are compared via `=` (true/false), not printed form.
|
||||||
;; The full canonical printer is Phase 2.
|
;; The full canonical printer is Phase 2.
|
||||||
(define (jolt-str-join strs)
|
(define (jolt-str-join strs)
|
||||||
|
|
@ -236,7 +236,7 @@
|
||||||
;; and the printer (jolt-str-render-one).
|
;; and the printer (jolt-str-render-one).
|
||||||
(load "host/chez/host-class.ss")
|
(load "host/chez/host-class.ss")
|
||||||
|
|
||||||
;; dynamic vars (jolt-9ls5): *clojure-version* / *unchecked-math* constants the seed
|
;; dynamic vars (jolt-9ls5): *clojure-version* / *unchecked-math* constants the host
|
||||||
;; binds natively. After collections.ss (jolt-hash-map) + def-var!.
|
;; binds natively. After collections.ss (jolt-hash-map) + def-var!.
|
||||||
(load "host/chez/dynamic-vars.ss")
|
(load "host/chez/dynamic-vars.ss")
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -12,28 +12,14 @@ Both are **generated**, not hand-written. They are checked in because a fresh
|
||||||
checkout must be able to build jolt-on-Chez using only Chez: `host/chez/bootstrap.ss`
|
checkout must be able to build jolt-on-Chez using only Chez: `host/chez/bootstrap.ss`
|
||||||
loads this seed, then rebuilds the prelude + image from the `.clj`/`.ss` sources via
|
loads this seed, then rebuilds the prelude + image from the `.clj`/`.ss` sources via
|
||||||
the on-Chez compiler (read → analyze → emit, all on Chez). The seed is a **joint
|
the on-Chez compiler (read → analyze → emit, all on Chez). The seed is a **joint
|
||||||
byte-fixpoint**: rebuilding from an up-to-date seed reproduces it exactly
|
byte-fixpoint**: rebuilding from an up-to-date seed reproduces it exactly.
|
||||||
(`test/chez/bootstrap-test.janet` verifies this).
|
`make selfhost` (`host/chez/selfcheck.sh`) runs `host/chez/bootstrap.ss` and diffs
|
||||||
|
the rebuilt artifacts against the checked-in seed.
|
||||||
Janet was used once, historically, to mint the very first seed (the Janet analyzer/
|
|
||||||
emitter cross-compiled the sources, then the on-Chez compiler iterated to the
|
|
||||||
fixpoint — see `test/chez/fixpoint-test.janet`). After that, Janet is never needed
|
|
||||||
to build or run jolt-on-Chez.
|
|
||||||
|
|
||||||
## Re-minting
|
## Re-minting
|
||||||
|
|
||||||
When the seed sources change (the core tiers, the compiler namespaces, the host
|
When the seed sources change (the core tiers, the compiler namespaces, the host
|
||||||
contract, the reader, `emit-image.ss`), the seed drifts and `bootstrap-test`
|
contract, the reader, `emit-image.ss`), the seed drifts and `make selfhost`
|
||||||
fails. Re-mint it:
|
fails. Re-mint it by running `host/chez/bootstrap.ss` and writing the freshly
|
||||||
|
rebuilt prelude/image back to `host/chez/seed/prelude.ss` /
|
||||||
```janet
|
`host/chez/seed/image.ss`, then commit the refreshed files.
|
||||||
(import host/chez/driver :as d)
|
|
||||||
(import host/chez/jolt-chez :as jc)
|
|
||||||
(def ctx (d/make-ctx))
|
|
||||||
(d/mint-chez-seed* (jc/ensure-prelude ctx)
|
|
||||||
(d/ensure-compiler-image ctx "/tmp/stage1.ss")
|
|
||||||
"host/chez/seed/prelude.ss"
|
|
||||||
"host/chez/seed/image.ss")
|
|
||||||
```
|
|
||||||
|
|
||||||
Then commit the refreshed `prelude.ss` / `image.ss`.
|
|
||||||
|
|
|
||||||
|
|
@ -23,7 +23,7 @@
|
||||||
;; only thing that distinguishes a list from any other realized seq on this host,
|
;; only thing that distinguishes a list from any other realized seq on this host,
|
||||||
;; since one record type backs both (clojure.core/list? — jolt-75sv). The marker
|
;; since one record type backs both (clojure.core/list? — jolt-75sv). The marker
|
||||||
;; lives on the cell, so (rest a-list) / (seq a-vector) / (map …) yield plain seq
|
;; lives on the cell, so (rest a-list) / (seq a-vector) / (map …) yield plain seq
|
||||||
;; cells and are not list?, matching the seed.
|
;; cells and are not list?.
|
||||||
(define-record-type cseq (fields head (mutable tail) (mutable forced?) list?) (nongenerative chez-cseq-v2))
|
(define-record-type cseq (fields head (mutable tail) (mutable forced?) list?) (nongenerative chez-cseq-v2))
|
||||||
(define (cseq-realized head tail) (make-cseq head tail #t #f)) ; tail already a seq
|
(define (cseq-realized head tail) (make-cseq head tail #t #f)) ; tail already a seq
|
||||||
(define (cseq-lazy head tail-thunk) (make-cseq head tail-thunk #f #f))
|
(define (cseq-lazy head tail-thunk) (make-cseq head tail-thunk #f #f))
|
||||||
|
|
@ -84,11 +84,11 @@
|
||||||
;; other (if (next s) ...) loops over a lazy seq ran one step too far.
|
;; other (if (next s) ...) loops over a lazy seq ran one step too far.
|
||||||
(let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-nil (jolt-seq (seq-more s)))))
|
(let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-nil (jolt-seq (seq-more s)))))
|
||||||
;; Only the HEAD cell carries the list marker — (rest a-list)/(next a-list) return
|
;; Only the HEAD cell carries the list marker — (rest a-list)/(next a-list) return
|
||||||
;; the unmarked tail, so they are seqs and not list?, matching the seed (which
|
;; the unmarked tail, so they are seqs and not list? (rest-of-a-list is a non-list
|
||||||
;; makes rest-of-a-list a non-list seq). cons/list/reverse/conj therefore mark
|
;; seq). cons/list/reverse/conj therefore mark
|
||||||
;; just the cell they create.
|
;; just the cell they create.
|
||||||
;;
|
;;
|
||||||
;; cons always yields a list — (list? (cons x anything)) is true on the seed (cons
|
;; cons always yields a list — (list? (cons x anything)) is true (cons
|
||||||
;; onto a vector/seq/nil all report list?).
|
;; onto a vector/seq/nil all report list?).
|
||||||
(define (jolt-cons x coll) (cseq-list x (jolt-seq coll)))
|
(define (jolt-cons x coll) (cseq-list x (jolt-seq coll)))
|
||||||
;; Scheme list -> a jolt PersistentList: head is a list cell, the tail chain is
|
;; Scheme list -> a jolt PersistentList: head is a list cell, the tail chain is
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
;; syntax-quote form builders (jolt-r9lm, inc6b) — the Chez analogs of
|
;; syntax-quote form builders (jolt-r9lm, inc6b). A macro expander whose body was a
|
||||||
;; core_types.janet's core-sq*. A cross-compiled macro expander whose body was a
|
;; syntax-quote template (lowered by jolt.host/form-syntax-quote-lower) calls these
|
||||||
;; syntax-quote template (lowered by jolt.host/form-syntax-quote-lower at Janet
|
;; at RUNTIME on Chez to build the EXPANSION as
|
||||||
;; cross-compile time) calls these at RUNTIME on Chez to build the EXPANSION as
|
|
||||||
;; Chez READER forms (cseq list / pvec / pmap / tagged-set pmap) so the on-Chez
|
;; Chez READER forms (cseq list / pvec / pmap / tagged-set pmap) so the on-Chez
|
||||||
;; analyzer can re-analyze it. def-var!'d into clojure.core, so the lowered body's
|
;; analyzer can re-analyze it. def-var!'d into clojure.core, so the lowered body's
|
||||||
;; unqualified __sqcat/__sqvec/__sqmap/__sqset/__sq1 refs (which lower to var-deref
|
;; unqualified __sqcat/__sqvec/__sqmap/__sqset/__sq1 refs (which lower to var-deref
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
;; clojure.core — kernel tier (stage just above the Janet seed).
|
;; clojure.core — kernel tier (stage just above the host primitives).
|
||||||
;;
|
;;
|
||||||
;; These are the structural fns the self-hosted compiler itself uses
|
;; These are the structural fns the self-hosted compiler itself uses
|
||||||
;; (jolt.analyzer): second/peek/subvec/mapv/update. Because the compiler must be
|
;; (jolt.analyzer): second/peek/subvec/mapv/update. Because the compiler must be
|
||||||
|
|
@ -6,12 +6,11 @@
|
||||||
;; before it is built. So this tier is loaded FIRST and, in compile mode, is
|
;; 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
|
;; bootstrap-compiled directly into clojure.core (not routed through the
|
||||||
;; self-hosted pipeline, which would need these to already exist — the
|
;; self-hosted pipeline, which would need these to already exist — the
|
||||||
;; circularity that previously forced `second` to stay in Janet). With this tier
|
;; circularity that previously forced `second` to stay a host primitive). With this tier
|
||||||
;; in place the analyzer is built against the Clojure definitions and the Janet
|
;; in place the analyzer is built against the Clojure definitions.
|
||||||
;; primitives are gone.
|
|
||||||
;;
|
;;
|
||||||
;; Constraint: depend only on core-renames primitives (first/next/nth/count/conj/
|
;; 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.
|
;; vec/map/apply/assoc/get/…, all hardwired to host primitives) and on each other.
|
||||||
|
|
||||||
(defn second [coll] (first (next coll)))
|
(defn second [coll] (first (next coll)))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -157,8 +157,8 @@
|
||||||
(defmacro declare [& syms]
|
(defmacro declare [& syms]
|
||||||
`(do ~@(map (fn* [s] `(def ~s)) syms)))
|
`(do ~@(map (fn* [s] `(def ~s)) syms)))
|
||||||
|
|
||||||
;; destructure — Clojure's binding-vector expander, ported from the Janet seed
|
;; destructure — Clojure's binding-vector expander.
|
||||||
;; (was core-destructure). Turns a binding vector that may contain destructuring
|
;; Turns a binding vector that may contain destructuring
|
||||||
;; patterns into a plain binding vector (alternating symbol / init-form) built from
|
;; 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
|
;; nth/nthnext/get, so the COMPILER only ever sees plain symbols (analyze-bindings
|
||||||
;; rejects patterns). `let` consumes it directly; `loop`/`fn` reuse it transitively
|
;; rejects patterns). `let` consumes it directly; `loop`/`fn` reuse it transitively
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
;; clojure.core — seq tier. Pure-Clojure leaf sequence fns on top of the kernel
|
;; 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
|
;; tier (00-kernel) and the host primitives. Loaded after the kernel tier; in compile
|
||||||
;; mode these self-host through the now-built analyzer (interpreted otherwise).
|
;; mode these self-host through the now-built analyzer (interpreted otherwise).
|
||||||
;;
|
;;
|
||||||
;; Migration rule for adding fns here: the fn must (1) NOT be in
|
;; Migration rule for adding fns here: the fn must (1) NOT be in
|
||||||
|
|
|
||||||
|
|
@ -16,7 +16,7 @@
|
||||||
;; neg? throws on non-numbers via <, as Clojure's Numbers.isNeg does.
|
;; neg? throws on non-numbers via <, as Clojure's Numbers.isNeg does.
|
||||||
(defn neg? [x] (< x 0))
|
(defn neg? [x] (< x 0))
|
||||||
|
|
||||||
;; even?/odd? stay in the seed: (filter even? ...) is idiomatic-hot and the
|
;; even?/odd? stay host primitives: (filter even? ...) is idiomatic-hot and the
|
||||||
;; overlay versions cost an extra call layer per element (seq-pipe bench 4x).
|
;; overlay versions cost an extra call layer per element (seq-pipe bench 4x).
|
||||||
|
|
||||||
;; Variadic bit ops — canonical Clojure arities folding the binary host op
|
;; Variadic bit ops — canonical Clojure arities folding the binary host op
|
||||||
|
|
@ -355,9 +355,9 @@
|
||||||
(make-hierarchy) (partition 2 deriv-seq))
|
(make-hierarchy) (partition 2 deriv-seq))
|
||||||
h))))
|
h))))
|
||||||
|
|
||||||
;; --- Stage 3 tier shrink: pure-over-core leaves moved off the Janet seed ----
|
;; --- Stage 3 tier shrink: pure-over-core leaves moved off the host primitives ----
|
||||||
|
|
||||||
;; Representation predicates over the overlay's own predicates (no Janet reps).
|
;; Representation predicates over the overlay's own predicates.
|
||||||
(defn sequential? [x] (or (vector? x) (seq? x)))
|
(defn sequential? [x] (or (vector? x) (seq? x)))
|
||||||
(defn associative? [x] (or (map? x) (vector? x)))
|
(defn associative? [x] (or (map? x) (vector? x)))
|
||||||
(defn counted? [x]
|
(defn counted? [x]
|
||||||
|
|
@ -381,10 +381,10 @@
|
||||||
|
|
||||||
|
|
||||||
;; realized?: defined on the pending types only (delay/lazy-seq/future read
|
;; realized?: defined on the pending types only (delay/lazy-seq/future read
|
||||||
;; Tagged-value predicates. The constructors (atom/volatile!/...) stay in Janet,
|
;; Tagged-value predicates. The constructors (atom/volatile!/...) are host
|
||||||
;; but every tagged value carries its kind under :jolt/type (records under
|
;; primitives, but every tagged value carries its kind under :jolt/type (records
|
||||||
;; :jolt/deftype), reachable via get — which is nil on non-tables — so the
|
;; 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.
|
;; predicates are pure over get.
|
||||||
(defn atom? [x] (= (get x :jolt/type) :jolt/atom))
|
(defn atom? [x] (= (get x :jolt/type) :jolt/atom))
|
||||||
(defn volatile? [x] (= (get x :jolt/type) :jolt/volatile))
|
(defn volatile? [x] (= (get x :jolt/type) :jolt/volatile))
|
||||||
(defn reader-conditional? [x] (= (get x :jolt/type) :jolt/reader-conditional))
|
(defn reader-conditional? [x] (= (get x :jolt/type) :jolt/reader-conditional))
|
||||||
|
|
@ -418,7 +418,7 @@
|
||||||
:else (throw (str "pop not supported on: " coll))))
|
:else (throw (str "pop not supported on: " coll))))
|
||||||
|
|
||||||
;; doall/dorun: realization boundaries. dorun walks (optionally at most n
|
;; doall/dorun: realization boundaries. dorun walks (optionally at most n
|
||||||
;; steps — the Janet seed version ignored n); doall walks then returns coll.
|
;; steps); doall walks then returns coll.
|
||||||
(defn dorun
|
(defn dorun
|
||||||
([coll]
|
([coll]
|
||||||
(loop [s (seq coll)]
|
(loop [s (seq coll)]
|
||||||
|
|
@ -791,7 +791,7 @@
|
||||||
(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
|
(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
|
||||||
(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
|
(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
|
||||||
|
|
||||||
;; No class hierarchy on the Janet host.
|
;; No class hierarchy on this host.
|
||||||
(defn supers [x] #{})
|
(defn supers [x] #{})
|
||||||
|
|
||||||
;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
|
;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
|
||||||
|
|
@ -949,7 +949,7 @@
|
||||||
;; inst-ms itself.
|
;; inst-ms itself.
|
||||||
(defn inst-ms* [i] (inst-ms i))
|
(defn inst-ms* [i] (inst-ms i))
|
||||||
|
|
||||||
;; Canonical comp — here rather than the seed so each stage is invoked with
|
;; Canonical comp — here rather than a host primitive so each stage is invoked with
|
||||||
;; jolt call semantics: (comp seq :content) works because the keyword stage
|
;; jolt call semantics: (comp seq :content) works because the keyword stage
|
||||||
;; goes through IFn dispatch (raw Janet keyword application does not).
|
;; goes through IFn dispatch (raw Janet keyword application does not).
|
||||||
(defn comp
|
(defn comp
|
||||||
|
|
@ -1078,7 +1078,7 @@
|
||||||
(let [xf (xform f)]
|
(let [xf (xform f)]
|
||||||
(xf (reduce xf init coll)))))
|
(xf (reduce xf init coll)))))
|
||||||
|
|
||||||
;; into stays in the seed: it's perf-wall hot (the into-vec bench pays ~11%
|
;; into stays a host primitive: it's perf-wall hot (the into-vec bench pays ~11%
|
||||||
;; through the overlay call layers — same lesson as even?/odd? in round 4).
|
;; through the overlay call layers — same lesson as even?/odd? in round 4).
|
||||||
|
|
||||||
;; eduction is EAGER on jolt (documented divergence, as before): the composed
|
;; eduction is EAGER on jolt (documented divergence, as before): the composed
|
||||||
|
|
@ -1116,8 +1116,8 @@
|
||||||
|
|
||||||
;; print-method / print-dup are real multimethods in the io tier (50-io.clj).
|
;; print-method / print-dup are real multimethods in the io tier (50-io.clj).
|
||||||
|
|
||||||
;; JVM proxies don't exist on a Janet host: the read-only surface is inert,
|
;; JVM proxies don't exist on this host: the read-only surface is inert,
|
||||||
;; the constructive surface throws (matching the prior seed stubs).
|
;; the constructive surface throws.
|
||||||
(defn proxy-mappings [p] {})
|
(defn proxy-mappings [p] {})
|
||||||
(defn proxy-call-with-super [f p meth] (f))
|
(defn proxy-call-with-super [f p meth] (f))
|
||||||
(defn init-proxy [p mappings] p)
|
(defn init-proxy [p mappings] p)
|
||||||
|
|
|
||||||
|
|
@ -17,7 +17,7 @@
|
||||||
;; and the methods become functions — the algorithm is identical.
|
;; and the methods become functions — the algorithm is identical.
|
||||||
;;
|
;;
|
||||||
;; A sorted-SET stores its elements as keys with a nil value; its ops project the
|
;; A sorted-SET stores its elements as keys with a nil value; its ops project the
|
||||||
;; key. ALL the semantics live here in Clojure; the Janet seed keeps only its
|
;; key. ALL the semantics live here in Clojure; the host keeps only its
|
||||||
;; dispatch branches (conj/assoc/get/seq/count/…), each a one-line call through
|
;; dispatch branches (conj/assoc/get/seq/count/…), each a one-line call through
|
||||||
;; the value's own :ops table, so the ops travel WITH the value (correct across
|
;; the value's own :ops table, so the ops travel WITH the value (correct across
|
||||||
;; contexts, forks, and AOT images). The wrapper is minted/read through the host
|
;; contexts, forks, and AOT images). The wrapper is minted/read through the host
|
||||||
|
|
@ -286,7 +286,7 @@
|
||||||
|
|
||||||
(defn- ss-disj-many [ss xs] (reduce ss-disj-1 ss xs))
|
(defn- ss-disj-many [ss xs] (reduce ss-disj-1 ss xs))
|
||||||
|
|
||||||
;; --- the ops tables the Janet seed dispatches through ------------------------
|
;; --- the ops tables the host dispatches through ------------------------
|
||||||
|
|
||||||
(def ^:private sm-ops
|
(def ^:private sm-ops
|
||||||
{:count (fn [sm] (sfield sm :cnt))
|
{:count (fn [sm] (sfield sm :cnt))
|
||||||
|
|
|
||||||
|
|
@ -5,9 +5,9 @@
|
||||||
;; IMPORTANT — only macros NOT used by the self-hosted compiler (jolt-core/jolt/*)
|
;; 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/
|
;; 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
|
;; 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.
|
;; tier loads, so they remain host primitives for now. Everything here is user-facing.
|
||||||
;;
|
;;
|
||||||
;; Migration: remove the Janet core-X macro fn AND its core-macro-names entry when
|
;; Migration: remove the host core-X macro fn AND its core-macro-names entry when
|
||||||
;; moving a macro here (defmacro installs the :macro flag itself).
|
;; moving a macro here (defmacro installs the :macro flag itself).
|
||||||
|
|
||||||
(defmacro comment [& body] nil)
|
(defmacro comment [& body] nil)
|
||||||
|
|
|
||||||
|
|
@ -86,7 +86,7 @@
|
||||||
()))
|
()))
|
||||||
|
|
||||||
;; --- repeatedly --- ((f) throws on a non-fn; (take n …) throws on a non-number
|
;; --- repeatedly --- ((f) throws on a non-fn; (take n …) throws on a non-number
|
||||||
;; count — both now enforced in the seed (jolt-call / core-take), so the canonical
|
;; count — both enforced by the host (jolt-call / take), so the canonical
|
||||||
;; CLJ form matches the repeatedly.cljc exception cases.)
|
;; CLJ form matches the repeatedly.cljc exception cases.)
|
||||||
(defn repeatedly
|
(defn repeatedly
|
||||||
([f] (lazy-seq (cons (f) (repeatedly f))))
|
([f] (lazy-seq (cons (f) (repeatedly f))))
|
||||||
|
|
@ -105,8 +105,8 @@
|
||||||
;; --- partition-all --- (transducer + [n coll] + [n step coll])
|
;; --- partition-all --- (transducer + [n coll] + [n step coll])
|
||||||
;; The collection arities realize EXACTLY n per chunk via a first/rest loop and
|
;; The collection arities realize EXACTLY n per chunk via a first/rest loop and
|
||||||
;; continue from the advanced cursor (not a re-drop / nthrest), so they realize
|
;; continue from the advanced cursor (not a re-drop / nthrest), so they realize
|
||||||
;; minimally — matching the Janet pstep the §6.3 laziness counters were written
|
;; minimally — the §6.3 laziness counters depend on this.
|
||||||
;; against. (A take/nthrest form is correct but over-realizes.)
|
;; (A take/nthrest form is correct but over-realizes.)
|
||||||
(defn partition-all
|
(defn partition-all
|
||||||
([n]
|
([n]
|
||||||
(fn [rf]
|
(fn [rf]
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,7 @@
|
||||||
bootstrap can compile this namespace via its plain :var path. ctx is an opaque
|
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.
|
host handle threaded to the contract fns; the analyzer never inspects it.
|
||||||
|
|
||||||
Coverage grows toward compiler.janet; unsupported forms throw :jolt/uncompilable
|
Unsupported forms throw :jolt/uncompilable
|
||||||
so the caller falls back to the interpreter (the hybrid contract).
|
so the caller falls back to the interpreter (the hybrid contract).
|
||||||
|
|
||||||
`env` carries lexical state: {:locals #{names} :recur recur-target-name|nil}.
|
`env` carries lexical state: {:locals #{names} :recur recur-target-name|nil}.
|
||||||
|
|
@ -140,8 +140,8 @@
|
||||||
;; form (the Chez data reader) wraps an arglist vector carrying a return-type hint
|
;; form (the Chez data reader) wraps an arglist vector carrying a return-type hint
|
||||||
;; (^bytes [b] / ^String [x y]). Unwrap to the underlying vector so fn parsing sees
|
;; (^bytes [b] / ^String [x y]). Unwrap to the underlying vector so fn parsing sees
|
||||||
;; the params — the hint is ignored at runtime. Only the (with-meta <vec> _) shape
|
;; the params — the hint is ignored at runtime. Only the (with-meta <vec> _) shape
|
||||||
;; matches, so a real arity clause (head is a vector) and the Janet reader's
|
;; matches, so a real arity clause (head is a vector) and a
|
||||||
;; meta-on-tuple (already a vector) pass through unchanged.
|
;; meta-on-vector arglist pass through unchanged.
|
||||||
(defn- strip-arglist-meta [form]
|
(defn- strip-arglist-meta [form]
|
||||||
(if (form-list? form)
|
(if (form-list? form)
|
||||||
(let [es (vec (form-elements form))]
|
(let [es (vec (form-elements form))]
|
||||||
|
|
@ -212,10 +212,10 @@
|
||||||
;; letfn: (letfn [(name [params] body*)...] body*). The named local fns are
|
;; letfn: (letfn [(name [params] body*)...] body*). The named local fns are
|
||||||
;; MUTUALLY recursive, so bind every name into the env BEFORE analyzing any spec
|
;; MUTUALLY recursive, so bind every name into the env BEFORE analyzing any spec
|
||||||
;; — each spec then resolves its siblings (and itself) as locals. Emitted as a
|
;; — each spec then resolves its siblings (and itself) as locals. Emitted as a
|
||||||
;; :let flagged :letrec so the back ends know the bindings forward-reference each
|
;; :let flagged :letrec so the back end knows the bindings forward-reference each
|
||||||
;; other: Chez lowers it to `letrec*`; the Janet back end punts to the
|
;; other: Chez lowers it to `letrec*`. The interpreter's shared mutable env already
|
||||||
;; interpreter (its shared mutable env already gives the letrec semantics that a
|
;; gives the letrec semantics that a
|
||||||
;; compiled sequential let* lacks — the reason letfn was uncompilable before).
|
;; compiled sequential let* lacks — the reason letfn was uncompilable before.
|
||||||
(defn- analyze-letfn [ctx items env]
|
(defn- analyze-letfn [ctx items env]
|
||||||
(let [specs (vec (form-vec-items (nth items 1)))
|
(let [specs (vec (form-vec-items (nth items 1)))
|
||||||
names (mapv #(form-sym-name (first (vec (form-elements %)))) specs)
|
names (mapv #(form-sym-name (first (vec (form-elements %)))) specs)
|
||||||
|
|
@ -252,9 +252,9 @@
|
||||||
(uncompilable "def name with map metadata"))
|
(uncompilable "def name with map metadata"))
|
||||||
(if (< (count items) 3)
|
(if (< (count items) 3)
|
||||||
;; (def name) with no init (declare): intern + reserve the cell so a
|
;; (def name) with no init (declare): intern + reserve the cell so a
|
||||||
;; forward reference resolves. The back ends key on :no-init — Chez
|
;; forward reference resolves. The back end keys on :no-init — Chez
|
||||||
;; def-var!s an unbound placeholder; the Janet back end punts to the
|
;; def-var!s an unbound placeholder; the interpreter interns a
|
||||||
;; interpreter, which interns a genuinely-unbound var.
|
;; genuinely-unbound var.
|
||||||
(let [nm (form-sym-name name-sym) cur (compile-ns ctx)]
|
(let [nm (form-sym-name name-sym) cur (compile-ns ctx)]
|
||||||
(host-intern! ctx cur nm)
|
(host-intern! ctx cur nm)
|
||||||
{:op :def :ns cur :name nm :no-init true})
|
{:op :def :ns cur :name nm :no-init true})
|
||||||
|
|
@ -297,8 +297,7 @@
|
||||||
|
|
||||||
;; Host interop method call (jolt-0kf5). `(.method target arg*)` — a head that
|
;; Host interop method call (jolt-0kf5). `(.method target arg*)` — a head that
|
||||||
;; starts with "." but not ".-" (field access stays punted). Analyzes to a
|
;; starts with "." but not ".-" (field access stays punted). Analyzes to a
|
||||||
;; :host-call node; the Janet back end punts it at emit (no interop model -> the
|
;; :host-call node; the Chez back end lowers it to a jolt-host-call dispatch.
|
||||||
;; interpreter runs it), the Chez back end lowers it to a jolt-host-call dispatch.
|
|
||||||
(defn- method-head? [nm]
|
(defn- method-head? [nm]
|
||||||
(and (> (count nm) 1)
|
(and (> (count nm) 1)
|
||||||
(= "." (subs nm 0 1))
|
(= "." (subs nm 0 1))
|
||||||
|
|
@ -320,9 +319,8 @@
|
||||||
(not (= "." (subs nm 0 1)))))
|
(not (= "." (subs nm 0 1)))))
|
||||||
|
|
||||||
;; `(Class. args*)` and `(new Class args*)` -> a :host-new node carrying the class
|
;; `(Class. args*)` and `(new Class args*)` -> a :host-new node carrying the class
|
||||||
;; token and the analyzed args. The Janet back end punts it (the interpreter runs
|
;; token and the analyzed args. The Chez back end lowers it to a runtime
|
||||||
;; the constructor from its class-ctors registry); the Chez back end lowers it to
|
;; constructor dispatch (jolt-avt6).
|
||||||
;; a runtime constructor dispatch (jolt-avt6).
|
|
||||||
(defn- analyze-ctor [ctx class args env]
|
(defn- analyze-ctor [ctx class args env]
|
||||||
(host-new class (mapv #(analyze ctx % env) args)))
|
(host-new class (mapv #(analyze ctx % env) args)))
|
||||||
|
|
||||||
|
|
@ -330,10 +328,8 @@
|
||||||
;; A symbol member whose name starts with "-" is a field read; otherwise it is a
|
;; A symbol member whose name starts with "-" is a field read; otherwise it is a
|
||||||
;; method (call with the trailing args). Both lower to a :host-call carrying the
|
;; method (call with the trailing args). Both lower to a :host-call carrying the
|
||||||
;; member name verbatim (the leading "-" survives so the runtime dispatcher reads
|
;; member name verbatim (the leading "-" survives so the runtime dispatcher reads
|
||||||
;; it as a field). The Janet back end punts :host-call to the interpreter, which
|
;; it as a field). The Chez back end dispatches it through record-method-dispatch
|
||||||
;; re-runs the original `.` form via eval-dot — so Janet behavior is unchanged;
|
;; (jolt-kuic).
|
||||||
;; the Chez back end dispatches it through record-method-dispatch (jolt-kuic).
|
|
||||||
;; A non-symbol member (e.g. a keyword) stays punted — the interpreter handles it.
|
|
||||||
(defn- analyze-dot [ctx items env]
|
(defn- analyze-dot [ctx items env]
|
||||||
(when (< (count items) 3)
|
(when (< (count items) 3)
|
||||||
(throw (str "Malformed (. target member ...) form")))
|
(throw (str "Malformed (. target member ...) form")))
|
||||||
|
|
@ -367,11 +363,8 @@
|
||||||
(if (= :var (:kind r))
|
(if (= :var (:kind r))
|
||||||
(var-ref (:ns r) (:name r))
|
(var-ref (:ns r) (:name r))
|
||||||
;; A non-var qualified ref `Class/member` is a host class static
|
;; A non-var qualified ref `Class/member` is a host class static
|
||||||
;; (Math/sqrt, Long/MAX_VALUE, System/getenv). The Janet back end
|
;; (Math/sqrt, Long/MAX_VALUE, System/getenv). The Chez back end
|
||||||
;; punts the :host-static node (the interpreter resolves it from its
|
;; lowers it to a runtime static dispatch (jolt-avt6).
|
||||||
;; class-statics registry, exactly as it did when this was an
|
|
||||||
;; uncompilable); the Chez back end lowers it to a runtime static
|
|
||||||
;; dispatch (jolt-avt6).
|
|
||||||
(host-static ns nm)))
|
(host-static ns nm)))
|
||||||
:else (let [r (resolve-global ctx form)]
|
:else (let [r (resolve-global ctx form)]
|
||||||
(case (:kind r)
|
(case (:kind r)
|
||||||
|
|
@ -445,12 +438,10 @@
|
||||||
(form-map-pairs form)))
|
(form-map-pairs form)))
|
||||||
(form-set? form) (set-node (mapv #(analyze ctx % env) (form-set-items form)))
|
(form-set? form) (set-node (mapv #(analyze ctx % env) (form-set-items form)))
|
||||||
(form-list? form) (analyze-list ctx form env)
|
(form-list? form) (analyze-list ctx form env)
|
||||||
;; regex literal #"…" -> a :regex IR node (leaf). The Janet back end punts it
|
;; regex literal #"…" -> a :regex IR node (leaf). The Chez back end emits a
|
||||||
;; (interpreter compiles via the seed PEG engine); the Chez back end emits a
|
|
||||||
;; jolt-regex value over the vendored irregex.
|
;; jolt-regex value over the vendored irregex.
|
||||||
(form-regex? form) {:op :regex :source (form-regex-source form)}
|
(form-regex? form) {:op :regex :source (form-regex-source form)}
|
||||||
;; #inst / #uuid literals -> :inst / :uuid IR leaves. Like :regex, the Janet
|
;; #inst / #uuid literals -> :inst / :uuid IR leaves. The Chez back
|
||||||
;; back end punts (the interpreter's data-readers parse them); the Chez back
|
|
||||||
;; end emits a runtime inst/uuid value (host/chez/inst-time.ss).
|
;; end emits a runtime inst/uuid value (host/chez/inst-time.ss).
|
||||||
(form-inst? form) {:op :inst :source (form-inst-source form)}
|
(form-inst? form) {:op :inst :source (form-inst-source form)}
|
||||||
(form-uuid? form) {:op :uuid :source (form-uuid-source form)}
|
(form-uuid? form) {:op :uuid :source (form-uuid-source form)}
|
||||||
|
|
|
||||||
|
|
@ -1,15 +1,14 @@
|
||||||
(ns jolt.backend-scheme
|
(ns jolt.backend-scheme
|
||||||
"Portable Clojure IR -> Chez Scheme emitter (Chez Phase 3, jolt-cf1q.4).
|
"Portable Clojure IR -> Chez Scheme emitter (Chez Phase 3, jolt-cf1q.4).
|
||||||
|
|
||||||
The no-Janet replacement for host/chez/emit.janet: consumes the same
|
Consumes the
|
||||||
host-neutral IR (jolt.ir, see jolt-core/jolt/ir.clj) the analyzer produces and
|
host-neutral IR (jolt.ir, see jolt-core/jolt/ir.clj) the analyzer produces and
|
||||||
emits Chez Scheme source TEXT. Pure jolt-core (clojure.core + clojure.string
|
emits Chez Scheme source TEXT. Pure jolt-core (clojure.core + clojure.string
|
||||||
only) so that, once cross-compiled, it runs ON Chez and the analyzer can emit
|
only) so that, once cross-compiled, it runs ON Chez and the analyzer can emit
|
||||||
its own code with no Janet in the loop — the bootstrap spine.
|
its own code — the bootstrap spine.
|
||||||
|
|
||||||
Output is a STRING of Scheme source; `host/compile` on Chez is `(eval (read
|
Output is a STRING of Scheme source; `host/compile` on Chez is `(eval (read
|
||||||
...))`. Mirrors emit.janet op-for-op so the value-parity gate holds against the
|
...))`. Lowers each IR op to Scheme.
|
||||||
Janet emitter while the port is in flight.
|
|
||||||
|
|
||||||
INCREMENT 1 (jolt-hg7z): const/local/var/the-var/if/do/let/loop/recur/invoke
|
INCREMENT 1 (jolt-hg7z): const/local/var/the-var/if/do/let/loop/recur/invoke
|
||||||
(+ native-ops)/fn/def + the escaping/flonum/munge helpers.
|
(+ native-ops)/fn/def + the escaping/flonum/munge helpers.
|
||||||
|
|
@ -17,7 +16,7 @@
|
||||||
quote (emit-quoted, walks the raw reader form via the portable jolt.host form-*
|
quote (emit-quoted, walks the raw reader form via the portable jolt.host form-*
|
||||||
contract — same seam the analyzer uses, so it stays host-neutral).
|
contract — same seam the analyzer uses, so it stays host-neutral).
|
||||||
INCREMENT 3 (jolt-me6m): try/throw + host-call + regex/inst/uuid + def-meta +
|
INCREMENT 3 (jolt-me6m): try/throw + host-call + regex/inst/uuid + def-meta +
|
||||||
quoted-symbol-meta. With this the emitter covers every op emit.janet handles.
|
quoted-symbol-meta. With this the emitter covers every IR op.
|
||||||
emit-quoted now also reconstructs plain jolt VALUES (def/symbol :meta), enabled
|
emit-quoted now also reconstructs plain jolt VALUES (def/symbol :meta), enabled
|
||||||
by making :meta a portable struct at the host seam (h-sym-meta). Program
|
by making :meta a portable struct at the host seam (h-sym-meta). Program
|
||||||
assembly + the prelude driver port land with compile-from-source (inc 4+)."
|
assembly + the prelude driver port land with compile-from-source (inc 4+)."
|
||||||
|
|
@ -27,8 +26,8 @@
|
||||||
form-literal? form-elements form-vec-items
|
form-literal? form-elements form-vec-items
|
||||||
form-map-pairs form-set-items form-char-code]]))
|
form-map-pairs form-set-items form-char-code]]))
|
||||||
|
|
||||||
;; Hot clojure.core primitives lowered to native Scheme, mirroring the Janet
|
;; Hot clojure.core primitives lowered to native Scheme.
|
||||||
;; backend's native-ops. `=` is the exactness-aware jolt= from values.ss; inc/dec/
|
;; `=` is the exactness-aware jolt= from values.ss; inc/dec/
|
||||||
;; not are rt shims; mod/rem/quot map to Scheme's (Scheme has all three).
|
;; not are rt shims; mod/rem/quot map to Scheme's (Scheme has all three).
|
||||||
(def ^:private native-ops
|
(def ^:private native-ops
|
||||||
{"+" "+" "-" "-" "*" "*" "/" "/"
|
{"+" "+" "-" "-" "*" "*" "/" "/"
|
||||||
|
|
@ -80,7 +79,7 @@
|
||||||
|
|
||||||
;; Host interop methods with a Chez RT shim (rt.ss jolt-host-call). A `.method`
|
;; Host interop methods with a Chez RT shim (rt.ss jolt-host-call). A `.method`
|
||||||
;; call on any other method routes to record-method-dispatch (a reify/record
|
;; call on any other method routes to record-method-dispatch (a reify/record
|
||||||
;; protocol method). Keep in sync with emit.janet's supported-host-methods.
|
;; protocol method).
|
||||||
(def ^:private supported-host-methods #{"isDirectory" "listFiles"})
|
(def ^:private supported-host-methods #{"isDirectory" "listFiles"})
|
||||||
|
|
||||||
;; Native-op Scheme procedures that return a genuine Scheme boolean (#t/#f), so an
|
;; Native-op Scheme procedures that return a genuine Scheme boolean (#t/#f), so an
|
||||||
|
|
@ -173,8 +172,7 @@
|
||||||
;; reconstruct each as the matching Chez RT constructor — the runtime value of a
|
;; reconstruct each as the matching Chez RT constructor — the runtime value of a
|
||||||
;; quote is just that literal data. The form is walked via the jolt.host form-*
|
;; quote is just that literal data. The form is walked via the jolt.host form-*
|
||||||
;; contract (the portable seam the analyzer uses), NOT host-native predicates, so
|
;; contract (the portable seam the analyzer uses), NOT host-native predicates, so
|
||||||
;; this stays host-neutral: on Janet the contract walks Janet reader forms, on
|
;; this stays host-neutral — the contract walks the host's reader forms.
|
||||||
;; Chez it walks Chez reader forms.
|
|
||||||
(declare emit-quoted)
|
(declare emit-quoted)
|
||||||
(defn- emit-quoted-map [pairs]
|
(defn- emit-quoted-map [pairs]
|
||||||
;; pairs: a jolt vector of [k-form v-form] pairs (form-map-pairs)
|
;; pairs: a jolt vector of [k-form v-form] pairs (form-map-pairs)
|
||||||
|
|
|
||||||
|
|
@ -29,14 +29,13 @@
|
||||||
|
|
||||||
;; A qualified static reference to a host class member, `Class/member` (e.g.
|
;; A qualified static reference to a host class member, `Class/member` (e.g.
|
||||||
;; Math/sqrt, Long/MAX_VALUE, System/getenv). A leaf node carrying the class and
|
;; Math/sqrt, Long/MAX_VALUE, System/getenv). A leaf node carrying the class and
|
||||||
;; member names. The Janet back end punts it (the interpreter resolves the static
|
;; member names. The Chez back end lowers a value ref to host-static-ref and a
|
||||||
;; from its class-statics registry); the Chez back end lowers a value ref to
|
;; call head to host-static-call (host-static.ss).
|
||||||
;; host-static-ref and a call head to host-static-call (host-static.ss).
|
|
||||||
(defn host-static [class member] {:op :host-static :class class :member member})
|
(defn host-static [class member] {:op :host-static :class class :member member})
|
||||||
|
|
||||||
;; A host constructor, `(Class. args*)` / `(new Class args*)`. Carries the class
|
;; A host constructor, `(Class. args*)` / `(new Class args*)`. Carries the class
|
||||||
;; name and the analyzed argument nodes. Janet punts (interpreter runs the
|
;; name and the analyzed argument nodes. Chez lowers to host-new (host-static.ss
|
||||||
;; constructor); Chez lowers to host-new (host-static.ss class-ctor registry).
|
;; class-ctor registry).
|
||||||
(defn host-new [class args] {:op :host-new :class class :args args})
|
(defn host-new [class args] {:op :host-new :class class :args args})
|
||||||
|
|
||||||
(defn if-node [test then else] {:op :if :test test :then then :else else})
|
(defn if-node [test then else] {:op :if :test test :then then :else else})
|
||||||
|
|
|
||||||
|
|
@ -25,7 +25,7 @@
|
||||||
;; :phm (persistent hash map; NOT raw-get-safe)
|
;; :phm (persistent hash map; NOT raw-get-safe)
|
||||||
;; :any (top), nil (bottom, identity for join).
|
;; :any (top), nil (bottom, identity for join).
|
||||||
;; Compound types are small jolt maps, so they compare by value on both the
|
;; Compound types are small jolt maps, so they compare by value on both the
|
||||||
;; Clojure and the Janet (orchestrator) side. struct/vec/set use distinct keys so
|
;; Clojure and the host (orchestrator) side. struct/vec/set use distinct keys so
|
||||||
;; a type is recognised by which key it carries.
|
;; a type is recognised by which key it carries.
|
||||||
;; (get t :KEY) is nil for a keyword type and the child for a compound, so a
|
;; (get t :KEY) is nil for a keyword type and the child for a compound, so a
|
||||||
;; compound is detected by some? — no map?/contains? needed.
|
;; compound is detected by some? — no map?/contains? needed.
|
||||||
|
|
|
||||||
|
|
@ -1,16 +1,16 @@
|
||||||
(ns jolt.reader
|
(ns jolt.reader
|
||||||
"Portable Clojure reader: source text -> reader forms (Chez Phase 3, jolt-cf1q.4).
|
"Portable Clojure reader: source text -> reader forms (Chez Phase 3, jolt-cf1q.4).
|
||||||
|
|
||||||
The no-Janet replacement for src/jolt/reader.janet. All the lexing/parsing LOGIC
|
All the lexing/parsing LOGIC
|
||||||
is portable Clojure; form CONSTRUCTION and string->number parsing delegate to the
|
is portable Clojure; form CONSTRUCTION and string->number parsing delegate to the
|
||||||
jolt.host contract (form-make-symbol/char, form-char-from-name, form-scan-number)
|
jolt.host contract (form-make-symbol/char, form-char-from-name, form-scan-number)
|
||||||
— a Clojure source file cannot write a {:jolt/type :symbol} literal (it parses as
|
— a Clojure source file cannot write a {:jolt/type :symbol} literal (it parses as
|
||||||
a tagged reader form), and the concrete form representation is the host's to own.
|
a tagged reader form), and the concrete form representation is the host's to own.
|
||||||
Same split the analyzer uses for the form-* readers. Once cross-compiled this runs
|
Same split the analyzer uses for the form-* readers. Once cross-compiled this runs
|
||||||
ON Chez so compile-from-source needs no Janet reader.
|
ON Chez to drive compile-from-source.
|
||||||
|
|
||||||
Positions are CHARACTER indices (the Janet reader uses byte indices); for ASCII
|
Positions are CHARACTER indices; for ASCII
|
||||||
source they coincide, and form VALUES are identical either way — the parity gate
|
source they coincide with byte indices, and form VALUES are identical either way — the parity gate
|
||||||
compares values, not positions.
|
compares values, not positions.
|
||||||
|
|
||||||
INCREMENT 5a (jolt-50xx): the ATOM layer — whitespace/comments, symbols (+ nil/
|
INCREMENT 5a (jolt-50xx): the ATOM layer — whitespace/comments, symbols (+ nil/
|
||||||
|
|
@ -27,8 +27,8 @@
|
||||||
form-elements form-vec-items form-set-items
|
form-elements form-vec-items form-set-items
|
||||||
form-map-pairs]]))
|
form-map-pairs]]))
|
||||||
|
|
||||||
;; Source access by CHARACTER codepoint, mirroring the Janet reader's byte access
|
;; Source access by CHARACTER codepoint
|
||||||
;; (identical for ASCII). cp = codepoint at i; len = character count.
|
;; (identical to byte access for ASCII). cp = codepoint at i; len = character count.
|
||||||
(defn- cp [s i] (int (nth s i)))
|
(defn- cp [s i] (int (nth s i)))
|
||||||
(defn- len [s] (count s))
|
(defn- len [s] (count s))
|
||||||
|
|
||||||
|
|
@ -71,8 +71,7 @@
|
||||||
(if (and (< end (len s)) (symbol-char? (cp s end))) (recur s pos (inc end)) end))
|
(if (and (< end (len s)) (symbol-char? (cp s end))) (recur s pos (inc end)) end))
|
||||||
|
|
||||||
(defn- read-keyword* [s pos]
|
(defn- read-keyword* [s pos]
|
||||||
;; pos is at the first colon; ::foo is treated as :foo (no auto-resolution),
|
;; pos is at the first colon; ::foo is treated as :foo (no auto-resolution).
|
||||||
;; matching the Janet reader.
|
|
||||||
(let [start (if (and (< (inc pos) (len s)) (= (cp s (inc pos)) 58)) (+ pos 2) (inc pos))
|
(let [start (if (and (< (inc pos) (len s)) (= (cp s (inc pos)) 58)) (+ pos 2) (inc pos))
|
||||||
end (read-keyword-name s start start)]
|
end (read-keyword-name s start start)]
|
||||||
[(keyword (subs s start end)) end]))
|
[(keyword (subs s start end)) end]))
|
||||||
|
|
@ -182,7 +181,7 @@
|
||||||
;; :form payload=the form a real datum
|
;; :form payload=the form a real datum
|
||||||
;; :skip payload=nil a comment (;) or #_ discard — produced nothing
|
;; :skip payload=nil a comment (;) or #_ discard — produced nothing
|
||||||
;; :splice payload=items-vector #?@ — contributes 0+ items to the enclosing coll
|
;; :splice payload=items-vector #?@ — contributes 0+ items to the enclosing coll
|
||||||
;; Out-of-band control (vs the Janet reader's :jolt/skip / :jolt/splice sentinel
|
;; Out-of-band control (rather than :jolt/skip / :jolt/splice sentinel
|
||||||
;; FORMS) keeps it collision-free and host-neutral — no tagged-struct to build or
|
;; FORMS) keeps it collision-free and host-neutral — no tagged-struct to build or
|
||||||
;; recognize. Collection readers dispatch on kind; read-next-form skips :skip.
|
;; recognize. Collection readers dispatch on kind; read-next-form skips :skip.
|
||||||
(declare read-form)
|
(declare read-form)
|
||||||
|
|
@ -345,7 +344,7 @@
|
||||||
|
|
||||||
(defn- read-tagged* [s pos]
|
(defn- read-tagged* [s pos]
|
||||||
;; unknown dispatch -> a tagged literal (#inst, #uuid, #foo). The tag includes
|
;; unknown dispatch -> a tagged literal (#inst, #uuid, #foo). The tag includes
|
||||||
;; the leading # (read-symbol-name starts at #), matching the Janet reader.
|
;; the leading # (read-symbol-name starts at #).
|
||||||
(let [end (read-symbol-name s pos pos)
|
(let [end (read-symbol-name s pos pos)
|
||||||
tag (subs s pos end)
|
tag (subs s pos end)
|
||||||
[form np] (read-next-form s end)]
|
[form np] (read-next-form s end)]
|
||||||
|
|
|
||||||
|
|
@ -1,95 +0,0 @@
|
||||||
; Jolt Standard Library: clojure.java.io
|
|
||||||
;
|
|
||||||
; A Janet-backed shim: file I/O via Janet's file/ and os/ through the janet.*
|
|
||||||
; interop bridge. It deals in plain path strings and Janet file handles, not
|
|
||||||
; java.io objects — so JVM-specific interop on the results (.toURL, .lastModified,
|
|
||||||
; …) won't work, but file/reader/writer/resource/copy/slurp do.
|
|
||||||
|
|
||||||
(defn file
|
|
||||||
"A java.io.File. With a parent and child, joins them with '/'. Returns a
|
|
||||||
:jolt/file value (instance? File true) with the File method surface; str/slurp
|
|
||||||
and io/reader coerce it back to its path."
|
|
||||||
([path] (__make-file path))
|
|
||||||
([parent child] (__make-file parent child)))
|
|
||||||
|
|
||||||
(defn as-file [x] (if (__file? x) x (__make-file x)))
|
|
||||||
|
|
||||||
(defn as-url
|
|
||||||
"Coerce `x` to a java.net.URL value (a :jolt/url). Strings are parsed."
|
|
||||||
[x]
|
|
||||||
(if (= :jolt/url (get x :jolt/type)) x (java.net.URL. (str x))))
|
|
||||||
|
|
||||||
(defn reader [x]
|
|
||||||
(cond
|
|
||||||
;; already a reader (java.io shim or janet file handle) — pass through,
|
|
||||||
;; like the JVM's io/reader on a Reader
|
|
||||||
(= :jolt/jio-string-reader (get x :jolt/type)) x
|
|
||||||
(= :jolt/url (get x :jolt/type)) (java.io.StringReader. (janet/slurp (.getPath x)))
|
|
||||||
(= :core/file (janet/type x)) x
|
|
||||||
(sequential? x) (java.io.StringReader. (apply str x)) ; char[] → in-memory reader
|
|
||||||
;; a path: an in-memory reader over the file's content — gives the
|
|
||||||
;; java.io.Reader surface (.read/.mark/.reset) plus line-seq's
|
|
||||||
;; :read-line-fn, which a raw janet file handle has neither of
|
|
||||||
:else (java.io.StringReader. (janet/slurp (str x)))))
|
|
||||||
(defn writer [x]
|
|
||||||
(cond
|
|
||||||
;; already a Writer/StringWriter shim — pass through, like the JVM's
|
|
||||||
;; io/writer on a Writer (markdown-clj's md-to-html writes into a StringWriter)
|
|
||||||
(= :jolt/writer (get x :jolt/type)) x
|
|
||||||
(= :core/file (janet/type x)) x ; already a janet file handle
|
|
||||||
:else (janet.file/open (str x) :w))) ; a path
|
|
||||||
(defn input-stream [x] (reader x))
|
|
||||||
(defn output-stream [x] (writer x))
|
|
||||||
|
|
||||||
(defn resource
|
|
||||||
"Returns a slurp-able path for `path` if it exists, else nil. (Clojure
|
|
||||||
returns a classpath URL; here the loader's source roots play the classpath
|
|
||||||
role — the bare path is tried first, then path under each root.)"
|
|
||||||
[path]
|
|
||||||
(let [p (str path)]
|
|
||||||
(if (janet.os/stat p)
|
|
||||||
p
|
|
||||||
(loop [roots (seq (__source-roots))]
|
|
||||||
(when roots
|
|
||||||
(let [cand (str (first roots) "/" p)]
|
|
||||||
(if (janet.os/stat cand)
|
|
||||||
cand
|
|
||||||
(recur (next roots)))))))))
|
|
||||||
|
|
||||||
(defn delete-file
|
|
||||||
([f] (delete-file f false))
|
|
||||||
([f silently]
|
|
||||||
(try (do (janet.os/rm (str f)) true)
|
|
||||||
(catch Throwable e (if silently false (throw e))))))
|
|
||||||
|
|
||||||
(defn make-parents
|
|
||||||
"Create the parent directories of `f`."
|
|
||||||
[f]
|
|
||||||
(let [path (str f)
|
|
||||||
i (clojure.string/last-index-of path "/")]
|
|
||||||
(when (and i (pos? i))
|
|
||||||
(let [parent (subs path 0 i)]
|
|
||||||
(make-parents parent)
|
|
||||||
(when-not (janet.os/stat parent) (janet.os/mkdir parent))))))
|
|
||||||
|
|
||||||
(defn copy
|
|
||||||
"Copy from `in` to `out`. A value carrying a truthy `:jolt/output-stream`
|
|
||||||
marker is treated as a java.io OutputStream (write via its .write); a
|
|
||||||
`:jolt/input-stream` source is pumped through its .read. This lets host-shim
|
|
||||||
libraries (e.g. jolt-lang/http-client's byte streams) participate without core
|
|
||||||
knowing their concrete types. Falls back to the original path/handle copy."
|
|
||||||
[in out & opts]
|
|
||||||
(cond
|
|
||||||
(get out :jolt/output-stream)
|
|
||||||
(if (get in :jolt/input-stream)
|
|
||||||
(let [buf (byte-array 8192)]
|
|
||||||
(loop []
|
|
||||||
(let [n (.read in buf 0 8192)]
|
|
||||||
(when (not= -1 n)
|
|
||||||
(.write out buf 0 n)
|
|
||||||
(recur)))))
|
|
||||||
;; in is a byte-array / string
|
|
||||||
(.write out in))
|
|
||||||
:else
|
|
||||||
(let [content (if (string? in) (slurp in) (janet.file/read in :all))]
|
|
||||||
(if (string? out) (spit out content) (janet.file/write out content)))))
|
|
||||||
|
|
@ -1,26 +0,0 @@
|
||||||
; Jolt Standard Library: jolt.interop
|
|
||||||
; Janet interop helpers for Jolt.
|
|
||||||
|
|
||||||
(defn janet-eval
|
|
||||||
[s]
|
|
||||||
(eval (parse s)))
|
|
||||||
|
|
||||||
(defn janet-type
|
|
||||||
[x]
|
|
||||||
(janet/type x))
|
|
||||||
|
|
||||||
(defn janet-describe
|
|
||||||
[x]
|
|
||||||
(describe x))
|
|
||||||
|
|
||||||
(defn janet-table-keys
|
|
||||||
[t]
|
|
||||||
(keys t))
|
|
||||||
|
|
||||||
(defn janet-table-vals
|
|
||||||
[t]
|
|
||||||
(vals t))
|
|
||||||
|
|
||||||
(defn janet-table->map
|
|
||||||
[t]
|
|
||||||
(into {} (map (fn [k] [k (get t k)]) (keys t))))
|
|
||||||
|
|
@ -1,236 +0,0 @@
|
||||||
; Jolt Standard Library: jolt.nrepl
|
|
||||||
;
|
|
||||||
; An nREPL (https://nrepl.org) server and client written in Clojure, on top of
|
|
||||||
; Jolt's Janet interop bridge (the `janet.*` namespace segment). The bencode
|
|
||||||
; codec follows nrepl.bencode and the op/response shapes follow babashka.nrepl
|
|
||||||
; (the SCI-targeted nREPL server). Because the whole thing is ordinary Clojure
|
|
||||||
; over `janet.net/*`, the networking it uses is reusable for anything else.
|
|
||||||
;
|
|
||||||
; Notes:
|
|
||||||
; - One Jolt runtime backs the server; sessions are tracked ids and share the
|
|
||||||
; runtime (defs persist across a connection, like a dev REPL).
|
|
||||||
; - eval uses Jolt's own `eval`/`read-string`; printed output is captured by
|
|
||||||
; rebinding Janet's :out dynamic.
|
|
||||||
; - No true interrupt: an in-flight synchronous eval can't be stopped.
|
|
||||||
|
|
||||||
;; ───────────────────────── bencode ─────────────────────────
|
|
||||||
|
|
||||||
(defn benc
|
|
||||||
"Encode `x` (integer, string, keyword, sequential, or map) to a bencode string."
|
|
||||||
[x]
|
|
||||||
(cond
|
|
||||||
(integer? x) (str "i" x "e")
|
|
||||||
(string? x) (str (count x) ":" x)
|
|
||||||
(keyword? x) (benc (name x))
|
|
||||||
(symbol? x) (benc (name x))
|
|
||||||
(map? x) (let [ks (sort (fn [a b] (compare (name a) (name b))) (keys x))]
|
|
||||||
(str "d" (apply str (mapcat (fn [k] [(benc (name k)) (benc (get x k))]) ks)) "e"))
|
|
||||||
(sequential? x) (str "l" (apply str (map benc x)) "e")
|
|
||||||
(nil? x) "le"
|
|
||||||
:else (throw (ex-info "bencode: cannot encode" {:value x}))))
|
|
||||||
|
|
||||||
(defn encode [x] (benc x))
|
|
||||||
|
|
||||||
; A reader buffers bytes from a janet.net connection (or a preloaded string for
|
|
||||||
; tests) and refills via janet.net/read.
|
|
||||||
(defn reader [conn buf] (atom {:conn conn :buf (or buf "") :pos 0}))
|
|
||||||
|
|
||||||
(defn- rd-ensure [r n]
|
|
||||||
(loop []
|
|
||||||
(let [{:keys [conn buf pos]} @r]
|
|
||||||
(when (< (count buf) (+ pos n))
|
|
||||||
(let [chunk (janet.net/read conn 4096)]
|
|
||||||
(when (nil? chunk) (throw (ex-info "eof" {})))
|
|
||||||
(swap! r assoc :buf (str buf (str chunk)))
|
|
||||||
(recur))))))
|
|
||||||
|
|
||||||
(defn- take-n [r n]
|
|
||||||
(rd-ensure r n)
|
|
||||||
(let [{:keys [buf pos]} @r]
|
|
||||||
(swap! r assoc :pos (+ pos n))
|
|
||||||
(subs buf pos (+ pos n))))
|
|
||||||
|
|
||||||
(defn- take-ch [r] (take-n r 1))
|
|
||||||
|
|
||||||
(def ^:private digits #{"0" "1" "2" "3" "4" "5" "6" "7" "8" "9"})
|
|
||||||
|
|
||||||
(defn decode
|
|
||||||
"Read one bencode value from reader `r`. Throws on EOF. Dict keys come back as
|
|
||||||
strings; the top-level nREPL message is a dict (map)."
|
|
||||||
[r]
|
|
||||||
(let [c (take-ch r)]
|
|
||||||
(cond
|
|
||||||
(= c "i") (loop [acc ""] (let [d (take-ch r)] (if (= d "e") (janet/scan-number acc) (recur (str acc d)))))
|
|
||||||
(= c "l") (loop [out []] (let [v (decode r)] (if (= v ::end) out (recur (conj out v)))))
|
|
||||||
(= c "d") (loop [out {}] (let [k (decode r)] (if (= k ::end) out (recur (assoc out k (decode r))))))
|
|
||||||
(= c "e") ::end
|
|
||||||
(contains? digits c)
|
|
||||||
(loop [acc c] (let [d (take-ch r)] (if (= d ":") (take-n r (janet/scan-number acc)) (recur (str acc d)))))
|
|
||||||
:else (throw (ex-info "bad bencode byte" {:byte c})))))
|
|
||||||
|
|
||||||
;; ───────────────────────── server ─────────────────────────
|
|
||||||
|
|
||||||
(def version "0.1.0")
|
|
||||||
|
|
||||||
(def ^:private session-counter (atom 0))
|
|
||||||
(defn- new-session []
|
|
||||||
(str "jolt-" (swap! session-counter inc) "-" (janet.math/floor (* 1000000 (janet.math/random)))))
|
|
||||||
|
|
||||||
(defn- resp-for
|
|
||||||
"Build a response by echoing the request's id/session (an nREPL requirement)."
|
|
||||||
[msg extra]
|
|
||||||
(assoc extra "session" (get msg "session" "none") "id" (get msg "id" "unknown")))
|
|
||||||
|
|
||||||
; Jolt resolves a function body's unqualified symbols against the *dynamic*
|
|
||||||
; current-ns, not the function's home ns. So evaluating user code (which switches
|
|
||||||
; ns) would break jolt.nrepl's own later symbol lookups. eval-in-ns confines the
|
|
||||||
; switch: it evaluates one form in `ns-str` and ALWAYS restores current-ns to
|
|
||||||
; jolt.nrepl before returning, reporting the form's value/error and resulting ns.
|
|
||||||
; It uses only special forms (in-ns/eval/the-ns/try) + keywords, so it resolves
|
|
||||||
; regardless of the ambient ns.
|
|
||||||
(defn- eval-in-ns [ns-str form]
|
|
||||||
(in-ns (symbol ns-str))
|
|
||||||
; Bind the value before reading the ns: jolt evaluates map-literal values
|
|
||||||
; right-to-left, so the result ns must be captured *after* eval runs any in-ns.
|
|
||||||
(let [result (try (let [v (eval form)] {:val v :ns (:name (the-ns))})
|
|
||||||
(catch Throwable e {:err e :ns (:name (the-ns))}))]
|
|
||||||
(in-ns 'jolt.nrepl)
|
|
||||||
result))
|
|
||||||
|
|
||||||
(defn- eval-handler [server msg send!]
|
|
||||||
; current-ns is global ctx state shared by all fibers, so set the eval ns
|
|
||||||
; explicitly each time: requested :ns, else the session's last ns, else user.
|
|
||||||
; `respond` / `flush-out` are locals (lexical, ns-independent) on purpose.
|
|
||||||
(let [code (get msg "code" "")
|
|
||||||
out-buf (janet/buffer "")
|
|
||||||
old-out (janet/dyn :out)
|
|
||||||
respond (fn [extra] (send! (assoc extra "session" (get msg "session" "none")
|
|
||||||
"id" (get msg "id" "unknown"))))
|
|
||||||
flush-out (fn [] (when (pos? (count out-buf))
|
|
||||||
(respond {"out" (str out-buf)})
|
|
||||||
(janet.buffer/clear out-buf)))]
|
|
||||||
(try
|
|
||||||
(do
|
|
||||||
(janet/setdyn :out out-buf)
|
|
||||||
(loop [forms (seq (read-string (str "[" code "]")))
|
|
||||||
cur-ns (or (get msg "ns") (:eval-ns @server) "user")]
|
|
||||||
(when forms
|
|
||||||
(let [{:keys [val ns err]} (eval-in-ns cur-ns (first forms))]
|
|
||||||
(flush-out)
|
|
||||||
(swap! server assoc :eval-ns ns)
|
|
||||||
(when err (throw err))
|
|
||||||
(respond {"ns" ns "value" (pr-str val)})
|
|
||||||
(recur (next forms) ns))))
|
|
||||||
(janet/setdyn :out old-out)
|
|
||||||
(respond {"status" ["done"]}))
|
|
||||||
(catch Throwable e
|
|
||||||
(janet/setdyn :out old-out)
|
|
||||||
(flush-out)
|
|
||||||
(respond {"err" (str e "\n")})
|
|
||||||
(respond {"ex" "class jolt/Exception"
|
|
||||||
"root-ex" "class jolt/Exception"
|
|
||||||
"status" ["eval-error"]})
|
|
||||||
(respond {"status" ["done"]})))))
|
|
||||||
|
|
||||||
(def ^:private describe-ops
|
|
||||||
{"clone" {} "close" {} "describe" {} "eval" {} "load-file" {}
|
|
||||||
"ls-sessions" {} "interrupt" {} "eldoc" {}})
|
|
||||||
|
|
||||||
(defn- dispatch [server msg send!]
|
|
||||||
(case (get msg "op")
|
|
||||||
"clone" (let [id (new-session)]
|
|
||||||
(swap! server update :sessions conj id)
|
|
||||||
(send! (resp-for msg {"new-session" id "status" ["done"]})))
|
|
||||||
"describe" (send! (resp-for msg {"ops" describe-ops
|
|
||||||
"versions" {"jolt" {"version-string" version}
|
|
||||||
"nrepl" {"version-string" version}}
|
|
||||||
"status" ["done"]}))
|
|
||||||
"eval" (eval-handler server msg send!)
|
|
||||||
"load-file" (eval-handler server (assoc msg "code" (get msg "file" "")) send!)
|
|
||||||
"close" (do (swap! server update :sessions disj (get msg "session"))
|
|
||||||
(send! (resp-for msg {"status" ["done" "session-closed"]})))
|
|
||||||
"ls-sessions" (send! (resp-for msg {"sessions" (vec (:sessions @server)) "status" ["done"]}))
|
|
||||||
"interrupt" (send! (resp-for msg {"status" ["done"]}))
|
|
||||||
"eldoc" (send! (resp-for msg {"status" ["done" "no-eldoc"]}))
|
|
||||||
(send! (resp-for msg {"status" ["error" "unknown-op" "done"]}))))
|
|
||||||
|
|
||||||
(defn- handle-conn [server conn]
|
|
||||||
(let [r (reader conn nil)
|
|
||||||
send! (fn [resp] (janet.net/write conn (encode resp)))]
|
|
||||||
(try
|
|
||||||
(loop []
|
|
||||||
(let [msg (decode r)]
|
|
||||||
(when (map? msg)
|
|
||||||
(try (dispatch server msg send!)
|
|
||||||
(catch Throwable e
|
|
||||||
(send! (resp-for msg {"err" (str e "\n") "status" ["done"]}))))
|
|
||||||
(recur))))
|
|
||||||
(catch Throwable _ nil))
|
|
||||||
(try (janet.net/close conn) (catch Throwable _ nil))))
|
|
||||||
|
|
||||||
; We run the accept loop ourselves with janet.net/accept rather than passing a
|
|
||||||
; handler to janet.net/server: Janet's built-in accept loop arity-checks the
|
|
||||||
; handler, which a Jolt closure doesn't satisfy. janet.ev/call schedules each
|
|
||||||
; connection (and the loop itself) on a fiber.
|
|
||||||
(defn- accept-loop [server]
|
|
||||||
(loop []
|
|
||||||
(let [conn (try (janet.net/accept (:sock @server)) (catch Throwable _ nil))]
|
|
||||||
(when conn
|
|
||||||
(janet.ev/call handle-conn server conn)
|
|
||||||
(recur)))))
|
|
||||||
|
|
||||||
(defn start-server!
|
|
||||||
"Start an nREPL server. opts: :host (default \"127.0.0.1\"), :port (default
|
|
||||||
7888). Returns a server handle (an atom). Non-blocking — connections are served
|
|
||||||
on the event loop."
|
|
||||||
[opts]
|
|
||||||
(let [host (get opts :host "127.0.0.1")
|
|
||||||
port (get opts :port 7888)
|
|
||||||
sock (janet.net/server host (str port))
|
|
||||||
server (atom {:sessions #{} :host host :port port :sock sock :eval-ns "user"})]
|
|
||||||
(janet.ev/call accept-loop server)
|
|
||||||
server))
|
|
||||||
|
|
||||||
(defn stop-server!
|
|
||||||
"Stop accepting new connections."
|
|
||||||
[server]
|
|
||||||
(when-let [sock (:sock @server)] (janet.net/close sock))
|
|
||||||
server)
|
|
||||||
|
|
||||||
;; ───────────────────────── client ─────────────────────────
|
|
||||||
|
|
||||||
(defn connect
|
|
||||||
"Connect to an nREPL server. opts: :host (default \"127.0.0.1\"), :port
|
|
||||||
(default 7888). Returns a client handle."
|
|
||||||
[opts]
|
|
||||||
(let [conn (janet.net/connect (get opts :host "127.0.0.1") (str (get opts :port 7888)))]
|
|
||||||
{:conn conn :reader (reader conn nil)}))
|
|
||||||
|
|
||||||
(defn send-msg [client msg] (janet.net/write (:conn client) (encode msg)))
|
|
||||||
(defn read-msg [client] (decode (:reader client)))
|
|
||||||
|
|
||||||
(defn- status-done? [resp]
|
|
||||||
(when-let [st (get resp "status")]
|
|
||||||
(and (sequential? st) (some (fn [s] (= "done" (str s))) st))))
|
|
||||||
|
|
||||||
(defn request
|
|
||||||
"Send `msg` (a map with at least an \"op\") and collect responses until one
|
|
||||||
carries the \"done\" status. Returns the vector of responses."
|
|
||||||
[client msg]
|
|
||||||
(send-msg client msg)
|
|
||||||
(loop [out []]
|
|
||||||
(let [resp (read-msg client)
|
|
||||||
out (conj out resp)]
|
|
||||||
(if (status-done? resp) out (recur out)))))
|
|
||||||
|
|
||||||
(defn client-clone
|
|
||||||
"Send a clone op; return the new session id."
|
|
||||||
[client]
|
|
||||||
(some (fn [r] (get r "new-session")) (request client {"op" "clone"})))
|
|
||||||
|
|
||||||
(defn client-eval
|
|
||||||
"Eval `code`; returns the responses. Pass `session` to eval in a cloned session."
|
|
||||||
([client code] (request client {"op" "eval" "code" code}))
|
|
||||||
([client code session] (request client {"op" "eval" "code" code "session" session})))
|
|
||||||
|
|
||||||
(defn client-close [client] (janet.net/close (:conn client)))
|
|
||||||
|
|
@ -1,35 +0,0 @@
|
||||||
; Jolt Standard Library: jolt.png
|
|
||||||
;
|
|
||||||
; Write PNG images from Clojure. Build an image, push RGB pixels in row-major
|
|
||||||
; order (top row first), then write to disk:
|
|
||||||
;
|
|
||||||
; (require '[jolt.png :as png])
|
|
||||||
; (let [img (png/image w h)]
|
|
||||||
; (doseq [y (range h)]
|
|
||||||
; (doseq [x (range w)]
|
|
||||||
; (png/put! img r g b))) ; r g b are ints 0-255
|
|
||||||
; (png/write img w h "out.png"))
|
|
||||||
;
|
|
||||||
; The byte-level encoding (filtering, stored-DEFLATE/zlib, CRC32) runs in the
|
|
||||||
; host (the Janet `png` module, reached via the `janet.*` bridge): per-byte work
|
|
||||||
; in the overlay is far too slow, so the overlay only produces pixels and the
|
|
||||||
; host encodes them in one pass.
|
|
||||||
(ns jolt.png)
|
|
||||||
|
|
||||||
(defn image
|
|
||||||
"A blank w×h RGB pixel sink (a host byte buffer). Push exactly w*h pixels with
|
|
||||||
put!, in row-major / top-row-first order, then write."
|
|
||||||
[w h]
|
|
||||||
(janet.buffer/new (* w h 3)))
|
|
||||||
|
|
||||||
(defn put!
|
|
||||||
"Append one RGB pixel — each of r g b an int in 0-255 — to the image. Returns
|
|
||||||
the image so calls can be threaded."
|
|
||||||
[img r g b]
|
|
||||||
(janet.buffer/push-byte img r g b)
|
|
||||||
img)
|
|
||||||
|
|
||||||
(defn write
|
|
||||||
"Encode the filled w×h image as a PNG and write it to path. Returns path."
|
|
||||||
[img w h path]
|
|
||||||
(janet.png/write path w h img))
|
|
||||||
|
|
@ -1,12 +0,0 @@
|
||||||
; Jolt Standard Library: jolt.shell
|
|
||||||
; Shell command execution via Janet's os/shell.
|
|
||||||
|
|
||||||
(defn sh
|
|
||||||
[& args]
|
|
||||||
(let [cmd (apply str (interpose " " args))
|
|
||||||
result (os/shell cmd)]
|
|
||||||
{:exit (result 0) :out (result 1) :err (result 2)}))
|
|
||||||
|
|
||||||
(defn shell
|
|
||||||
[& args]
|
|
||||||
(:out (apply sh args)))
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue