Clean up codebase: rename stdlib layer, strip porting residue, fix tooling

Rename src/jolt -> stdlib (the runtime-loaded layer; jolt-core stays the
seed-baked layer) and update the loader / emit-image / doc paths. Drop dead
code: the spike/ experiments, the duplicate clojuredocs-export.edn (json moves
to tools/), the Janet-era jolt.http binding, and the orphaned
persistent_vector.clj whose ns/path didn't even match.

Strip porting residue from comments and docstrings across host/chez, jolt-core,
stdlib, tests, and docs: internal issue ids, "Phase N" markers, and the "vs
Janet" historical exposition, leaving present-tense descriptions and the real
JVM-Clojure semantic contrasts. Same pass over the corpus suite labels. The seed
is unchanged (docstrings/comments aren't emitted), so the self-host fixpoint and
corpus are untouched.

Port tools/spec_coverage.py off the dead janet probe to bin/joltc and regenerate
coverage.md; drop the dead :host/janet rule from certify.clj and regenerate the
conformance profile. Add docs/host-interop.md (the JVM shims and how to register
your own host class from a library) and a writing-style note in CLAUDE.md.

Stabilize the four racy concurrency corpus cases (future-cancel and agent
send/send-off): give the future a sleeping body and the agent a slow action, so
cancel reliably catches an in-flight future and deref reliably reads the
pre-update snapshot. They certify deterministically now, so drop their :flaky
allowlist entries and the orphaned legend.
This commit is contained in:
Yogthos 2026-06-22 22:18:00 -04:00
parent c18f8087f0
commit 33eff7c7d8
112 changed files with 970 additions and 1621 deletions

View file

@ -86,7 +86,7 @@ reader/analyzer/IR/backend (`jolt-core/jolt/`) and `clojure.core` in
dependency-ordered tiers (`jolt-core/clojure/core/NN-*.clj`, loaded in order: dependency-ordered tiers (`jolt-core/clojure/core/NN-*.clj`, loaded in order:
00-syntax, 00-kernel, 10-seq, 20-coll, 25-sorted, 30-macros, 40-lazy, 50-io). 00-syntax, 00-kernel, 10-seq, 20-coll, 25-sorted, 30-macros, 40-lazy, 50-io).
The stdlib namespaces (`clojure.string`/`set`/`walk`/`edn`/`pprint`/…) are The stdlib namespaces (`clojure.string`/`set`/`walk`/`edn`/`pprint`/…) are
portable Clojure under `src/jolt/clojure/`. portable Clojure under `stdlib/clojure/`.
`bin/joltc` (`host/chez/cli.ss`) loads the checked-in seed `bin/joltc` (`host/chez/cli.ss`) loads the checked-in seed
(`host/chez/seed/{prelude,image}.ss`) + the spine and compiles+evals on Chez (`host/chez/seed/{prelude,image}.ss`) + the spine and compiles+evals on Chez
@ -114,3 +114,19 @@ Issue tracking and design notes live in beads (`bd prime`, `bd memories`).
is the contract. is the contract.
- **Gate every change**: `make test` with a real exit code (self-host fixpoint, - **Gate every change**: `make test` with a real exit code (self-host fixpoint,
corpus floor, unit, cli smoke, certify). Re-mint if a seed source changed. corpus floor, unit, cli smoke, certify). Re-mint if a seed source changed.
## Writing style (comments, docstrings, docs)
Write like a human maintainer of a serious open-source project. Plain, terse,
factual. Document how the code works *now* — what it does and why it matters.
- No LLM tells: drop "Note that", "It's worth noting", "Importantly", "simply",
"essentially", "in order to", "under the hood", and marketing words
("comprehensive", "robust", "seamless", "leverage", "powerful").
- No historical exposition (how the code used to work, porting notes, "the prior
X"), no internal issue IDs (`jolt-xxxx`) or milestone tags ("Phase N") in
comments or docstrings. The git history and beads hold that.
- Keep genuine semantic contrasts with JVM Clojure — those document real,
user-visible behavior.
- Don't restate the code; explain the non-obvious. Match the surrounding file's
comment density and tone.

View file

@ -48,11 +48,16 @@ $ bin/joltc -e '(/ 1 2)'
## Architecture ## Architecture
A small Chez runtime (`host/chez/*.ss`: value model, persistent collections, seqs, A small Chez runtime (`host/chez/*.ss`: value model, persistent collections, seqs,
vars/namespaces, host interop) hosts a portable Clojure overlay (`jolt-core/`): the vars/namespaces, host interop) hosts a portable Clojure overlay split across two
reader/analyzer/IR/backend (`jolt-core/jolt/`) and `clojure.core` in source roots by *when* they load:
dependency-ordered tiers (`jolt-core/clojure/core/NN-*.clj`). The stdlib namespaces
(`clojure.string`/`set`/`walk`/`edn`/`pprint`/…) are portable Clojure under - **`jolt-core/`** is baked into the seed — the compiler (`jolt-core/jolt/`:
`src/jolt/clojure/`. reader/analyzer/IR/backend, plus `jolt.main`/`jolt.deps`) and `clojure.core` in
dependency-ordered tiers (`jolt-core/clojure/core/NN-*.clj`). Changing anything
here means re-minting the seed.
- **`stdlib/`** loads lazily at runtime off the source roots — the rest of the
standard library (`clojure.string`/`set`/`walk`/`edn`/`pprint`/…) plus the
`jolt.ffi` host library. Editing these needs no re-mint.
`bin/joltc` loads the checked-in seed and the spine, then compiles and evaluates on `bin/joltc` loads the checked-in seed and the spine, then compiles and evaluates on
Chez (read → analyze → IR → emit → eval). `host/chez/bootstrap.ss` rebuilds that Chez (read → analyze → IR → emit → eval). `host/chez/bootstrap.ss` rebuilds that
@ -63,9 +68,11 @@ reproduces the checked-in seed byte-for-byte).
Jolt targets Clojure semantics but runs on Chez, not the JVM. Jolt targets Clojure semantics but runs on Chez, not the JVM.
- **Host platform.** No JVM and no Java interop — `import`, `gen-class`, `proxy` of - **Host platform.** No JVM, no reflection, no `gen-class`/`proxy` of Java
Java classes, and `java.*` are unavailable. A class token resolves to a name; a classes. Interop syntax (`Class.`, `Class/static`, `.method`) works against a
small set of host classes is recognized for `instance?`. shimmed subset of the `java.*` standard library, and a class token resolves to
a name. See [docs/host-interop.md](docs/host-interop.md) for what's covered and
how to register your own host classes from a library.
- **Numbers.** The full Scheme numeric tower, matching the JVM: exact integers and - **Numbers.** The full Scheme numeric tower, matching the JVM: exact integers and
bignums, exact ratios (`(/ 1 2)``1/2`), and flonum doubles. `=` is bignums, exact ratios (`(/ 1 2)``1/2`), and flonum doubles. `=` is
category-aware (`(= 3 3.0)``false`); `==` is value-equality (`(== 3 3.0)` category-aware (`(= 3 3.0)``false`); `==` is value-equality (`(== 3 3.0)`

View file

@ -17,12 +17,12 @@ absolute reference.
| Benchmark | Axis | Pass it exercises | Source | | Benchmark | Axis | Pass it exercises | Source |
|---|---|---|---| |---|---|---|---|
| `binary-trees` | allocation / GC pressure (escaping short-lived records) | jolt-15jq scalar-replace, jolt-8flj escape analysis | CLBG | | `binary-trees` | allocation / GC pressure (escaping short-lived records) | scalar-replace, escape analysis | CLBG |
| `dispatch` | polymorphic (**megamorphic**) protocol dispatch | jolt-41m devirt, inline-cache | AWFY-style | | `dispatch` | polymorphic (**megamorphic**) protocol dispatch | devirt, inline-cache | AWFY-style |
| `mono-dispatch` | **monomorphic** protocol dispatch (devirt/inline-cache *can* fire) | jolt-41m devirt, jolt-ez5h inline-cache | AWFY-style | | `mono-dispatch` | **monomorphic** protocol dispatch (devirt/inline-cache *can* fire) | devirt, inline-cache | AWFY-style |
| `collections` | persistent map/vector churn (HAMT / 32-way tries) | persistent structures (jolt-684u/0hbr), transients | CLBG k-nucleotide-style | | `collections` | persistent map/vector churn (HAMT / 32-way tries) | persistent structures, transients | CLBG k-nucleotide-style |
| `mandelbrot` | pure float compute (tight arith loops, no alloc/dispatch) | jolt-3pl native arith, loop codegen | CLBG | | `mandelbrot` | pure float compute (tight arith loops, no alloc/dispatch) | native arith, loop codegen | CLBG |
| `fib` | recursion: function-call + integer-arith overhead | jolt-3pl native arith, jolt-826 small-fn inlining | CLBG | | `fib` | recursion: function-call + integer-arith overhead | native arith, small-fn inlining | CLBG |
What the ray tracer does **not** capture and these do: allocation as the What the ray tracer does **not** capture and these do: allocation as the
bottleneck (~7% there), megamorphic *and* monomorphic dispatch (its dispatch is bottleneck (~7% there), megamorphic *and* monomorphic dispatch (its dispatch is
@ -35,17 +35,17 @@ control with record state), k-nucleotide proper.
## Holistic scorecard ## Holistic scorecard
`JVM=1 bench/run.sh` runs each benchmark on jolt **and** JVM Clojure and prints `JVM=1 bench/run.sh` runs each benchmark on jolt **and** JVM Clojure and prints
the jolt/JVM ratio — the epic's (jolt-ffn) absolute-reference scorecard. As of the jolt/JVM ratio — the absolute-reference scorecard. As of
the broadening (2026-06-16), ratios cluster by axis: the broadening (2026-06-16), ratios cluster by axis:
- **pure compute** (`mandelbrot`) is the floor, ~15× — native arith (jolt-3pl) - **pure compute** (`mandelbrot`) is the floor, ~15× — native arith
already gets jolt closest to the JVM. already gets jolt closest to the JVM.
- **collections** ~28×, **fib** ~37×. - **collections** ~28×, **fib** ~37×.
- **dispatch** ~75× (megamorphic), and `mono-dispatch` is *worse* (~110×): the - **dispatch** ~75× (megamorphic), and `mono-dispatch` is *worse* (~110×): the
JVM inline-caches a runtime-monomorphic call site to near-free, while jolt does JVM inline-caches a runtime-monomorphic call site to near-free, while jolt does
a full registry dispatch regardless (devirt only fires on *statically* proven a full registry dispatch regardless (devirt only fires on *statically* proven
receivers, which `reduce` over a vector doesn't give). This is the signal for receivers, which `reduce` over a vector doesn't give). This is the signal for
the call-site inline cache (jolt-ez5h). the call-site inline cache.
- **allocation** (`binary-trees`) is the widest gap — but also the most inflated - **allocation** (`binary-trees`) is the widest gap — but also the most inflated
by host memory pressure, so read it as "alloc is the worst axis," not a precise by host memory pressure, so read it as "alloc is the worst axis," not a precise
multiple. Numbers are machine-specific; regenerate with `JVM=1 bench/run.sh`. multiple. Numbers are machine-specific; regenerate with `JVM=1 bench/run.sh`.

View file

@ -1,7 +1,7 @@
;; binary-trees (Computer Language Benchmarks Game) — an ALLOCATION/GC stress ;; binary-trees (Computer Language Benchmarks Game) — an ALLOCATION/GC stress
;; test. Builds and discards millions of short-lived `Node` records; the nodes ;; test. Builds and discards millions of short-lived `Node` records; the nodes
;; ESCAPE (stored in the tree, walked later), so this is the regime jolt-8flj ;; ESCAPE (stored in the tree, walked later), so this is the regime escape analysis
;; (escape analysis) targets and the ray tracer never exercises (~7% alloc). ;; targets and the ray tracer never exercises (~7% alloc).
;; ;;
;; Portable Clojure: runs on jolt and JVM Clojure for cross-impl comparison. ;; Portable Clojure: runs on jolt and JVM Clojure for cross-impl comparison.
;; jolt -m binary-trees 14 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1) ;; jolt -m binary-trees 14 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1)

View file

@ -1,7 +1,7 @@
;; dispatch — a POLYMORPHIC-DISPATCH stress test. A protocol method is called in ;; dispatch — a POLYMORPHIC-DISPATCH stress test. A protocol method is called in
;; a hot loop over a heterogeneous (megamorphic) collection of record types, with ;; a hot loop over a heterogeneous (megamorphic) collection of record types, with
;; minimal per-call work, so protocol dispatch dominates. This is the regime ;; minimal per-call work, so protocol dispatch dominates. This is the regime
;; jolt-41m (devirtualization) and the inline-cache target, and the one the ray ;; devirtualization and the inline-cache target, and the one the ray
;; tracer can't reveal — its dispatch is monomorphic and a small fraction of the ;; tracer can't reveal — its dispatch is monomorphic and a small fraction of the
;; float-math cost (devirt measured FLAT there). ;; float-math cost (devirt measured FLAT there).
;; ;;

View file

@ -1,7 +1,7 @@
;; fib — naive recursive Fibonacci: pure function-call + integer-arithmetic ;; fib — naive recursive Fibonacci: pure function-call + integer-arithmetic
;; throughput, with no allocation, dispatch, or collections. Isolates call ;; throughput, with no allocation, dispatch, or collections. Isolates call
;; overhead and native integer arith (jolt-3pl), and is the natural target for ;; overhead and native integer arith, and is the natural target for
;; single-call-site / small-fn inlining (jolt-826) and self-call direct-linking. ;; single-call-site / small-fn inlining and self-call direct-linking.
;; ;;
;; Portable Clojure (jolt + JVM Clojure). ;; Portable Clojure (jolt + JVM Clojure).
;; jolt -m fib 32 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1) ;; jolt -m fib 32 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1)

View file

@ -3,7 +3,7 @@
;; dispatch, no collections in the hot loop — just double arithmetic and tight ;; dispatch, no collections in the hot loop — just double arithmetic and tight
;; recur loops. This isolates the irreducible-math axis the ray tracer is bound ;; recur loops. This isolates the irreducible-math axis the ray tracer is bound
;; on (where devirt/alloc passes measured flat), so it tracks native-arith codegen ;; on (where devirt/alloc passes measured flat), so it tracks native-arith codegen
;; (jolt-3pl) and loop quality directly. ;; and loop quality directly.
;; ;;
;; Portable Clojure (jolt + JVM Clojure). ;; Portable Clojure (jolt + JVM Clojure).
;; jolt -m mandelbrot 1000 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1) ;; jolt -m mandelbrot 1000 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1)

View file

@ -1,5 +1,5 @@
;; mono-dispatch — protocol dispatch where every call site sees ONE record type ;; mono-dispatch — protocol dispatch where every call site sees ONE record type
;; (monomorphic). This is the regime where devirtualization (jolt-41m) and a ;; (monomorphic). This is the regime where devirtualization and a
;; call-site inline cache CAN fire — the megamorphic `dispatch` bench deliberately ;; call-site inline cache CAN fire — the megamorphic `dispatch` bench deliberately
;; defeats them, so this is its complement: it measures how close a proven/cached ;; defeats them, so this is its complement: it measures how close a proven/cached
;; monomorphic dispatch gets to a direct call. Same per-call work as `dispatch`. ;; monomorphic dispatch gets to a direct call. Same per-call work as `dispatch`.

View file

@ -3,7 +3,7 @@
# #
# Each benchmark isolates an axis the ray tracer (float-compute-bound) doesn't # Each benchmark isolates an axis the ray tracer (float-compute-bound) doesn't
# capture — see README.md. Run back-to-back against `main` to measure a pass's # capture — see README.md. Run back-to-back against `main` to measure a pass's
# impact (the same protocol as test/bench/core-bench.janet). # impact.
# #
# bench/run.sh # default sizes, whole-program optimization on # bench/run.sh # default sizes, whole-program optimization on
# JOLT_WHOLE_PROGRAM=0 bench/run.sh # compare with WP off # JOLT_WHOLE_PROGRAM=0 bench/run.sh # compare with WP off
@ -20,12 +20,12 @@ export JOLT_PATH="$PWD"
# name:default-arg (arg sized to run in a few seconds each). Axes: allocation # name:default-arg (arg sized to run in a few seconds each). Axes: allocation
# (binary-trees), megamorphic vs monomorphic dispatch, persistent-collection # (binary-trees), megamorphic vs monomorphic dispatch, persistent-collection
# churn (collections — now O(log n) via the HAMT, jolt-684u, so sized up), pure # churn (collections — now O(log n) via the HAMT, so sized up), pure
# float compute (mandelbrot), call+arith recursion (fib). # float compute (mandelbrot), call+arith recursion (fib).
BENCHES="binary-trees:14 dispatch:2000 mono-dispatch:2000 collections:30000 mandelbrot:200 fib:30" BENCHES="binary-trees:14 dispatch:2000 mono-dispatch:2000 collections:30000 mandelbrot:200 fib:30"
# JVM=1 also runs each bench on JVM Clojure and prints a jolt/JVM ratio — the # JVM=1 also runs each bench on JVM Clojure and prints a jolt/JVM ratio — the
# holistic absolute-reference scorecard for the optimization epic (jolt-ffn). # holistic absolute-reference scorecard for the optimization work.
run_one() { run_one() {
ns="${1%%:*}"; arg="${2:-${1##*:}}" ns="${1%%:*}"; arg="${2:-${1##*:}}"
jmean=$(jolt -m "$ns" "$arg" 2>&1 | awk '/^mean:/{print $2}') jmean=$(jolt -m "$ns" "$arg" 2>&1 | awk '/^mean:/{print $2}')

File diff suppressed because one or more lines are too long

View file

@ -3,10 +3,11 @@
=========================================================================== ===========================================================================
This grammar specifies the surface syntax accepted by Jolt's reader This grammar specifies the surface syntax accepted by Jolt's reader
(src/jolt/reader.janet) the text that `read`/`parse-string`/`load-string` (host/chez/reader.ss, with the portable half in jolt-core/jolt/reader.clj)
turn into data/forms. It is the syntactic half of Jolt's contract; the the text that `read`/`read-string`/`load-string` turn into data/forms. It is
behavioural half lives in test/spec/. Where Jolt diverges from Clojure the the syntactic half of Jolt's contract; the behavioural half lives in the
difference is called out in a comment. conformance corpus (test/chez/corpus.edn, see docs/spec/02-reader.md). Where
Jolt diverges from Clojure the difference is called out in a comment.
Notation (ISO-ish EBNF): Notation (ISO-ish EBNF):
= definition | alternation = definition | alternation
@ -128,7 +129,7 @@ meta-form = map | keyword | symbol | string ;
a keyword -> {keyword true}; a map is used as-is. A keyword/symbol/string a keyword -> {keyword true}; a map is used as-is. A keyword/symbol/string
meta-form on a symbol rides ON the symbol (it stays a bare symbol, so a hint meta-form on a symbol rides ON the symbol (it stays a bare symbol, so a hint
like ^String is transparent in params/lets/bodies). A MAP meta-form routes like ^String is transparent in params/lets/bodies). A MAP meta-form routes
through a runtime (with-meta form ...) even on a symbol (jolt-8w2), so a name through a runtime (with-meta form ...) even on a symbol, so a name
with ^{:map} metadata reads as a form, not a bare symbol def/defn/defmacro/ns with ^{:map} metadata reads as a form, not a bare symbol def/defn/defmacro/ns
unwrap that to the bare name (and attach the metadata). *) unwrap that to the bare name (and attach the metadata). *)
@ -152,7 +153,7 @@ anon-arg = "%" | "%" , digit , { digit } | "%&" ;
var-quote = "#'" , symbol ; (* (var symbol) *) var-quote = "#'" , symbol ; (* (var symbol) *)
(* Regex literal -> a Janet PEG-backed regex value. (* Regex literal -> an irregex-backed regex value.
Supported: groups, greedy/lazy quantifiers, (?:..), lookahead (?=..)/(?!..), Supported: groups, greedy/lazy quantifiers, (?:..), lookahead (?=..)/(?!..),
alternation, anchors ^ $ \b \B, classes, (?i). NOT: lookbehind, alternation, anchors ^ $ \b \B, classes, (?i). NOT: lookbehind,
backreferences, named groups. *) backreferences, named groups. *)

175
docs/host-interop.md Normal file
View file

@ -0,0 +1,175 @@
# Host interop and JVM standard-library shims
Jolt runs on Chez Scheme, not the JVM, so there are no real Java classes behind
interop forms. Instead the runtime ships shims for the slice of the JVM standard
library that portable Clojure code reaches for, so libraries written against
`clojure.core` and common `java.*` classes run unchanged. The Clojure interop
syntax works against these shims:
```clojure
(Math/sqrt 2) ; static call
Math/PI ; static field
(StringBuilder.) ; constructor
(.append sb "x") ; instance method
(instance? String "hi") ; class token
```
A class token (`String`, `java.util.UUID`, …) resolves to a name; there is no
reflection and no class hierarchy. `(class x)` returns the JVM class name for the
scalar/collection types Clojure programs compare against (`"java.lang.Long"`,
`"java.lang.String"`, and so on).
## What's shimmed
This is the surface today, not the whole JVM. Methods not listed generally
aren't implemented; a few are accepted but no-ops (noted inline).
### Numbers and language
- **`java.lang.Math`** — `sqrt` `cbrt` `pow` `exp` `log` `log10` `floor` `ceil`
`round` `abs` `max` `min` `sin` `cos` `tan` `asin` `acos` `atan` `signum`
`random`; fields `PI`, `E`. (`clojure.math` mirrors these as functions.)
- **`Long` / `Integer`** — `parseLong`/`parseInt`/`valueOf` (optional radix),
`MAX_VALUE`, `MIN_VALUE`; `(Integer. x)`.
- **`Double` / `Float`** — `parseDouble`, `valueOf`, `toString`, `isNaN`,
`isInfinite`, the `*_VALUE`/`*_INFINITY`/`NaN` fields; `(Double. s)`.
- **`Boolean`** — `parseBoolean`, `TRUE`, `FALSE`.
- **`Character`** — `isUpperCase` `isLowerCase` `isDigit` `isWhitespace` (ASCII).
- **Boxed-number methods** — every number answers `.intValue` `.longValue`
`.doubleValue` `.floatValue` `.byteValue` `.shortValue` `.toString`
`.hashCode` (integer projections wrap modulo their width, as on the JVM).
- **`java.lang.System`** — `currentTimeMillis` `nanoTime` `exit` `getProperty`
`setProperty` `clearProperty` `getProperties` `getenv`.
- **`java.lang.Thread`** — `sleep` (real), `yield`/`interrupted` (no-ops),
`currentThread`.
- **`java.lang.Object`** — `(Object.)` as a fresh-identity sentinel; `.toString`
`.hashCode` `.equals` `.getClass` work on any value.
- **`java.lang.Class`** — `forName`.
### Strings and text
- **`java.lang.String`** statics — `valueOf`, `format` (the `clojure.core/format`
engine; `String/format` with a leading locale is accepted). Instance methods
go through `clojure.string` / the native string ops.
- **`StringBuilder`** — `append` `toString` `length` `charAt` `setLength`.
- **`java.text.NumberFormat`** — `getInstance` `getNumberInstance`
`getIntegerInstance`; `.format`, `.setGroupingUsed`,
`.setMinimum/MaximumFractionDigits`.
- **`java.util.StringTokenizer`** — `hasMoreTokens` `countTokens` `nextToken`.
- **`java.util.regex.Pattern`** — `compile` (with `Pattern/MULTILINE`), `quote`;
`.split`, `.pattern`. (`#"…"` literals and `clojure.string` regex fns are the
usual entry points.)
### Collections (mutable)
- **`java.util.ArrayList`** — `add` `get` `set` `size` `isEmpty` `remove` `clear`
`contains` `toArray` `iterator`.
- **`java.util.HashMap`** — `put` `get` `getOrDefault` `containsKey`
`containsValue` `size` `isEmpty` `remove` `clear` `putAll` `keySet` `values`
`entrySet`.
### I/O
- **`java.io.File`** — `(File. path)` / `(File. parent child)`; `getPath`
`getName` `getAbsolutePath` `getCanonicalPath` `toURI` `toURL` `exists`
`isDirectory` `isFile` `listFiles` `getParent`.
- **`java.io.StringReader` / `StringWriter` / `PushbackReader`** — the
`read`/`readLine`/`mark`/`reset`/`unread`/`write`/`append`/`toString` surface
the reader and `with-out-str` rely on.
- **`java.lang.ClassLoader`** — `getSystemClassLoader`, `.getResource`,
`.getResourceAsStream` (resolved against the source roots).
### Time and date
- **`java.util.Date`** — `(Date.)` / `(Date. ms)`; `getTime` `toInstant`
`toLocalDate(Time)` `before` `after` `equals` `toString` (RFC 3339).
- **`java.time`** — `Instant` (`now`, `ofEpochMilli`, `toEpochMilli`, `atZone`),
`LocalDateTime`, `ZoneId`, `DateTimeFormatter` (`ofPattern`, `ISO_LOCAL_*`,
localized styles), `FormatStyle`.
- **`java.text.SimpleDateFormat`** — `(SimpleDateFormat. pattern)`; `parse`
`format` `toPattern` `applyPattern` (`setTimeZone`/`setLenient` accepted but
ignored — formatting is UTC).
- **`java.util.TimeZone`** / **`java.util.Locale`** — constructed and passed
through; only UTC is honored for formatting.
### Net, encoding, misc
- **`java.net.URL`** — `(URL. spec)`; `toString` `toExternalForm` `getProtocol`
`getPath` `getFile`.
- **`java.net.URI`** — full component accessors (`getScheme` `getHost` `getPort`
`getPath` `getQuery` `getFragment`, raw variants, `isAbsolute`).
- **`java.util.Base64`** — `getEncoder`/`getDecoder` with `encode`,
`encodeToString`, `decode`.
- **`java.nio.charset.Charset`** — `forName`.
- **`java.util.UUID`** — `randomUUID`, `fromString`; `(UUID. s)`.
- **Exceptions**`Throwable` `Exception` `RuntimeException`
`IllegalArgumentException` `IllegalStateException` `IOException`
`NumberFormatException` `ArithmeticException` `NullPointerException`
`ClassCastException` `IndexOutOfBoundsException` `FileNotFoundException`
`UnsupportedOperationException` and the common network exceptions, each with
the `(E.)` / `(E. msg)` / `(E. msg cause)` / `(E. cause)` constructors.
What's deliberately absent: STM (`clojure.lang.LockingTransaction/isRunning`
returns `false`), reflection, `gen-class`/`proxy` of Java classes, and
`BigDecimal`.
## Adding your own shim from a library
The built-in shims above are baked into the seed. A library or project can
register its **own** host classes at load time — no seed re-mint, no host edits.
Put the registration calls at the top level of a namespace your code requires.
Four functions (in `clojure.core`) plus the tagged-table seam (in `jolt.host`)
cover it.
`__register-class-ctor!` makes `(Name. …)` work; `__register-class-statics!`
makes `Name/field` and `(Name/method …)` work; `__register-class-methods!`
attaches instance methods to a tagged value; `__register-instance-check!` teaches
`instance?` about your class. **Method and static names are strings** (they match
the literal name in the interop form).
A stateful object is a *tagged table*`jolt.host/tagged-table` creates one,
`ref-put!`/`ref-get` set and read its fields. Read the tag back with
`jolt.host/ref-get` (or test it with `jolt.host/table?`); a plain `get` /
keyword lookup deliberately can't see a wrapper's own `:jolt/type`.
```clojure
(ns mylib.greeter
(:require [jolt.host :as host]))
;; (Greeter. name) -> a tagged value carrying its name
(__register-class-ctor! "Greeter"
(fn [name] (-> (host/tagged-table :greeter)
(host/ref-put! :name name))))
;; (.hello g) -> instance method, keyed by the literal method name
(__register-class-methods! :greeter
{"hello" (fn [self] (str "hi " (host/ref-get self :name)))})
;; Greeter/VERSION (field) and (Greeter/make x) (static method)
(__register-class-statics! "Greeter"
{"VERSION" "1.0"
"make" (fn [name] (Greeter. name))})
;; (instance? Greeter x)
(__register-instance-check!
(fn [class-name v]
(when (= class-name "Greeter")
(and (host/table? v) (= :greeter (host/ref-get v :jolt/type))))))
```
```clojure
(.hello (Greeter. "ada")) ;=> "hi ada"
Greeter/VERSION ;=> "1.0"
(.hello (Greeter/make "bob")) ;=> "hi bob"
(instance? Greeter (Greeter. "x")) ;=> true
```
An instance-check predicate returns `true`/`false` to decide, or `nil` to defer
to the next registered check and the built-ins — so several libraries can
register checks without clobbering each other. This is the mechanism jolt's
HTTP client library uses to emulate `java.net.URL` and `HttpURLConnection` so
`clj-http-lite` runs unchanged.
Extending a *built-in* class instead (adding a method to core's `String` shim,
say) means editing the relevant `host/chez/*.ss` file and running `make remint`
— see [building-and-deps.md](building-and-deps.md).

View file

@ -77,6 +77,6 @@ per-context opt-in, exactly how the SCI bootstrap now loads
- Loading clj-ecosystem libraries via deps requires deciding their feature - Loading clj-ecosystem libraries via deps requires deciding their feature
set; the deps loader currently inherits the process default — a future set; the deps loader currently inherits the process default — a future
refinement is per-dependency feature configuration (filed with the deps refinement is per-dependency feature configuration (filed with the deps
work, jolt-dw4). work).
- `.cljc` authors targeting jolt can write `:jolt` branches and rely on - `.cljc` authors targeting jolt can write `:jolt` branches and rely on
`:default` fallbacks. `:default` fallbacks.

View file

@ -1,6 +1,6 @@
# RFC 0005 — Structural collection-type inference # RFC 0005 — Structural collection-type inference
- **Status**: Implemented (jolt-5uj). Ray tracer 12.8s to 11.0s hint-free, - **Status**: Implemented. Ray tracer 12.8s to 11.0s hint-free,
matching the explicit `^:struct` version; render checksum unchanged. matching the explicit `^:struct` version; render checksum unchanged.
- **Champions**: jolt maintainers - **Champions**: jolt maintainers
- **Created**: 2026-06-13 - **Created**: 2026-06-13
@ -14,7 +14,7 @@ function its parameter and return types, recursively. A keyword lookup returns
the looked-up field's type, so nested access like `(:r (:direction ray))` is the looked-up field's type, so nested access like `(:r (:direction ray))` is
typed end to end. This unifies the two facts the current inference tracks typed end to end. This unifies the two facts the current inference tracks
inconsistently (a vector's element type, but not a map's field types), subsumes inconsistently (a vector's element type, but not a map's field types), subsumes
the existing inference phases (jolt-99x Phases 0 to 3) as special cases, and the existing inference passes as special cases, and
closes the remaining ray-tracer gap without a hint. The system is a closes the remaining ray-tracer gap without a hint. The system is a
soft-typing-style inference: it never rejects a program, it assigns a concrete soft-typing-style inference: it never rejects a program, it assigns a concrete
type only when it can prove one, and it falls back to `:any` (and the existing type only when it can prove one, and it falls back to `:any` (and the existing
@ -22,7 +22,7 @@ runtime guard) everywhere else.
## Motivation ## Motivation
The inference added in jolt-99x specializes a collection access (drops the The existing inference specializes a collection access (drops the
`:jolt/type` guard, emits `pv-count`, and so on) when it can prove the `:jolt/type` guard, emits `pv-count`, and so on) when it can prove the
collection's type. It works, it is sound, and it is fully dynamic-fallback collection's type. It works, it is sound, and it is fully dynamic-fallback
safe. But its type lattice grew ad hoc: safe. But its type lattice grew ad hoc:
@ -96,7 +96,7 @@ are depth 2 to 3, well inside the cap.
Inference is a forward pass producing `[type node']` for each IR node (the Inference is a forward pass producing `[type node']` for each IR node (the
existing shape), threaded with a local type environment and the existing shape), threaded with a local type environment and the
inter-procedural state from Phase 1. The rules are uniform over the structural inter-procedural state. The rules are uniform over the structural
type: type:
- **Literals.** `{:k v ...}` with constant scalar keys and struct-safe values - **Literals.** `{:k v ...}` with constant scalar keys and struct-safe values
@ -115,9 +115,9 @@ type:
signature: core fns from a fixed signature table (below), user fns from the signature: core fns from a fixed signature table (below), user fns from the
inter-procedural fixpoint's inferred signature. inter-procedural fixpoint's inferred signature.
The Phase 1 inter-procedural fixpoint, recompile, escape gate, and closed-world The inter-procedural fixpoint, recompile, escape gate, and closed-world
assumption (RFC to follow / jolt-767) are unchanged. They now propagate assumption are unchanged. They now propagate structural types instead of flat
structural types instead of flat tags. tags.
## Core function signatures ## Core function signatures
@ -266,8 +266,8 @@ plus a signature table.
tables and HOF handling). tables and HOF handling).
4. The back end keeps reading the use-site type to specialize (guard drop for 4. The back end keeps reading the use-site type to specialize (guard drop for
`{:struct}`, `pv-count`/`pv-nth` for `{:vec}`), now uniformly. `{:struct}`, `pv-count`/`pv-nth` for `{:vec}`), now uniformly.
5. Keep the Phase 1 fixpoint, recompile, escape gate, and triggering as is; they 5. Keep the inter-procedural fixpoint, recompile, escape gate, and triggering as
propagate structural types. is; they propagate structural types.
The phases land incrementally behind the same optimization-mode gate, each The phases land incrementally behind the same optimization-mode gate, each
verified against conformance (three modes), the full test gate, and the verified against conformance (three modes), the full test gate, and the
@ -298,5 +298,6 @@ ray-tracer benchmark, exactly as the current phases were.
param/return inference is enough for the collection-specialization goal; param/return inference is enough for the collection-specialization goal;
full function types matter more for the type-checker (RFC 0006) and could be full function types matter more for the type-checker (RFC 0006) and could be
deferred. deferred.
- **Closed-world boundary.** Inherited from Phase 1: param/return inference - **Closed-world boundary.** Inherited from the inter-procedural pass:
assumes the compiled unit is the whole program. Documented there; unchanged. param/return inference assumes the compiled unit is the whole program.
Documented there; unchanged.

View file

@ -2,10 +2,10 @@
- **Status**: Implemented. Core-fn error domains (arithmetic on non-numbers, - **Status**: Implemented. Core-fn error domains (arithmetic on non-numbers,
count/first/rest/next/seq/nth on non-seqable scalars), `JOLT_TYPE_CHECK= count/first/rest/next/seq/nth on non-seqable scalars), `JOLT_TYPE_CHECK=
off|warn|error`. Follow-ups landed: bounded scalar **unions** (jolt-pz5) so a off|warn|error`. Follow-ups landed: bounded scalar **unions** so a
use is reported only when every member is in the error domain; **user-fn use is reported only when every member is in the error domain; **user-fn
error domains** behind `JOLT_TYPE_CHECK_USER` (jolt-zo1, closed-world); error domains** behind `JOLT_TYPE_CHECK_USER` (closed-world);
precise **file:line:col** locations (jolt-fqy). The checker is now one precise **file:line:col** locations. The checker is now one
inference walk (folded into `infer`), and is **on by default in direct-link inference walk (folded into `infer`), and is **on by default in direct-link
builds** — where it piggybacks on the specialization inference for ~free — builds** — where it piggybacks on the specialization inference for ~free —
and opt-in (`JOLT_TYPE_CHECK`) in plain builds. and opt-in (`JOLT_TYPE_CHECK`) in plain builds.
@ -203,22 +203,22 @@ smallest high-confidence table (arithmetic and seq/count/nth/first), and grow.
destroys trust. Mitigation: start tiny, test each entry against the runtime, destroys trust. Mitigation: start tiny, test each entry against the runtime,
grow slowly. Open question: derive the table from the same machinery the grow slowly. Open question: derive the table from the same machinery the
runtime uses, to avoid drift? runtime uses, to avoid drift?
- **Unions.** *Resolved (jolt-pz5).* The lattice has a bounded scalar union - **Unions.** *Resolved.* The lattice has a bounded scalar union
`{:union #{T...}}` (cap 4); differing if-branches form a union instead of `{:union #{T...}}` (cap 4); differing if-branches form a union instead of
collapsing to `:any`, and a use is reported only when *every* member is in the collapsing to `:any`, and a use is reported only when *every* member is in the
error domain. Unions are opaque to structural specialization, so codegen is error domain. Unions are opaque to structural specialization, so codegen is
unchanged. unchanged.
- **User-function signatures.** *Resolved (jolt-zo1), opt-in.* Behind - **User-function signatures.** *Resolved, opt-in.* Behind
`JOLT_TYPE_CHECK_USER`: the checker re-checks a registered non-redefinable `JOLT_TYPE_CHECK_USER`: the checker re-checks a registered non-redefinable
user fn's body with one parameter bound to its concrete argument type; a user fn's body with one parameter bound to its concrete argument type; a
diagnostic the all-`:any` body did not have means that argument is provably diagnostic the all-`:any` body did not have means that argument is provably
wrong. Monotonic, so still no false positives; closed-world, hence opt-in. wrong. Monotonic, so still no false positives; closed-world, hence opt-in.
- **Negative/never types.** *Resolved (jolt-wwy).* Calling a provably - **Negative/never types.** *Resolved.* Calling a provably
non-callable value (`:num`/`:str` — keywords/maps/vectors/sets are IFn) is non-callable value (`:num`/`:str` — keywords/maps/vectors/sets are IFn) is
reported at the default level; wrong-arity to a registered single-fixed-arity reported at the default level; wrong-arity to a registered single-fixed-arity
user fn is reported under the `JOLT_TYPE_CHECK_USER` opt-in. A union callee is user fn is reported under the `JOLT_TYPE_CHECK_USER` opt-in. A union callee is
flagged only when every member is non-callable. flagged only when every member is non-callable.
- **Position vs intent.** *Resolved (jolt-fqy).* The reader records each list - **Position vs intent.** *Resolved.* The reader records each list
form's absolute offset (identity-keyed, so positions survive macroexpansion form's absolute offset (identity-keyed, so positions survive macroexpansion
exactly when the user's sub-form is spliced through); the analyzer stamps it exactly when the user's sub-form is spliced through); the analyzer stamps it
onto `:invoke` nodes, the checker carries it into each diagnostic, and the onto `:invoke` nodes, the checker carries it into each diagnostic, and the

View file

@ -30,7 +30,7 @@ So a name's *home* is determined by two facts:
`clojure.core` is compiled ahead of time into the checked-in seed `clojure.core` is compiled ahead of time into the checked-in seed
(`host/chez/seed/{prelude,image}.ss`) as Scheme `def-var!` forms. The seed's (`host/chez/seed/{prelude,image}.ss`) as Scheme `def-var!` forms. The seed's
source twin is the overlay (`jolt-core/clojure/core/*.clj` plus the stdlib source twin is the overlay (`jolt-core/clojure/core/*.clj` plus the stdlib
namespaces under `src/jolt/clojure/`); `host/chez/emit-image.ss` re-emits the namespaces under `stdlib/clojure/`); `host/chez/emit-image.ss` re-emits the
prelude from those sources on Chez. The build is a byte-fixpoint: rebuilding from prelude from those sources on Chez. The build is a byte-fixpoint: rebuilding from
an up-to-date seed reproduces it exactly. an up-to-date seed reproduces it exactly.

View file

@ -12,29 +12,29 @@ sources, and process: [`../rfc/0001-language-specification.md`](../rfc/0001-lang
| Doc | Content | Status | | Doc | Content | Status |
|---|---|---| |---|---|---|
| [`00-front-matter.md`](00-front-matter.md) | conformance terms, entry format, host classification | drafted | | [`00-front-matter.md`](00-front-matter.md) | conformance terms, entry format, host classification | drafted |
| `01-evaluation.md``08-macros.md` | see chapter plan in front matter | planned | | [`02-reader.md`](02-reader.md) | token grammar + reader-macro catalog | drafted |
| `01`, `04``08` | see chapter plan in front matter | planned |
| [`03-special-forms.md`](03-special-forms.md) | special-form catalog + normative exemplars (`if`, `let*`) | exemplars | | [`03-special-forms.md`](03-special-forms.md) | special-form catalog + normative exemplars (`if`, `let*`) | exemplars |
| [`09-core-library.md`](09-core-library.md) | per-var entry format + exemplars (`first`, `reduce`, `parse-uuid`) | exemplars | | [`09-core-library.md`](09-core-library.md) | per-var entry format + exemplars (`first`, `reduce`, `parse-uuid`) | exemplars |
| [`coverage.md`](coverage.md) | generated dashboard over the 694-var surface | generated | | [`coverage.md`](coverage.md) | generated dashboard over the 694-var surface | generated |
| [`../grammar.ebnf`](../grammar.ebnf) | reader surface syntax (EBNF), companion to `02-reader.md` | reference |
Regenerate the dashboard after surface changes: Regenerate the dashboard after surface changes:
`python3 tools/spec_coverage.py` (requires `clojuredocs-export.json` in the `python3 tools/spec_coverage.py` (reads `tools/clojuredocs-export.json` and
repo root and a working jolt checkout). probes a working jolt checkout via `bin/joltc`).
## Current numbers (2026-06-10) ## Current numbers (2026-06-22)
Of the 694 `clojure.core` vars in the ClojureDocs inventory: Of the 694 `clojure.core` vars in the ClojureDocs inventory, jolt interns 574.
Broadly:
- **380** implemented in jolt *and* exercised by the behavioral suites - **568** implemented in jolt *and* exercised by the behavioral suites
- **154** implemented but not directly tested — each gets a test with its spec entry - **6** implemented but not directly tested — each gets a test with its spec entry
- **35** portable but missing from jolt (`parse-long`/`parse-double`/ - **6** portable but absent from jolt's resolvable surface (the REPL history
`parse-boolean`, `update-keys`/`update-vals`, `macroexpand`, `time`, vars `*1`/`*2`/`*3`/`*e`, plus `letfn`/`re-groups`, which work but aren't
`partitionv`/`partitionv-all`/`splitv-at`, `with-redefs`, `with-open`, interned where `resolve` can see them) — tracked as gaps
reader fns, ns-introspection stragglers, …) — tracked as implementation gaps - the rest classified host/JVM/concurrency (see the dashboard for the full
- **22** resolvable in code but invisible to ns introspection per-var breakdown — it is the source of truth)
(`resolve`/`ns-publics` can't see seed-fallback names like `compare`,
`gensym`, `type`) — a conformance finding in its own right
- the rest classified host/JVM/concurrency (see dashboard)
## How this connects to the test suites ## How this connects to the test suites

View file

@ -1,21 +1,21 @@
# Appendix A — Coverage Dashboard (generated) # Appendix A — Coverage Dashboard (generated)
Generated 2026-06-10 by `tools/spec_coverage.py` — do not edit by hand. Generated 2026-06-22 by `tools/spec_coverage.py` — do not edit by hand.
Surface: **694** clojure.core vars (ClojureDocs export; 648 with Surface: **694** clojure.core vars (ClojureDocs export; 648 with
community examples). jolt interns 564 of them. community examples). jolt interns 574 of them.
| Status | Count | Meaning | | Status | Count | Meaning |
|---|---|---| |---|---|---|
| implemented+tested | 564 | in jolt and exercised by spec/conformance | | implemented+tested | 568 | in jolt and exercised by spec/conformance |
| implemented-untested | 0 | in jolt, no direct test — spec entries will add them | | implemented-untested | 6 | in jolt, no direct test — spec entries will add them |
| resolvable-not-interned | 0 | works in code but invisible to ns introspection (conformance finding) | | resolvable-not-interned | 0 | works in code but invisible to ns introspection (conformance finding) |
| missing-portable | 0 | portable semantics, jolt lacks it — implementation gap | | missing-portable | 6 | portable semantics, jolt lacks it — implementation gap |
| special-form | 15 | specified in §3, not a library var | | special-form | 16 | specified in §3, not a library var |
| dynamic-var | 29 | classification needed: portable default vs host-dependent | | dynamic-var | 24 | classification needed: portable default vs host-dependent |
| agents-taps | 22 | out of scope pending concurrency design note | | agents-taps | 16 | out of scope pending concurrency design note |
| stm-refs | 11 | out of scope pending concurrency design note | | stm-refs | 11 | out of scope pending concurrency design note |
| jvm-specific | 53 | catalogued, not specified | | jvm-specific | 47 | catalogued, not specified |
Classifications are initial and mechanical — reclassifying is an ordinary Classifications are initial and mechanical — reclassifying is an ordinary
spec change. A var is *Verified* only when its §9 entry exists and carries no spec change. A var is *Verified* only when its §9 entry exists and carries no
@ -27,12 +27,12 @@ UNVERIFIED field; that column will be added as entries land.
|---|---|---| |---|---|---|
| `*` | implemented+tested | ✓ | | `*` | implemented+tested | ✓ |
| `*'` | implemented+tested | ✓ | | `*'` | implemented+tested | ✓ |
| `*1` | implemented+tested | ✓ | | `*1` | missing-portable | ✓ |
| `*2` | implemented+tested | ✓ | | `*2` | missing-portable | ✓ |
| `*3` | implemented+tested | ✓ | | `*3` | missing-portable | ✓ |
| `*agent*` | dynamic-var | ✓ | | `*agent*` | dynamic-var | ✓ |
| `*allow-unresolved-vars*` | dynamic-var | ✓ | | `*allow-unresolved-vars*` | dynamic-var | ✓ |
| `*assert*` | dynamic-var | ✓ | | `*assert*` | implemented+tested | ✓ |
| `*clojure-version*` | implemented+tested | ✓ | | `*clojure-version*` | implemented+tested | ✓ |
| `*command-line-args*` | dynamic-var | ✓ | | `*command-line-args*` | dynamic-var | ✓ |
| `*compile-files*` | dynamic-var | ✓ | | `*compile-files*` | dynamic-var | ✓ |
@ -40,21 +40,21 @@ UNVERIFIED field; that column will be added as entries land.
| `*compiler-options*` | dynamic-var | ✓ | | `*compiler-options*` | dynamic-var | ✓ |
| `*data-readers*` | dynamic-var | ✓ | | `*data-readers*` | dynamic-var | ✓ |
| `*default-data-reader-fn*` | dynamic-var | ✓ | | `*default-data-reader-fn*` | dynamic-var | ✓ |
| `*e` | implemented+tested | ✓ | | `*e` | missing-portable | ✓ |
| `*err*` | dynamic-var | ✓ | | `*err*` | implemented-untested | ✓ |
| `*file*` | dynamic-var | ✓ | | `*file*` | dynamic-var | ✓ |
| `*flush-on-newline*` | dynamic-var | | | `*flush-on-newline*` | dynamic-var | |
| `*fn-loader*` | dynamic-var | | | `*fn-loader*` | dynamic-var | |
| `*in*` | implemented+tested | | | `*in*` | implemented+tested | |
| `*math-context*` | dynamic-var | | | `*math-context*` | dynamic-var | |
| `*ns*` | implemented+tested | ✓ | | `*ns*` | implemented+tested | ✓ |
| `*out*` | dynamic-var | ✓ | | `*out*` | implemented-untested | ✓ |
| `*print-dup*` | dynamic-var | ✓ | | `*print-dup*` | dynamic-var | ✓ |
| `*print-length*` | dynamic-var | ✓ | | `*print-length*` | dynamic-var | ✓ |
| `*print-level*` | dynamic-var | ✓ | | `*print-level*` | dynamic-var | ✓ |
| `*print-meta*` | dynamic-var | ✓ | | `*print-meta*` | dynamic-var | ✓ |
| `*print-namespace-maps*` | dynamic-var | ✓ | | `*print-namespace-maps*` | dynamic-var | ✓ |
| `*print-readably*` | dynamic-var | ✓ | | `*print-readably*` | implemented+tested | ✓ |
| `*read-eval*` | dynamic-var | ✓ | | `*read-eval*` | dynamic-var | ✓ |
| `*reader-resolver*` | dynamic-var | | | `*reader-resolver*` | dynamic-var | |
| `*repl*` | dynamic-var | | | `*repl*` | dynamic-var | |
@ -63,7 +63,7 @@ UNVERIFIED field; that column will be added as entries land.
| `*unchecked-math*` | implemented+tested | ✓ | | `*unchecked-math*` | implemented+tested | ✓ |
| `*use-context-classloader*` | dynamic-var | ✓ | | `*use-context-classloader*` | dynamic-var | ✓ |
| `*verbose-defrecords*` | dynamic-var | | | `*verbose-defrecords*` | dynamic-var | |
| `*warn-on-reflection*` | dynamic-var | ✓ | | `*warn-on-reflection*` | implemented-untested | ✓ |
| `+` | implemented+tested | ✓ | | `+` | implemented+tested | ✓ |
| `+'` | implemented+tested | ✓ | | `+'` | implemented+tested | ✓ |
| `-` | implemented+tested | ✓ | | `-` | implemented+tested | ✓ |
@ -77,7 +77,7 @@ UNVERIFIED field; that column will be added as entries land.
| `->VecSeq` | jvm-specific | | | `->VecSeq` | jvm-specific | |
| `-cache-protocol-fn` | jvm-specific | | | `-cache-protocol-fn` | jvm-specific | |
| `-reset-methods` | jvm-specific | | | `-reset-methods` | jvm-specific | |
| `.` | implemented+tested | ✓ | | `.` | special-form | ✓ |
| `..` | implemented+tested | ✓ | | `..` | implemented+tested | ✓ |
| `/` | implemented+tested | ✓ | | `/` | implemented+tested | ✓ |
| `<` | implemented+tested | ✓ | | `<` | implemented+tested | ✓ |
@ -98,8 +98,8 @@ UNVERIFIED field; that column will be added as entries land.
| `add-classpath` | jvm-specific | ✓ | | `add-classpath` | jvm-specific | ✓ |
| `add-tap` | agents-taps | ✓ | | `add-tap` | agents-taps | ✓ |
| `add-watch` | implemented+tested | ✓ | | `add-watch` | implemented+tested | ✓ |
| `agent` | agents-taps | ✓ | | `agent` | implemented+tested | ✓ |
| `agent-error` | agents-taps | ✓ | | `agent-error` | implemented+tested | ✓ |
| `agent-errors` | agents-taps | | | `agent-errors` | agents-taps | |
| `aget` | implemented+tested | ✓ | | `aget` | implemented+tested | ✓ |
| `alength` | implemented+tested | ✓ | | `alength` | implemented+tested | ✓ |
@ -131,7 +131,7 @@ UNVERIFIED field; that column will be added as entries land.
| `assoc-in` | implemented+tested | ✓ | | `assoc-in` | implemented+tested | ✓ |
| `associative?` | implemented+tested | ✓ | | `associative?` | implemented+tested | ✓ |
| `atom` | implemented+tested | ✓ | | `atom` | implemented+tested | ✓ |
| `await` | agents-taps | ✓ | | `await` | implemented-untested | ✓ |
| `await-for` | agents-taps | ✓ | | `await-for` | agents-taps | ✓ |
| `await1` | agents-taps | | | `await1` | agents-taps | |
| `bases` | jvm-specific | ✓ | | `bases` | jvm-specific | ✓ |
@ -183,7 +183,7 @@ UNVERIFIED field; that column will be added as entries land.
| `chunk-rest` | implemented+tested | ✓ | | `chunk-rest` | implemented+tested | ✓ |
| `chunked-seq?` | implemented+tested | ✓ | | `chunked-seq?` | implemented+tested | ✓ |
| `class` | implemented+tested | ✓ | | `class` | implemented+tested | ✓ |
| `class?` | jvm-specific | ✓ | | `class?` | implemented+tested | ✓ |
| `clear-agent-errors` | agents-taps | | | `clear-agent-errors` | agents-taps | |
| `clojure-version` | implemented+tested | ✓ | | `clojure-version` | implemented+tested | ✓ |
| `coll?` | implemented+tested | ✓ | | `coll?` | implemented+tested | ✓ |
@ -375,13 +375,13 @@ UNVERIFIED field; that column will be added as entries land.
| `lazy-cat` | implemented+tested | ✓ | | `lazy-cat` | implemented+tested | ✓ |
| `lazy-seq` | implemented+tested | ✓ | | `lazy-seq` | implemented+tested | ✓ |
| `let` | implemented+tested | ✓ | | `let` | implemented+tested | ✓ |
| `letfn` | implemented+tested | ✓ | | `letfn` | missing-portable | ✓ |
| `line-seq` | implemented+tested | ✓ | | `line-seq` | implemented+tested | ✓ |
| `list` | implemented+tested | ✓ | | `list` | implemented+tested | ✓ |
| `list*` | implemented+tested | ✓ | | `list*` | implemented+tested | ✓ |
| `list?` | implemented+tested | ✓ | | `list?` | implemented+tested | ✓ |
| `load` | jvm-specific | ✓ | | `load` | implemented+tested | ✓ |
| `load-file` | jvm-specific | ✓ | | `load-file` | implemented-untested | ✓ |
| `load-reader` | jvm-specific | ✓ | | `load-reader` | jvm-specific | ✓ |
| `load-string` | implemented+tested | ✓ | | `load-string` | implemented+tested | ✓ |
| `loaded-libs` | jvm-specific | ✓ | | `loaded-libs` | jvm-specific | ✓ |
@ -464,10 +464,10 @@ UNVERIFIED field; that column will be added as entries land.
| `partition-by` | implemented+tested | ✓ | | `partition-by` | implemented+tested | ✓ |
| `partitionv` | implemented+tested | | | `partitionv` | implemented+tested | |
| `partitionv-all` | implemented+tested | | | `partitionv-all` | implemented+tested | |
| `pcalls` | jvm-specific | ✓ | | `pcalls` | implemented+tested | ✓ |
| `peek` | implemented+tested | ✓ | | `peek` | implemented+tested | ✓ |
| `persistent!` | implemented+tested | ✓ | | `persistent!` | implemented+tested | ✓ |
| `pmap` | jvm-specific | ✓ | | `pmap` | implemented+tested | ✓ |
| `pop` | implemented+tested | ✓ | | `pop` | implemented+tested | ✓ |
| `pop!` | implemented+tested | ✓ | | `pop!` | implemented+tested | ✓ |
| `pop-thread-bindings` | implemented+tested | | | `pop-thread-bindings` | implemented+tested | |
@ -496,7 +496,7 @@ UNVERIFIED field; that column will be added as entries land.
| `proxy-name` | jvm-specific | | | `proxy-name` | jvm-specific | |
| `proxy-super` | implemented+tested | ✓ | | `proxy-super` | implemented+tested | ✓ |
| `push-thread-bindings` | implemented+tested | | | `push-thread-bindings` | implemented+tested | |
| `pvalues` | jvm-specific | ✓ | | `pvalues` | implemented+tested | ✓ |
| `qualified-ident?` | implemented+tested | ✓ | | `qualified-ident?` | implemented+tested | ✓ |
| `qualified-keyword?` | implemented+tested | ✓ | | `qualified-keyword?` | implemented+tested | ✓ |
| `qualified-symbol?` | implemented+tested | ✓ | | `qualified-symbol?` | implemented+tested | ✓ |
@ -512,7 +512,7 @@ UNVERIFIED field; that column will be added as entries land.
| `rational?` | implemented+tested | ✓ | | `rational?` | implemented+tested | ✓ |
| `rationalize` | implemented+tested | ✓ | | `rationalize` | implemented+tested | ✓ |
| `re-find` | implemented+tested | ✓ | | `re-find` | implemented+tested | ✓ |
| `re-groups` | implemented+tested | ✓ | | `re-groups` | missing-portable | ✓ |
| `re-matcher` | implemented+tested | ✓ | | `re-matcher` | implemented+tested | ✓ |
| `re-matches` | implemented+tested | ✓ | | `re-matches` | implemented+tested | ✓ |
| `re-pattern` | implemented+tested | ✓ | | `re-pattern` | implemented+tested | ✓ |
@ -558,7 +558,7 @@ UNVERIFIED field; that column will be added as entries land.
| `reset-vals!` | implemented+tested | ✓ | | `reset-vals!` | implemented+tested | ✓ |
| `resolve` | implemented+tested | ✓ | | `resolve` | implemented+tested | ✓ |
| `rest` | implemented+tested | ✓ | | `rest` | implemented+tested | ✓ |
| `restart-agent` | agents-taps | ✓ | | `restart-agent` | implemented-untested | ✓ |
| `resultset-seq` | jvm-specific | ✓ | | `resultset-seq` | jvm-specific | ✓ |
| `reverse` | implemented+tested | ✓ | | `reverse` | implemented+tested | ✓ |
| `reversible?` | implemented+tested | ✓ | | `reversible?` | implemented+tested | ✓ |
@ -568,8 +568,8 @@ UNVERIFIED field; that column will be added as entries land.
| `satisfies?` | implemented+tested | ✓ | | `satisfies?` | implemented+tested | ✓ |
| `second` | implemented+tested | ✓ | | `second` | implemented+tested | ✓ |
| `select-keys` | implemented+tested | ✓ | | `select-keys` | implemented+tested | ✓ |
| `send` | agents-taps | ✓ | | `send` | implemented+tested | ✓ |
| `send-off` | agents-taps | ✓ | | `send-off` | implemented+tested | ✓ |
| `send-via` | agents-taps | ✓ | | `send-via` | agents-taps | ✓ |
| `seq` | implemented+tested | ✓ | | `seq` | implemented+tested | ✓ |
| `seq-to-map-for-destructuring` | implemented+tested | ✓ | | `seq-to-map-for-destructuring` | implemented+tested | ✓ |

View file

@ -1,12 +1,10 @@
;; async.ss (jolt-byjr) — clojure.core.async on real OS threads for the Chez host. ;; async.ss — clojure.core.async on real OS threads for the Chez host.
;; ;;
;; No mature Chez fibers library exists, and this Chez is a threaded build, so a ;; A `go` block is 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).
;; <! / >! work ANYWHERE (no CPS transform) — ;; <! / >! work ANYWHERE — no CPS transform — because they are ordinary blocking
;; here because they are ordinary blocking calls. Real parallelism, shared heap. ;; calls. Real parallelism, shared heap. Trade-off: one OS thread per go block
;; Trade-off: one OS thread per go block (fine for typical use / conformance, not ;; (fine for typical use, not for thousands of simultaneous go blocks).
;; for thousands of simultaneous go blocks).
;; ;;
;; Channel: an unbuffered channel is a rendezvous (the putter blocks until its ;; Channel: an unbuffered channel is a rendezvous (the putter blocks until its
;; value is taken); a buffered (chan n) put blocks only when full; dropping/sliding ;; value is taken); a buffered (chan n) put blocks only when full; dropping/sliding

View file

@ -1,26 +1,24 @@
;; atoms (jolt-9ziu) — host-coupled mutable reference cells for the Chez host. ;; atoms — host-coupled mutable reference cells for the Chez host.
;; ;;
;; atom/deref/swap!/reset! are host primitives (not the clojure.core overlay), ;; atom/deref/swap!/reset! are host primitives (not the clojure.core overlay),
;; so the Chez runtime provides native shims, def-var!'d into clojure.core. They ;; so the 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.
;; ;;
;; compare-and-set!/swap-vals!/reset-vals! are overlay fns over the native kernel ;; compare-and-set!/swap-vals!/reset-vals! are overlay fns over the native kernel
;; in the live system; provided here natively too so the Chez host is ;; in the live system; provided here natively too so the host is self-sufficient
;; self-sufficient for atoms without the full prelude (the overlay versions, when ;; for atoms without the full prelude (the overlay versions, when the full prelude
;; the full prelude loads, override these but compose the same native kernel). ;; loads, override these but compose the same native kernel).
;; watches is an alist of (key . watch-fn); validator is a jolt fn or jolt-nil. ;; watches is an alist of (key . watch-fn); validator is a jolt fn or jolt-nil.
;; The overlay's add-watch/set-validator! drive these via jolt.host/ref-put! on a ;; The peripheral ops + the notify/validate behaviour live natively here, and
;; Janet table, which a Chez atom record is not — so the peripheral ops + the ;; post-prelude.ss re-asserts them over the overlay's def-var!.
;; notify/validate behaviour live natively here, and post-prelude.ss re-asserts ;; `lock` is a per-atom mutex guarding the read-modify-write critical sections,
;; them over the overlay's def-var! (jolt-mn9o). ;; so swap!/reset!/compare-and-set! are atomic under real OS threads
;; `lock` (jolt-byjr) is a per-atom mutex guarding the read-modify-write critical ;; (futures/go blocks share the heap). The user fn in swap! runs OUTSIDE the lock
;; sections, so swap!/reset!/compare-and-set! are atomic under real OS threads ;; (a CAS retry loop, like the JVM) so it never deadlocks on re-entrant access and
;; (futures/go blocks share the heap on Chez). The user fn in swap! runs OUTSIDE ;; a watch/validator can deref the same atom.
;; the lock (a CAS retry loop, like the JVM) so it never deadlocks on re-entrant
;; access and a watch/validator can deref the same atom.
(define-record-type jolt-atom (define-record-type jolt-atom
(fields (mutable val) (mutable watches) (mutable validator) lock) (fields (mutable val) (mutable watches) (mutable validator) lock)
(nongenerative jolt-atom-v3)) (nongenerative jolt-atom-v3))
@ -108,7 +106,7 @@
(jolt-atom-notify a old v) (jolt-atom-notify a old v)
(jolt-vector old v))) (jolt-vector old v)))
;; --- watches / validators (jolt-mn9o) --------------------------------------- ;; --- watches / validators ---------------------------------------------------
;; add-watch interns (key . fn) (replacing any existing key, keeping order); ;; add-watch interns (key . fn) (replacing any existing key, keeping order);
;; remove-watch drops it; both return the atom. set-validator! installs a ;; remove-watch drops it; both return the atom. set-validator! installs a
;; validator and validates the CURRENT value immediately (Clojure throws if it's ;; validator and validates the CURRENT value immediately (Clojure throws if it's
@ -139,7 +137,7 @@
(def-var! "clojure.core" "reset-vals!" jolt-reset-vals!) (def-var! "clojure.core" "reset-vals!" jolt-reset-vals!)
(def-var! "clojure.core" "atom?" jolt-atom?) (def-var! "clojure.core" "atom?" jolt-atom?)
;; peripheral ops: the overlay (20-coll) re-defs these over jolt.host/ref-put!, ;; peripheral ops: the overlay (20-coll) re-defs these over jolt.host/ref-put!,
;; which fails on a Chez atom record — post-prelude.ss re-asserts the natives. ;; which fails on an atom record — post-prelude.ss re-asserts the natives.
(def-var! "clojure.core" "add-watch" jolt-add-watch) (def-var! "clojure.core" "add-watch" jolt-add-watch)
(def-var! "clojure.core" "remove-watch" jolt-remove-watch) (def-var! "clojure.core" "remove-watch" jolt-remove-watch)
(def-var! "clojure.core" "set-validator!" jolt-set-validator!) (def-var! "clojure.core" "set-validator!" jolt-set-validator!)

View file

@ -1,9 +1,9 @@
;; BigDecimal (jolt-i2jm). A jbigdec is {unscaled, scale} over Chez arbitrary- ;; BigDecimal. A jbigdec is {unscaled, scale} over Chez arbitrary-precision exact
;; precision exact integers; its value is unscaled * 10^-scale (1.5M = {15,1}, ;; integers; its value is unscaled * 10^-scale (1.5M = {15,1}, 1.00M = {100,2},
;; 1.00M = {100,2}, 3M = {3,0}). M-suffix literals read to a :bigdec form that the ;; 3M = {3,0}). M-suffix literals read to a :bigdec form that the back end lowers
;; back end lowers to jolt-bigdec-from-string; bigdec coerces a number/string. ;; to jolt-bigdec-from-string; bigdec coerces a number/string. Equality is by
;; Equality is by value (1.0M = 1.00M), str drops the M, pr keeps it, class is ;; value (1.0M = 1.00M), str drops the M, pr keeps it, class is
;; java.math.BigDecimal. Arithmetic contagion is not modelled (jolt-i2jm scope). ;; java.math.BigDecimal. Arithmetic contagion is not modelled.
(define-record-type jbigdec (fields unscaled scale) (nongenerative chez-jbigdec-v1)) (define-record-type jbigdec (fields unscaled scale) (nongenerative chez-jbigdec-v1))

View file

@ -1,13 +1,12 @@
;; bootstrap.ss (jolt-9phg, Phase 3 inc9a) — the pure-Chez self-build. ;; bootstrap.ss — the pure-Chez self-build.
;; ;;
;; This is the zero-Janet build step. Given a SEED (prelude, image) pair — the ;; Given a SEED (prelude, image) pair — the bootstrap compiler, checked in under
;; bootstrap compiler, minted once via the inc8 fixpoint and checked in under
;; host/chez/seed/ — it loads them, then rebuilds the clojure.core prelude AND the ;; host/chez/seed/ — it loads them, then rebuilds the clojure.core prelude AND the
;; 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
;; writing fresh artifacts. No Janet is invoked: read -> analyze -> emit all run on ;; (emit-image.ss), writing fresh artifacts: 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 (`make selfhost` checks this); when ;; reproduces it byte-for-byte (`make selfhost` checks this); when the sources
;; the sources change, run it twice to reconverge and re-mint the seed. ;; change, run it twice to reconverge and re-mint the seed.
;; ;;
;; Run from the repo root: ;; Run from the repo root:
;; chez --script host/chez/bootstrap.ss SEED-PRELUDE SEED-IMAGE OUT-PRELUDE OUT-IMAGE ;; chez --script host/chez/bootstrap.ss SEED-PRELUDE SEED-IMAGE OUT-PRELUDE OUT-IMAGE
@ -23,7 +22,7 @@
(define bs-out-image (list-ref bs-args 3)) (define bs-out-image (list-ref bs-args 3))
;; Load the runtime + the SEED compiler (prelude for macros, image for the ;; Load the runtime + the SEED compiler (prelude for macros, image for the
;; analyzer/emitter), exactly as the zero-Janet spine assembles a program. ;; analyzer/emitter), exactly as the spine assembles a program.
(load "host/chez/rt.ss") (load "host/chez/rt.ss")
(set-chez-ns! "clojure.core") (set-chez-ns! "clojure.core")
(load bs-seed-prelude) (load bs-seed-prelude)
@ -39,4 +38,4 @@
(put-string p (jolt-emit-prelude)) (close-port p)) (put-string p (jolt-emit-prelude)) (close-port p))
(let ((p (open-output-file bs-out-image 'replace))) (let ((p (open-output-file bs-out-image 'replace)))
(put-string p (jolt-emit-image)) (close-port p)) (put-string p (jolt-emit-image)) (close-port p))
(display "bootstrap: rebuilt prelude + compiler image on Chez (no Janet)\n") (display "bootstrap: rebuilt prelude + compiler image on Chez\n")

View file

@ -1,8 +1,8 @@
;; cli.ss (jolt-9phg / jolt-90sp) — the pure-Chez jolt runtime. NO Janet. ;; cli.ss — the jolt runtime.
;; ;;
;; Loads the checked-in seed (host/chez/seed/{prelude,image}.ss — the bootstrap ;; Loads the checked-in seed (host/chez/seed/{prelude,image}.ss — the bootstrap
;; compiler) and the zero-Janet spine, then either evaluates a -e expression or ;; compiler) and the spine, then either evaluates a -e expression or dispatches a
;; dispatches a CLI command (run/-M/repl/path/task) through jolt.main. The loader ;; CLI command (run/-M/repl/path/task) through jolt.main. The loader
;; (loader.ss) turns `require` into real file loading off the source roots, so a ;; (loader.ss) turns `require` into real file loading off the source roots, so a
;; multi-file project with deps.edn dependencies runs end to end. ;; multi-file project with deps.edn dependencies runs end to end.
;; ;;
@ -23,13 +23,13 @@
(load "host/chez/loader.ss") (load "host/chez/loader.ss")
;; jolt.ffi host primitives (memory / library loading) load AFTER the loader's ;; jolt.ffi host primitives (memory / library loading) load AFTER the loader's
;; baked-ns snapshot, so a library's (require '[jolt.ffi]) still loads jolt.ffi's ;; baked-ns snapshot, so a library's (require '[jolt.ffi]) still loads jolt.ffi's
;; Clojure side (the foreign-fn / defcfn macros, src/jolt/jolt/ffi.clj). ;; Clojure side (the foreign-fn / defcfn macros, stdlib/jolt/ffi.clj).
(load "host/chez/ffi.ss") ; jolt.ffi (FFI: a library binds native code) (load "host/chez/ffi.ss") ; jolt.ffi (FFI: a library binds native code)
;; jolt.main + jolt.deps live under jolt-core; keep them (and src/jolt) on the ;; jolt.main + jolt.deps live under jolt-core; keep them (and stdlib) on the
;; roots so the CLI's own namespaces — and any jolt.* an app pulls in — resolve. ;; roots so the CLI's own namespaces — and any jolt.* an app pulls in — resolve.
;; A project's resolved deps roots are prepended to these by jolt.main. ;; A project's resolved deps roots are prepended to these by jolt.main.
(set-source-roots! (list "jolt-core" "src/jolt")) (set-source-roots! (list "jolt-core" "stdlib"))
;; Render an uncaught jolt throw (any value, not just a Chez condition) to stderr ;; Render an uncaught jolt throw (any value, not just a Chez condition) to stderr
;; and exit non-zero, instead of Chez's opaque "non-condition value" dump. An ;; and exit non-zero, instead of Chez's opaque "non-condition value" dump. An

View file

@ -1,4 +1,4 @@
;; Phase 1 (jolt-cf1q.2, inc 3a) — persistent collections on the Chez RT. ;; persistent collections on the Chez RT.
;; ;;
;; The vector / map / set the emitted programs construct from literals and ;; The vector / map / set the emitted programs construct from literals and
;; operate on via the lowered leaf ops (conj/get/nth/count/assoc/...). Loaded by ;; operate on via the lowered leaf ops (conj/get/nth/count/assoc/...). Loaded by
@ -6,11 +6,8 @@
;; jolt-coll? / jolt-coll=? / jolt-coll-hash hooks defined here (forward refs, ;; jolt-coll? / jolt-coll=? / jolt-coll-hash hooks defined here (forward refs,
;; resolved at run time — nothing is CALLED during load). ;; resolved at run time — nothing is CALLED during load).
;; ;;
;; Phase note: the persistent vector is a copy-on-write Scheme vector and the ;; The persistent vector is a copy-on-write Scheme vector and the map/set are a
;; map/set are a bitmap HAMT (the structure 0c measured self-hostable). They live ;; bitmap HAMT. They live in Scheme; correctness, not perf, is the gate.
;; in Scheme for the Phase-1 bootstrap; the 0c decision is to SELF-HOST them in
;; Clojure once core is up on Chez (Phase 3 shim shrink). Correctness, not perf,
;; is the Phase-1 gate.
;; ============================================================================ ;; ============================================================================
;; small immutable-vector helpers (manual; avoid stdlib arg-order ambiguity) ;; small immutable-vector helpers (manual; avoid stdlib arg-order ambiguity)
@ -40,7 +37,7 @@
;; A pvec carries an `ent` flag: #t marks a MAP ENTRY (the [k v] pair seq'd out ;; A pvec carries an `ent` flag: #t marks a MAP ENTRY (the [k v] pair seq'd out
;; of a map). A map entry equals its [k v] vector and walks like one (nth/count/ ;; of a map). A map entry equals its [k v] vector and walks like one (nth/count/
;; seq/=/hash/print all read only `v`), but is NOT `vector?` and IS `map-entry?` ;; seq/=/hash/print all read only `v`), but is NOT `vector?` and IS `map-entry?`
;; — matching Clojure's MapEntry (jolt-agw6). The flag defaults #f, so every ;; — matching Clojure's MapEntry. The flag defaults #f, so every
;; existing `(make-pvec v)` builds a plain vector; modifying an entry (conj/assoc) ;; existing `(make-pvec v)` builds a plain vector; modifying an entry (conj/assoc)
;; likewise yields a plain vector. ;; likewise yields a plain vector.
(define-record-type pvec (define-record-type pvec

View file

@ -1,11 +1,11 @@
;; compile-eval.ss (jolt-hs9n, Phase 3 inc6) — the zero-Janet compile spine. ;; compile-eval.ss — the compile spine.
;; ;;
;; Ties together the cross-compiled compiler image (jolt.ir + jolt.analyzer + ;; Ties together the cross-compiled compiler image (jolt.ir + jolt.analyzer +
;; jolt.backend-scheme, loaded as def-var! forms) and the host contract ;; jolt.backend-scheme, loaded as def-var! forms) and the host contract
;; (host-contract.ss) into a runtime entry: a Clojure source string is read by the ;; (host-contract.ss) into a runtime entry: a Clojure source string is read by the
;; Chez data reader, analyzed by the ON-CHEZ analyzer to IR, emitted to Scheme by ;; Chez data reader, analyzed by the analyzer to IR, emitted to Scheme by the
;; the ON-CHEZ emitter, and eval'd — no Janet in the loop. This is the spine the ;; emitter, and eval'd. This is the spine the stage2==stage3 bootstrap fixpoint
;; stage2==stage3 bootstrap fixpoint (later increments) closes over. ;; closes over.
;; ;;
;; Loaded after host-contract.ss + the compiler image. ;; Loaded after host-contract.ss + the compiler image.
@ -13,11 +13,11 @@
(define jolt-ce-emit (var-deref "jolt.backend-scheme" "emit")) (define jolt-ce-emit (var-deref "jolt.backend-scheme" "emit"))
(define jolt-ce-read (var-deref "clojure.core" "read-string")) (define jolt-ce-read (var-deref "clojure.core" "read-string"))
;; The zero-Janet spine ALWAYS runs with the full clojure.core prelude loaded, so a ;; The spine ALWAYS runs with the full clojure.core prelude loaded, so a clojure.*
;; clojure.* ref must lower to var-deref (resolved from the prelude), not trip the ;; ref must lower to var-deref (resolved from the prelude), not trip the emitter's
;; emitter's "unsupported stdlib fn (no core on Chez yet)" out-of-subset guard — ;; "unsupported stdlib fn (no core on Chez yet)" out-of-subset guard — that guard
;; that guard is only for the bare -e subset with no prelude. Turn prelude mode on ;; is only for the bare -e subset with no prelude. Turn prelude mode on once, here,
;; once, here, so every analyze->emit on this spine sees the full core (jolt-qjr0). ;; so every analyze->emit on this spine sees the full core.
((var-deref "jolt.backend-scheme" "set-prelude-mode!") #t) ((var-deref "jolt.backend-scheme" "set-prelude-mode!") #t)
;; (quote X) -> X, else x — unwraps a quoted require spec. ;; (quote X) -> X, else x — unwraps a quoted require spec.
@ -31,7 +31,7 @@
;; Pre-register any (require ...)/(use ...) :as aliases under `ns` BEFORE analysis, ;; Pre-register any (require ...)/(use ...) :as aliases under `ns` BEFORE analysis,
;; so a qualified s/foo resolves while compiling (analysis precedes the runtime ;; so a qualified s/foo resolves while compiling (analysis precedes the runtime
;; require). Walks the whole form (a require may be nested in a do/let). jolt-qjr0. ;; require). Walks the whole form (a require may be nested in a do/let).
(define (ce-clause-require? cl) ; (:require ...) / (:use ...) ns clause (define (ce-clause-require? cl) ; (:require ...) / (:use ...) ns clause
(and (pair? cl) (keyword? (car cl)) (and (pair? cl) (keyword? (car cl))
(let ((kn (keyword-t-name (car cl)))) (or (string=? kn "require") (string=? kn "use"))))) (let ((kn (keyword-t-name (car cl)))) (or (string=? kn "require") (string=? kn "use")))))
@ -66,7 +66,7 @@
(define (jolt-analyze-emit src ns) (define (jolt-analyze-emit src ns)
(jolt-analyze-emit-form (jolt-ce-read src) ns)) (jolt-analyze-emit-form (jolt-ce-read src) ns))
;; --- runtime defmacro (jolt-r8ku) ------------------------------------------- ;; --- runtime defmacro -------------------------------------------------------
;; Shared with emit-image.ss (loaded after this). A defmacro lowers to a def of ;; Shared with emit-image.ss (loaded after this). A defmacro lowers to a def of
;; its expander fn + a macro flag, exactly as the prelude emits build-time macros. ;; its expander fn + a macro flag, exactly as the prelude emits build-time macros.
@ -82,7 +82,7 @@
;; Strips a leading docstring (native string) + attr-map (a non-symbol pmap), then ;; Strips a leading docstring (native string) + attr-map (a non-symbol pmap), then
;; re-heads the rest with `fn` so a destructured macro arglist desugars. Emits the ;; re-heads the rest with `fn` so a destructured macro arglist desugars. Emits the
;; BARE fn (the caller wraps it in def-var! + mark-macro!), never a (def NAME ...) — ;; BARE fn (the caller wraps it in def-var! + mark-macro!), never a (def NAME ...) —
;; interning NAME would make require skip the real macro (jolt-r9lm). ;; interning NAME would make require skip the real macro.
(define (ce-defmacro->fn f) (define (ce-defmacro->fn f)
(let* ((items (seq->list f)) (let* ((items (seq->list f))
(name-sym (cadr items)) (name-sym (cadr items))
@ -131,7 +131,6 @@
;; 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).
;; 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)))

View file

@ -1,13 +1,12 @@
;; concurrency.ss (jolt-byjr) — real OS-thread futures + promises for the Chez host. ;; concurrency.ss — real OS-thread futures + promises for the Chez host.
;; ;;
;; SHARED-HEAP semantics (JVM Clojure), NOT Janet's isolated-heap snapshot: a ;; SHARED-HEAP semantics, like JVM Clojure: a future body runs on a native thread
;; future body runs on a native thread (fork-thread) over the SAME heap, so a ;; (fork-thread) over the SAME heap, so a captured atom is shared and the body's
;; captured atom is shared and the body's mutations are visible to the parent — ;; mutations are visible to the parent. deref blocks on a mutex+condition latch.
;; matching `clojure.core` on the JVM. deref blocks on a mutex+condition latch.
;; ;;
;; future / future-call / future-cancel / future? / future-done? / future-cancelled? ;; future / future-call / future-cancel / future? / future-done? / future-cancelled?
;; promise / deliver, and the deref extension for both, are bound here (some ;; promise / deliver, and the deref extension for both, are bound here (some
;; re-asserted in post-prelude.ss over the overlay's Janet-shaped versions). ;; re-asserted in post-prelude.ss over the overlay's versions).
;; ;;
;; pmap / pcalls / pvalues live in the clojure.core overlay (40-lazy) expressed ;; pmap / pcalls / pvalues live in the clojure.core overlay (40-lazy) expressed
;; over `future`, so they light up for free once future-call exists. ;; over `future`, so they light up for free once future-call exists.
@ -105,8 +104,8 @@
(and (jolt-future? x) (jolt-future-cancelled? x))) (and (jolt-future? x) (jolt-future-cancelled? x)))
;; --- promises --------------------------------------------------------------- ;; --- promises ---------------------------------------------------------------
;; A blocking promise (JVM), not Janet's non-blocking atom shim: deref parks until ;; A blocking promise (like the JVM): deref parks until deliver, then caches the
;; deliver, then caches the value. deliver wins once; later delivers return nil. ;; value. deliver wins once; later delivers return nil.
(define-record-type jolt-promise (define-record-type jolt-promise
(fields (mutable delivered?) (mutable value) mu cv) (fields (mutable delivered?) (mutable value) mu cv)
(nongenerative jolt-promise-v1)) (nongenerative jolt-promise-v1))
@ -144,8 +143,8 @@
(if got (jolt-promise-value p) timeout-val))) (if got (jolt-promise-value p) timeout-val)))
;; --- agents (async, per-agent serialized dispatch) -------------------------- ;; --- agents (async, per-agent serialized dispatch) --------------------------
;; JVM semantics, not Janet's synchronous shim: send/send-off enqueue an action ;; JVM semantics: send/send-off enqueue an action and a single worker thread
;; and a single worker thread applies them to the state IN ORDER; deref reads the ;; applies them to the state IN ORDER; deref reads the
;; (possibly not-yet-updated) state without blocking; await blocks until the queue ;; (possibly not-yet-updated) state without blocking; await blocks until the queue
;; drains. An action error is captured (agent-error) and stops the queue. ;; drains. An action error is captured (agent-error) and stops the queue.
(define-record-type jolt-agent (define-record-type jolt-agent
@ -246,8 +245,8 @@
((jolt-delay? x) (jolt-delay-force x)) ((jolt-delay? x) (jolt-delay-force x))
(else (apply %pre-conc-deref x opts))))) (else (apply %pre-conc-deref x opts)))))
;; realized? for a Chez future/promise/delay (the overlay reads Janet map keys). ;; realized? for a future/promise/delay. Wrapped over the overlay version in
;; Wrapped over the overlay version in post-prelude.ss. ;; post-prelude.ss.
(define (jolt-conc-realized? x) (define (jolt-conc-realized? x)
(cond ((jolt-future? x) (jolt-future-done? x)) (cond ((jolt-future? x) (jolt-future-done? x))
((jolt-promise? x) (jolt-promise-delivered? x)) ((jolt-promise? x) (jolt-promise-delivered? x))
@ -273,7 +272,7 @@
(def-var! "clojure.core" "delay?" jolt-delay?) (def-var! "clojure.core" "delay?" jolt-delay?)
(def-var! "clojure.core" "deref" jolt-deref) (def-var! "clojure.core" "deref" jolt-deref)
;; --- cooperative thread interrupt (jolt-amzy) ------------------------------- ;; --- cooperative thread interrupt -------------------------------------------
;; Chez has no force-kill, but its engine timer (set-timer + timer-interrupt- ;; Chez has no force-kill, but its engine timer (set-timer + timer-interrupt-
;; handler, thread-local) is polled at procedure-call / loop back-edges — so a ;; handler, thread-local) is polled at procedure-call / loop back-edges — so a
;; running computation, even a tight Scheme loop, can be aborted from another ;; running computation, even a tight Scheme loop, can be aborted from another

View file

@ -143,8 +143,8 @@
(def-var! "clojure.core" "gensym" jolt-gensym) (def-var! "clojure.core" "gensym" jolt-gensym)
(def-var! "clojure.core" "int" jolt-int) (def-var! "clojure.core" "int" jolt-int)
;; char: coerce a code point (jolt's all-flonum number) to a Chez char; pass a ;; char: coerce a code point (jolt's all-flonum number) to a Chez char; pass a
;; char through. Inverse of int on chars. (Missing on Chez before jolt-hs9n — the ;; char through. Inverse of int on chars. The cross-compiled emitter's
;; cross-compiled emitter's chez-str-lit needs it for printable-ASCII escaping.) ;; chez-str-lit needs it for printable-ASCII escaping.
(define (jolt-char x) (if (char? x) x (integer->char (exact (round x))))) (define (jolt-char x) (if (char? x) x (integer->char (exact (round x)))))
(def-var! "clojure.core" "char" jolt-char) (def-var! "clojure.core" "char" jolt-char)
;; long: same truncation as int in jolt's all-flonum model (seed core-long = ;; long: same truncation as int in jolt's all-flonum model (seed core-long =

View file

@ -1,5 +1,5 @@
;; dot-forms.ss — generic dispatch for the `.` special-form / `.-field` desugar ;; dot-forms.ss — generic dispatch for the `.` special-form / `.-field` desugar.
;; (jolt-kuic). The analyzer lowers (. target member arg*) and (.-field target) ;; The analyzer lowers (. target member arg*) and (.-field target)
;; 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

View file

@ -1,5 +1,5 @@
;; dynamic var binding (jolt-2o7x, Phase 2) — binding / with-bindings* / var-set / ;; dynamic var binding — binding / with-bindings* / var-set / thread-bound? /
;; thread-bound? / with-local-vars / with-redefs / bound-fn* / get-thread-bindings. ;; with-local-vars / with-redefs / bound-fn* / get-thread-bindings.
;; ;;
;; A per-thread dynamic-binding stack: a list of frames, innermost (most recently ;; A per-thread dynamic-binding stack: a list of frames, innermost (most recently
;; pushed) at the HEAD. Each frame is an alist of (var-cell . value) MUTABLE pairs ;; pushed) at the HEAD. Each frame is an alist of (var-cell . value) MUTABLE pairs
@ -15,8 +15,8 @@
;; 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
;; ns.ss) so it chains the fully-extended jolt-var-get and overrides rt.ss var-deref. ;; ns.ss) so it chains the fully-extended jolt-var-get and overrides rt.ss var-deref.
;; THREAD-LOCAL (jolt-byjr): a Chez thread parameter, so each OS thread (a future ;; THREAD-LOCAL: a Chez thread parameter, so each OS thread (a future / go block)
;; / go block) has its own binding stack. Chez initializes a new thread's parameter ;; has its own binding stack. Chez initializes a new thread's parameter
;; to the spawning thread's value at fork time, giving Clojure binding conveyance ;; to the spawning thread's value at fork time, giving Clojure binding conveyance
;; for free (the future shim also installs an explicit snapshot, belt-and-suspenders). ;; for free (the future shim also installs an explicit snapshot, belt-and-suspenders).
(define dyn-binding-stack (make-thread-parameter '())) (define dyn-binding-stack (make-thread-parameter '()))
@ -104,8 +104,8 @@
;; jolt-var-get's unbound-error path) so undefined-var reads keep prior behaviour. ;; jolt-var-get's unbound-error path) so undefined-var reads keep prior behaviour.
;; The *ns* var cell — its reads are thread-local: with no thread-binding they ;; The *ns* var cell — its reads are thread-local: with no thread-binding they
;; derive from chez-current-ns (a thread-parameter), so *ns* tracks in-ns per ;; derive from chez-current-ns (a thread-parameter), so *ns* tracks in-ns per
;; thread and a (binding [*ns* ..]) drives resolution (jolt-6rld). Captured now ;; thread and a (binding [*ns* ..]) drives resolution. Captured now that *ns* is
;; that *ns* is defined (ns.ss loaded earlier); chez-current-ns consults it too. ;; defined (ns.ss loaded earlier); chez-current-ns consults it too.
(set! star-ns-cell (jolt-var "clojure.core" "*ns*")) (set! star-ns-cell (jolt-var "clojure.core" "*ns*"))
(define %dyn-rt-var-deref var-deref) (define %dyn-rt-var-deref var-deref)

View file

@ -1,4 +1,4 @@
;; emit-image.ss (jolt-cf1q.4 inc8) — the on-Chez compiler-image emitter. ;; emit-image.ss — the on-Chez compiler-image emitter.
;; ;;
;; This is the stage2/stage3 half of the self-hosting fixpoint. The ;; This is the stage2/stage3 half of the self-hosting fixpoint. 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
@ -34,7 +34,7 @@
;; 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>) +
;; (mark-macro! ns name) so the on-Chez analyzer can expand it (jolt-r9lm). ;; (mark-macro! ns name) so the on-Chez analyzer can expand it.
(define (ei-emit-ns ns-name src) (define (ei-emit-ns ns-name src)
(let loop ((forms (ei-read-all src)) (acc '())) (let loop ((forms (ei-read-all src)) (acc '()))
(if (null? forms) (if (null? forms)
@ -82,12 +82,12 @@
(append (append
(map (lambda (tf) (cons "clojure.core" (string-append "jolt-core/clojure/core/" tf ".clj"))) (map (lambda (tf) (cons "clojure.core" (string-append "jolt-core/clojure/core/" tf ".clj")))
'("00-syntax" "00-kernel" "10-seq" "20-coll" "25-sorted" "30-macros" "40-lazy" "50-io")) '("00-syntax" "00-kernel" "10-seq" "20-coll" "25-sorted" "30-macros" "40-lazy" "50-io"))
(list (cons "clojure.string" "src/jolt/clojure/string.clj") (list (cons "clojure.string" "stdlib/clojure/string.clj")
(cons "clojure.walk" "src/jolt/clojure/walk.clj") (cons "clojure.walk" "stdlib/clojure/walk.clj")
(cons "clojure.template" "src/jolt/clojure/template.clj") (cons "clojure.template" "stdlib/clojure/template.clj")
(cons "clojure.edn" "src/jolt/clojure/edn.clj") (cons "clojure.edn" "stdlib/clojure/edn.clj")
(cons "clojure.set" "src/jolt/clojure/set.clj") (cons "clojure.set" "stdlib/clojure/set.clj")
(cons "clojure.pprint" "src/jolt/clojure/pprint.clj")))) (cons "clojure.pprint" "stdlib/clojure/pprint.clj"))))
;; Join a list of form strings with "\n", no trailing newline. ;; Join a list of form strings with "\n", no trailing newline.
(define (ei-join forms) (define (ei-join forms)

View file

@ -1,4 +1,4 @@
;; host class tokens (jolt-13zk) — a bare class name (String, Keyword, File...) ;; host class tokens — 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). ;; against a (class …) dispatch (ring.util.request does this).
@ -81,8 +81,8 @@
(lambda (pair) (def-var! "clojure.core" (car pair) (cdr pair))) (lambda (pair) (def-var! "clojure.core" (car pair) (cdr pair)))
class-token-alist) class-token-alist)
;; resolve a ^Type hint symbol-name to its canonical class name at def time ;; resolve a ^Type hint symbol-name to its canonical class name at def time:
;; (jolt-a1ir): "String" -> "java.lang.String", matching the JVM compiler. An ;; "String" -> "java.lang.String", matching the JVM compiler. An
;; already-canonical name maps to itself; an unknown name yields #f (left as-is). ;; already-canonical name maps to itself; an unknown name yields #f (left as-is).
(define class-hint-table (make-hashtable string-hash string=?)) (define class-hint-table (make-hashtable string-hash string=?))
(for-each (lambda (p) (hashtable-set! class-hint-table (car p) (cdr p))) class-token-alist) (for-each (lambda (p) (hashtable-set! class-hint-table (car p) (cdr p))) class-token-alist)

View file

@ -1,4 +1,4 @@
;; host-contract.ss (jolt-hs9n, Phase 3 inc6) — the jolt.host contract on Chez. ;; host-contract.ss — 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. Every ;; Scheme) and the host. Every
@ -6,7 +6,7 @@
;; 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.
;; ;;
;; This is what puts analyze->IR->emit ON CHEZ (the zero-Janet spine). It runs ;; This is what puts analyze->IR->emit ON CHEZ. It runs
;; over the Chez data reader's forms (reader.ss): symbols are symbol-t, lists are ;; over the Chez data reader's forms (reader.ss): symbols are symbol-t, lists are
;; cseq (list?), () is empty-list-t, vectors/maps are pvec/pmap, sets and #tag/ ;; cseq (list?), () is empty-list-t, vectors/maps are pvec/pmap, sets and #tag/
;; regex/inst/uuid are pmaps tagged :jolt/type, chars are NATIVE Chez chars. ;; regex/inst/uuid are pmaps tagged :jolt/type, chars are NATIVE Chez chars.
@ -41,13 +41,13 @@
(define (hc-sym? x) (symbol-t? x)) (define (hc-sym? x) (symbol-t? x))
;; ANY non-empty seq is a list form for analysis (a macro/eval form built via ;; ANY non-empty seq is a list form for analysis (a macro/eval form built via
;; concat/map/cons is a lazy cseq with list?=#f, but evaluating it still means ;; concat/map/cons is a lazy cseq with list?=#f, but evaluating it still means
;; calling its head) — not just reader-built lists (jolt-cf1q.7). ;; calling its head) — not just reader-built lists.
(define (hc-list? x) (or (empty-list-t? x) (cseq? x))) (define (hc-list? x) (or (empty-list-t? x) (cseq? x)))
(define (hc-vec? x) (pvec? x)) (define (hc-vec? x) (pvec? x))
(define (hc-map? x) (and (pmap? x) (jolt-nil? (jolt-get x hc-kw-jolt-type)))) (define (hc-map? x) (and (pmap? x) (jolt-nil? (jolt-get x hc-kw-jolt-type))))
;; A set form is the reader's tagged map {:jolt/type :jolt/set :value <pvec>} OR a ;; A set form is the reader's tagged map {:jolt/type :jolt/set :value <pvec>} OR a
;; real pset value — a macro template's #{...} expansion (syntax-quote.ss jolt-sqset) ;; real pset value — a macro template's #{...} expansion (syntax-quote.ss jolt-sqset)
;; produces a pset, which the analyzer must still read as a set literal (jolt-r9lm). ;; produces a pset, which the analyzer must still read as a set literal.
(define (hc-set? x) (define (hc-set? x)
(or (pset? x) (or (pset? x)
(and (pmap? x) (eq? (jolt-get x hc-kw-jolt-type) hc-kw-jolt-set)))) (and (pmap? x) (eq? (jolt-get x hc-kw-jolt-type) hc-kw-jolt-set))))
@ -67,7 +67,7 @@
(define (hc-bigdec-source x) (jolt-get x hc-kw-form)) (define (hc-bigdec-source x) (jolt-get x hc-kw-form))
;; A live namespace value spliced into a form (e.g. `(str ~*ns*) in a macro): ;; A live namespace value spliced into a form (e.g. `(str ~*ns*) in a macro):
;; the analyzer can't carry an opaque runtime value, so recognize a jns and ;; the analyzer can't carry an opaque runtime value, so recognize a jns and
;; reconstruct it by name at the call site (jolt-8sha). ;; reconstruct it by name at the call site.
(define (hc-ns-value? x) (jns? x)) (define (hc-ns-value? x) (jns? x))
(define (hc-ns-value-name x) (jns-name x)) (define (hc-ns-value-name x) (jns-name x))
@ -98,7 +98,7 @@
(let ((kv (hashtable-ref rdr-map-order x #f))) (let ((kv (hashtable-ref rdr-map-order x #f)))
(if kv (if kv
;; reader-built map literal: emit pairs in SOURCE order (kv = k1 v1 k2 v2 …) ;; reader-built map literal: emit pairs in SOURCE order (kv = k1 v1 k2 v2 …)
;; so the analyzer evaluates the values left-to-right (jolt-qjr0). ;; so the analyzer evaluates the values left-to-right.
(let loop ((kv kv) (acc '())) (let loop ((kv kv) (acc '()))
(if (null? kv) (apply jolt-vector (reverse acc)) (if (null? kv) (apply jolt-vector (reverse acc))
(loop (cddr kv) (cons (jolt-vector (car kv) (cadr kv)) acc)))) (loop (cddr kv) (cons (jolt-vector (car kv) (cadr kv)) acc))))
@ -111,14 +111,14 @@
(define (hc-inst-source x) (jolt-get x hc-kw-form)) (define (hc-inst-source x) (jolt-get x hc-kw-form))
(define (hc-uuid-source x) (jolt-get x hc-kw-form)) (define (hc-uuid-source x) (jolt-get x hc-kw-form))
;; The Chez reader does not record source offsets yet (jolt-q2kg). ;; The Chez reader does not record source offsets yet.
(define (hc-form-position x) jolt-nil) (define (hc-form-position x) jolt-nil)
;; --- special forms ---------------------------------------------------------- ;; --- special forms ----------------------------------------------------------
;; Mirrors host_iface special-names + interop-head? — forms the analyzer marks ;; Mirrors host_iface special-names + interop-head? — forms the analyzer marks
;; uncompilable (the handled specials are dispatched in analyze-list BEFORE this). ;; uncompilable (the handled specials are dispatched in analyze-list BEFORE this).
;; `eval` is NOT here: it is a clojure.core FUNCTION on the spine (compile-eval.ss ;; `eval` is NOT here: it is a clojure.core FUNCTION on the spine (compile-eval.ss
;; def-var!s it), so it must resolve as an ordinary var, not punt (jolt-r8ku). ;; def-var!s it), so it must resolve as an ordinary var, not punt.
;; `defmacro` stays special — the spine intercepts it before analysis. ;; `defmacro` stays special — the spine intercepts it before analysis.
(define hc-special-names (define hc-special-names
'("quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def" '("quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def"
@ -155,7 +155,7 @@
(and ref (var-cell-lookup ref nm))) (and ref (var-cell-lookup ref nm)))
(var-cell-lookup "clojure.core" nm))))) (var-cell-lookup "clojure.core" nm)))))
;; Runtime macros (jolt-r9lm, inc6b): a defmacro is emitted into the prelude as a ;; Runtime macros: a defmacro is emitted into the prelude as a
;; 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
@ -173,7 +173,7 @@
;; {:kind :var :ns NS :name NAME} — a defined var (compile ns / clojure.core) ;; {:kind :var :ns NS :name NAME} — a defined var (compile ns / clojure.core)
;; {:kind :unresolved :name NAME} — not found (late-bind -> var-ref @ compile ns; ;; {:kind :unresolved :name NAME} — not found (late-bind -> var-ref @ compile ns;
;; a qualified one -> host-static in the analyzer) ;; a qualified one -> host-static in the analyzer)
;; No :host branch: there is no Janet-style native-op env on Chez — the hot ;; No :host branch: there is no separate native-op env — the hot
;; clojure.core primitives (+,-,map,...) are declared in clojure.core below so ;; clojure.core primitives (+,-,map,...) are declared in clojure.core below so
;; they classify as :var and the emitter's native-op path lowers them. ;; they classify as :var and the emitter's native-op path lowers them.
(define (hc-resolve-global ctx sym) (define (hc-resolve-global ctx sym)
@ -187,7 +187,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 ---------------------------------------------------
;; 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
@ -236,7 +236,7 @@
;; to the target namespace — Clojure resolves the alias part of a qualified ;; to the target namespace — Clojure resolves the alias part of a qualified
;; symbol in syntax-quote, so a macro's `impl/foo` expands to its real ;; symbol in syntax-quote, so a macro's `impl/foo` expands to its real
;; (clojure.tools.logging.impl/foo) name and stays unambiguous even when ;; (clojure.tools.logging.impl/foo) name and stays unambiguous even when
;; another loaded ns shares the alias's short name (jolt-qjr0). Otherwise ;; another loaded ns shares the alias's short name. Otherwise
;; leave it as written (a real ns or an interop class token). ;; leave it as written (a real ns or an interop class token).
(let ((target (chez-resolve-alias (chez-actx-cns ctx) sns))) (let ((target (chez-resolve-alias (chez-actx-cns ctx) sns)))
(if target (jolt-symbol target nm) form))))) (if target (jolt-symbol target nm) form)))))

View file

@ -1,4 +1,4 @@
;; host-static.ss (jolt-avt6) — host class statics + constructors on Chez. ;; host-static.ss — host class statics + constructors on Chez.
;; ;;
;; 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
@ -99,7 +99,7 @@
(let ((ctor (lookup-class class-ctors-tbl class))) (let ((ctor (lookup-class class-ctors-tbl class)))
(cond (cond
(ctor (apply ctor args)) (ctor (apply ctor args))
;; deftype/defrecord (jolt-499t): the type name is bound as a VAR (the ;; deftype/defrecord: the type name is bound as a VAR (the
;; make-deftype-ctor closure) in its defining ns, not a registered host class. ;; make-deftype-ctor closure) in its defining ns, not a registered host class.
;; Resolve it in the current ns / clojure.core and invoke it — so (P. args) ;; Resolve it in the current ns / clojure.core and invoke it — so (P. args)
;; works the same as the ->P factory. ;; works the same as the ->P factory.
@ -111,7 +111,7 @@
(error #f (string-append "No constructor for class " class)))))))) (error #f (string-append "No constructor for class " class))))))))
;; ---- coercion helpers ------------------------------------------------------- ;; ---- coercion helpers -------------------------------------------------------
;; numeric tower (jolt-n6al): currentTimeMillis/nanoTime are exact longs (JVM). ;; numeric tower: 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 ;; parse an integer string in radix; #f on failure
@ -161,7 +161,7 @@
(cons "PI" (->dbl (* 4 (atan 1)))) (cons "E" (->dbl (exp 1))) (cons "PI" (->dbl (* 4 (atan 1)))) (cons "E" (->dbl (exp 1)))
(cons "random" (lambda args (random 1.0))))) (cons "random" (lambda args (random 1.0)))))
;; Thread: real OS threads back futures/promises (jolt-byjr), so sleep genuinely ;; Thread: real OS threads back futures/promises, so sleep genuinely
;; parks the calling thread for `ms` milliseconds (a worker sleeping doesn't block ;; parks the calling thread for `ms` milliseconds (a worker sleeping doesn't block
;; the parent). yield hands off the scheduler. ;; the parent). yield hands off the scheduler.
(register-class-statics! "Thread" (register-class-statics! "Thread"
@ -178,7 +178,7 @@
(list (cons "getContextClassLoader" (lambda (self) (make-jhost "classloader" '()))))) (list (cons "getContextClassLoader" (lambda (self) (make-jhost "classloader" '())))))
;; clojure.lang.LockingTransaction: jolt has no STM (no refs/dosync), so a ;; clojure.lang.LockingTransaction: jolt has no STM (no refs/dosync), so a
;; transaction is never running. isRunning -> false (jolt-0obq). ;; transaction is never running. isRunning -> false.
(register-class-statics! "LockingTransaction" (list (cons "isRunning" (lambda () #f)))) (register-class-statics! "LockingTransaction" (list (cons "isRunning" (lambda () #f))))
(register-class-statics! "clojure.lang.LockingTransaction" (list (cons "isRunning" (lambda () #f)))) (register-class-statics! "clojure.lang.LockingTransaction" (list (cons "isRunning" (lambda () #f))))
@ -267,7 +267,7 @@
(apply jolt-format (car rest) (cdr rest)) (apply jolt-format (car rest) (cdr rest))
(apply jolt-format a rest)))))) (apply jolt-format a rest))))))
;; ---- java.text.NumberFormat (jolt-1nnn) ------------------------------------- ;; ---- java.text.NumberFormat -------------------------------------------------
;; A grouping decimal formatter (selmer number-format / cuerdas). state: ;; A grouping decimal formatter (selmer number-format / cuerdas). state:
;; #(grouping? min-frac max-frac). .format groups the integer part with commas. ;; #(grouping? min-frac max-frac). .format groups the integer part with commas.
(define (nf-make grouping? minf maxf) (make-jhost "numberformat" (vector grouping? minf maxf))) (define (nf-make grouping? minf maxf) (make-jhost "numberformat" (vector grouping? minf maxf)))
@ -371,7 +371,7 @@
((char=? (string-ref l i) #\=) i) ((char=? (string-ref l i) #\=) i)
(else (scan (+ i 1))))))) (else (scan (+ i 1)))))))
(loop (if eq (cons (cons (substring l 0 eq) (substring l (+ eq 1) (string-length l))) acc) acc))))))))) (loop (if eq (cons (cons (substring l 0 eq) (substring l (+ eq 1) (string-length l))) acc) acc)))))))))
;; JOLT_BAKE_ENV_ALLOWLIST (jolt-s3j): when set, only the listed comma-separated ;; JOLT_BAKE_ENV_ALLOWLIST: when set, only the listed comma-separated
;; names are served; unset (the normal case) reads are live and unfiltered. ;; names are served; unset (the normal case) reads are live and unfiltered.
(define (env-allowlist) (define (env-allowlist)
(let ((a (getenv "JOLT_BAKE_ENV_ALLOWLIST"))) (let ((a (getenv "JOLT_BAKE_ENV_ALLOWLIST")))
@ -399,7 +399,7 @@
;; or a unique sentinel). Each call returns a new jhost so identical?/= separate. ;; or a unique sentinel). Each call returns a new jhost so identical?/= separate.
(register-class-ctor! "Object" (lambda _ (make-jhost "object" (vector)))) (register-class-ctor! "Object" (lambda _ (make-jhost "object" (vector))))
;; ---- java.util.ArrayList (jolt-1nnn) ---------------------------------------- ;; ---- java.util.ArrayList ----------------------------------------------------
;; A mutable list backed by a Scheme list in a box. medley's stateful transducers ;; A mutable list backed by a Scheme list in a box. medley's stateful transducers
;; (window / partition-between) build one with .add / .size / .toArray / .clear / ;; (window / partition-between) build one with .add / .size / .toArray / .clear /
;; .remove. (ArrayList.) | (ArrayList. n) | (ArrayList. coll). ;; .remove. (ArrayList.) | (ArrayList. n) | (ArrayList. coll).
@ -899,5 +899,5 @@
(def-var! "clojure.core" "__register-instance-check!" (def-var! "clojure.core" "__register-instance-check!"
(lambda (f) (set! user-instance-checks (append user-instance-checks (list f))) jolt-nil)) (lambda (f) (set! user-instance-checks (append user-instance-checks (list f))) jolt-nil))
;; (jolt.host/table? x) — is x a host tagged-table (the Janet-table replacement)? ;; (jolt.host/table? x) — is x a host tagged-table?
(def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f))) (def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f)))

View file

@ -1,10 +1,9 @@
;; host tables + sorted collections (jolt-cf1q.3, jolt-0zoy) — the jolt.host ;; host tables + sorted collections — the jolt.host value primitives and the
;; value primitives and the 25-sorted tier's runtime. ;; 25-sorted tier's runtime.
;; ;;
;; jolt.host/tagged-table + ref-put! + ref-get resolved to jolt-nil on the Chez ;; jolt.host/tagged-table + ref-put! + ref-get back the whole sorted tier
;; prelude, so the whole sorted tier (sorted-map/sorted-set/subseq/rsubseq) AND ;; (sorted-map/sorted-set/subseq/rsubseq) AND every overlay fn that calls
;; every overlay fn that calls (sorted? x) — empty, ifn?, reversible?, map?, set?, ;; (sorted? x) — empty, ifn?, reversible?, map?, set?, coll?. This provides:
;; coll? — hit the apply-jolt-nil crash bucket. This provides:
;; 1. tagged-table / ref-put! / ref-get over a Chez mutable tagged-table type ;; 1. tagged-table / ref-put! / ref-get over a Chez mutable tagged-table type
;; (a string-keyed hashtable wrapped in an `htable` record), def-var!'d into ;; (a string-keyed hashtable wrapped in an `htable` record), def-var!'d into
;; the jolt.host ns. The sorted tier (25-sorted.clj) mints its wrapper with ;; the jolt.host ns. The sorted tier (25-sorted.clj) mints its wrapper with
@ -28,10 +27,9 @@
(let ((h (make-hashtable string-hash string=?))) (let ((h (make-hashtable string-hash string=?)))
(hashtable-set! h "jolt/type" tag) (hashtable-set! h "jolt/type" tag)
(make-htable h))) (make-htable h)))
;; ref-put! threads the table back; a nil value REMOVES the key (Janet table ;; ref-put! threads the table back; a nil value REMOVES the key. Errors on a
;; semantics — h-ref-put!). Errors on a non-htable so the atom-watch / volatile ;; non-htable so the atom-watch / volatile uses (which pass a different ref type
;; uses (which pass a different ref type and have no Chez table yet) stay a crash ;; and have no table yet) stay a crash rather than silently diverging.
;; rather than silently diverging.
(define (jolt-ref-put! t k v) (define (jolt-ref-put! t k v)
(unless (htable? t) (error #f "ref-put!: not a host table" t)) (unless (htable? t) (error #f "ref-put!: not a host table" t))
(if (jolt-nil? v) (if (jolt-nil? v)

View file

@ -1,4 +1,4 @@
;; #inst values + a java.time formatting shim (jolt-at0a, inc X). ;; #inst values + a java.time formatting shim.
;; ;;
;; 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
@ -356,7 +356,7 @@
;; java.util.Date / java.sql.Timestamp: #inst's classes. (Date.) = now, (Date. ms) ;; java.util.Date / java.sql.Timestamp: #inst's classes. (Date.) = now, (Date. ms)
;; or (Date. another-date) -> a jinst (ms-of accepts a number / jinst / instant), so ;; or (Date. another-date) -> a jinst (ms-of accepts a number / jinst / instant), so
;; .getTime / inst? / instance? Date|Timestamp work. (jolt-dcmm) ;; .getTime / inst? / instance? Date|Timestamp work.
(define (date-ctor . args) (define (date-ctor . args)
(make-jinst (if (null? args) (now-ms) (ms->exact (ms-of (car args)))))) (make-jinst (if (null? args) (now-ms) (ms->exact (ms-of (car args))))))
(register-class-ctor! "Date" date-ctor) (register-class-ctor! "Date" date-ctor)

View file

@ -1,5 +1,5 @@
;; java.io.File + host file I/O (jolt-yyud). A ;; java.io.File + host file I/O, implemented over Chez's filesystem
;; Chez-native implementation over Chez's filesystem primitives. A File is a ;; 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.
@ -8,8 +8,7 @@
;; list-dir for 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, ;; Loaded LAST in rt.ss, after
;; slurp over a reader) is deferred to jolt-at0a. Loaded LAST in rt.ss, after
;; dot-forms.ss (so the jfile method arm wraps the fully-built dispatch) and ;; dot-forms.ss (so the jfile method arm wraps the fully-built dispatch) and
;; natives-meta.ss / records.ss / printing.ss (jolt-type / instance-check / ;; natives-meta.ss / records.ss / printing.ss (jolt-type / instance-check /
;; jolt-str-render-one, which it extends). ;; jolt-str-render-one, which it extends).
@ -109,8 +108,8 @@
(%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 — the Phase-1 shims there assume a ;; dispatch — the shims there assume a path STRING target. Make them jfile-aware
;; path STRING target. Make them jfile-aware so file-seq's File branch works. ;; 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
(lambda (method target . args) (lambda (method target . args)
@ -156,17 +155,15 @@
(begin (reader-refill! r "") (values jolt-nil #f)) (begin (reader-refill! r "") (values jolt-nil #f))
(begin (reader-refill! r (jolt-nth pr 1)) (values (jolt-nth pr 0) #t))))) (begin (reader-refill! r (jolt-nth pr 1)) (values (jolt-nth pr 0) #t)))))
;; clojure.edn/read over a reader (jolt-uicd): the overlay edn.clj's drain-reader is ;; clojure.edn/read over a reader: drain the jhost reader to a string and read the
;; janet/type-coupled, so on Chez we drain the jhost reader to a string and read the
;; first EDN form (read-string). Re-asserted over the prelude in post-prelude.ss. ;; first EDN form (read-string). Re-asserted over the prelude in post-prelude.ss.
(define (chez-edn-read reader) (define (chez-edn-read reader)
(jolt-invoke (var-deref "clojure.core" "read-string") (jolt-invoke (var-deref "clojure.core" "read-string")
(if (reader-jhost? reader) (drain-reader reader) (jolt-str-render-one reader)))) (if (reader-jhost? reader) (drain-reader reader) (jolt-str-render-one reader))))
;; line-seq (jolt-0obq): the overlay line-seq reads via a Janet map-reader's ;; line-seq: an io/reader is a jhost StringReader. Drain it (or take a string)
;; :read-line-fn, but a Chez io/reader is a jhost StringReader. Drain it (or take a ;; and split on newline; a trailing newline does NOT yield a final empty line
;; string) and split on newline; a trailing newline does NOT yield a final empty ;; (like readLine -> nil at EOF). Re-asserted in post-prelude.ss.
;; line (like readLine -> nil at EOF). Re-asserted in post-prelude.ss.
(define (chez-lines s) (define (chez-lines s)
(let loop ((cs (string->list s)) (cur '()) (acc '())) (let loop ((cs (string->list s)) (cur '()) (acc '()))
(cond ((null? cs) (reverse (if (null? cur) acc (cons (list->string (reverse cur)) acc)))) (cond ((null? cs) (reverse (if (null? cur) acc (cons (list->string (reverse cur)) acc))))
@ -350,7 +347,7 @@
(else (let ((ctor (lookup-class class-ctors-tbl "URL"))) (else (let ((ctor (lookup-class class-ctors-tbl "URL")))
(if ctor (ctor (jolt-str-render-one x)) (make-url (jolt-str-render-one x)))))))) (if ctor (ctor (jolt-str-render-one x)) (make-url (jolt-str-render-one x))))))))
;; --- java.lang.ClassLoader (jolt-1nnn) -------------------------------------- ;; --- java.lang.ClassLoader --------------------------------------------------
;; jolt has no classpath; a "classloader" resolves a named resource against the ;; jolt has no classpath; a "classloader" resolves a named resource against the
;; loader's source roots (the same model as clojure.java.io/resource), returning a ;; loader's source roots (the same model as clojure.java.io/resource), returning a
;; file: URL or nil. getSystemClassLoader / a thread's contextClassLoader both hand ;; file: URL or nil. getSystemClassLoader / a thread's contextClassLoader both hand
@ -380,7 +377,7 @@
(register-class-statics! "Thread" (list (cons "currentThread" (lambda () the-thread)))) (register-class-statics! "Thread" (list (cons "currentThread" (lambda () the-thread))))
(register-class-statics! "java.lang.Thread" (list (cons "currentThread" (lambda () the-thread)))) (register-class-statics! "java.lang.Thread" (list (cons "currentThread" (lambda () the-thread))))
;; --- java.io.File / java.util.UUID constructors (jolt-1nnn) ------------------ ;; --- java.io.File / java.util.UUID constructors -----------------------------
;; (java.io.File. parent child) joins with "/"; (File. path) wraps the path. ;; (java.io.File. parent child) joins with "/"; (File. path) wraps the path.
(register-class-ctor! "File" (register-class-ctor! "File"
(lambda (a . rest) (lambda (a . rest)
@ -396,7 +393,7 @@
(cons "fromString" (lambda (s) (jolt-parse-uuid (jolt-str-render-one s)))))) (cons "fromString" (lambda (s) (jolt-parse-uuid (jolt-str-render-one s))))))
(register-class-ctor! "UUID" (lambda (s) (jolt-parse-uuid (jolt-str-render-one s)))) (register-class-ctor! "UUID" (lambda (s) (jolt-parse-uuid (jolt-str-render-one s))))
;; --- java.net.URI (jolt-1nnn) ----------------------------------------------- ;; --- java.net.URI -----------------------------------------------------------
;; A minimal RFC-3986 split into scheme/authority/host/port/path/query/fragment, ;; A minimal RFC-3986 split into scheme/authority/host/port/path/query/fragment,
;; kept in a jhost "uri" carrying the original string. (str u)/(.toString u) give ;; kept in a jhost "uri" carrying the original string. (str u)/(.toString u) give
;; the original; getHost is nil for a relative URI (hiccup.util/to-str branches on ;; the original; getHost is nil for a relative URI (hiccup.util/to-str branches on

View file

@ -1,12 +1,10 @@
;; lazy-seq bridge (jolt-cf1q.3, jolt-dmw9) — make-lazy-seq / coll->cells. ;; lazy-seq bridge — make-lazy-seq / coll->cells.
;; ;;
;; 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 had ;; and `lazy-cat` to (concat (lazy-seq c) ...). These back 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.
;; to jolt-nil and hit the apply-jolt-nil crash bucket.
;; ;;
;; Bridge to the cseq model (seq.ss): a `jolt-lazyseq` is a deferred seq — a 0-arg ;; Bridge to the cseq model (seq.ss): a `jolt-lazyseq` is a deferred seq — a 0-arg
;; thunk that, when forced once, yields a seq (cseq | nil). coll->cells coerces the ;; thunk that, when forced once, yields a seq (cseq | nil). coll->cells coerces the

View file

@ -1,10 +1,9 @@
;; loader.ss (jolt-90sp) — file-based namespace loading + a shell primitive. ;; loader.ss — file-based namespace loading + a shell primitive.
;; ;;
;; The corpus/CLI spine compiles one program at a time; namespaces declared in ;; The corpus/CLI spine compiles one program at a time; namespaces declared in
;; that program see each other because a top-level (do …) unrolls. A real project ;; that program see each other because a top-level (do …) unrolls. A real project
;; spans many FILES, so `require` must locate a namespace's source on the search ;; spans many FILES, so `require` must locate a namespace's source on the search
;; roots and load it — transitively, once each. This is the piece the Phase-3 ;; roots and load it — transitively, once each.
;; "cross-ns load is deferred" note left open (ns.ss).
;; ;;
;; Loaded by cli.ss AFTER compile-eval.ss (it calls jolt-compile-eval-form). The ;; Loaded by cli.ss AFTER compile-eval.ss (it calls jolt-compile-eval-form). The
;; gates load compile-eval.ss but NOT this file, so the corpus/unit/sci runners ;; gates load compile-eval.ss but NOT this file, so the corpus/unit/sci runners

View file

@ -1,10 +1,10 @@
;; clojure.math (jolt-22vo) — Chez host shim over native flonum math. ;; clojure.math host shim over native flonum math.
;; ;;
;; clojure.math is registered as native bindings (jolt-h79), NOT a .clj file — so ;; clojure.math is registered as native bindings, 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. The def-var! shims here back each clojure.math fn over
;; clojure.math fn, over Chez's native procedures. The analyzer knows the ;; Chez's native procedures. The analyzer knows the clojure.math ns exists, so a
;; clojure.math ns exists, so a ref ;; ref like clojure.math/sqrt lowers to a var-deref; these cells back it at
;; like clojure.math/sqrt lowers to a var-deref; these cells back it at runtime. ;; 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 ;; sqrt/sin/expt/... return flonums for flonum args). Semantics match

View file

@ -1,4 +1,4 @@
;; multimethods (jolt-9ls5) — the multimethod dispatch runtime on the Chez host. ;; multimethods — the multimethod dispatch runtime on the Chez host.
;; ;;
;; 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/
@ -21,7 +21,7 @@
;; so they agree with defmulti. Loaded from rt.ss after seq.ss (jolt-invoke), ;; so they agree with defmulti. Loaded from rt.ss after seq.ss (jolt-invoke),
;; collections.ss (jolt=/key-hash/jolt-hash-map) and the var-cell machinery. ;; collections.ss (jolt=/key-hash/jolt-hash-map) and the var-cell machinery.
;; THREAD-LOCAL (jolt-6rld): a Chez thread-parameter, so each OS thread (an nREPL ;; THREAD-LOCAL: a Chez thread-parameter, so each OS thread (an nREPL
;; session worker / future) has its own current ns — vars stay global, only the ;; session worker / future) has its own current ns — vars stay global, only the
;; "current ns" pointer is per-thread, matching Clojure's thread-local *ns*. A new ;; "current ns" pointer is per-thread, matching Clojure's thread-local *ns*. A new
;; thread inherits the forking thread's value. `star-ns-cell` (the *ns* var cell, ;; thread inherits the forking thread's value. `star-ns-cell` (the *ns* var cell,

View file

@ -1,4 +1,4 @@
;; natives-array.ss (jolt-cf1q.7) — Java-style mutable arrays for the Chez host. ;; natives-array.ss — Java-style mutable arrays for the Chez host.
;; ;;
;; 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
@ -24,7 +24,7 @@
(make-jolt-array (make-vector (exact (na-idx a)) (if (pair? rest) (car rest) init)) kind) (make-jolt-array (make-vector (exact (na-idx a)) (if (pair? rest) (car rest) init)) kind)
(na-from-seq a kind))) (na-from-seq a kind)))
;; numeric tower (jolt-n6al): array element defaults / masked bytes / count are ;; numeric tower: array element defaults / masked bytes / count are
;; EXACT integers (= JVM byte/short/int), matching exact integer literals. ;; EXACT integers (= JVM byte/short/int), matching exact integer literals.
(define (na-byte-of v) (bitwise-and (exact (floor v)) #xff)) (define (na-byte-of v) (bitwise-and (exact (floor v)) #xff))

View file

@ -1,10 +1,8 @@
;; Collection constructors + rand (jolt-cf1q.3 Phase 2 inc A) — host-coupled ;; Collection constructors + rand — host-coupled natives the overlay assumes as
;; natives the overlay assumes as bare clojure.core vars but which were never ;; bare clojure.core vars. The persistent-collection constructors already exist
;; def-var!'d, so they resolved to jolt-nil and any call hit the apply-jolt-nil ;; in collections.ss (jolt-hash-map / jolt-hash-set / jolt-vector); this just
;; crash bucket. The persistent-collection constructors already exist in ;; binds the public clojure.core names to them. Loaded after def-var! (rt.ss) +
;; collections.ss (jolt-hash-map / jolt-hash-set / jolt-vector); this just binds ;; the collections + seq tiers. hash-map/array-map/hash-set/set/rand semantics.
;; the public clojure.core names to them. Loaded after def-var! (rt.ss) + the
;; collections + seq tiers. hash-map/array-map/hash-set/set/rand semantics.
;; 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

View file

@ -1,4 +1,4 @@
;; metadata (jolt-cf1q.3 Phase 2 inc E) — meta / with-meta. Chez values don't ;; metadata — meta / with-meta. Chez values don't
;; carry metadata, so collections use an identity-keyed side-table: with-meta ;; carry metadata, so collections use an identity-keyed side-table: with-meta
;; returns a fresh COPY of the value (new identity) and records its meta there, so ;; returns a fresh COPY of the value (new identity) and records its meta there, so
;; the original is unchanged (Clojure's immutable-with-meta) and a copy made by a ;; the original is unchanged (Clojure's immutable-with-meta) and a copy made by a
@ -13,7 +13,7 @@
(cond (cond
((symbol-t? x) (let ((m (symbol-t-meta x))) (if (jolt-nil? m) jolt-nil m))) ((symbol-t? x) (let ((m (symbol-t-meta x))) (if (jolt-nil? m) jolt-nil m)))
;; a var's meta is {:ns :name} (derived from the cell) + any def-time user ;; a var's meta is {:ns :name} (derived from the cell) + any def-time user
;; meta from rt.ss's var-meta-table (jolt-zikh). ;; meta from rt.ss's var-meta-table.
((var-cell? x) ((var-cell? x)
(let ((user (hashtable-ref var-meta-table x #f))) (let ((user (hashtable-ref var-meta-table x #f)))
(jolt-assoc (if user user (jolt-hash-map)) (jolt-assoc (if user user (jolt-hash-map))

View file

@ -1,5 +1,4 @@
;; misc scalar natives (jolt-cf1q.3) — UUID, format/printf, tagged-literal, ;; misc scalar natives — UUID, format/printf, tagged-literal, bigint.
;; bigint. Seed natives that were jolt-nil on the prelude.
;; ;;
;; Loaded after the printers (pr-str of a uuid is #uuid "…") and converters ;; Loaded after the printers (pr-str of a uuid is #uuid "…") and converters
;; (jolt-str-render-one for %s / str of a uuid). ;; (jolt-str-render-one for %s / str of a uuid).

View file

@ -1,8 +1,7 @@
;; bit ops + string->number parsers (jolt-cf1q.3 Phase 2 inc C) — host-coupled ;; bit ops + string->number parsers — host-coupled natives (bit family,
;; natives (bit family, parse-long/double) that ;; parse-long/double). 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-* use strict shapes
;; to an exact integer, operate, and return a flonum. parse-* use ;; (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.
(define (->int x) (exact (truncate x))) (define (->int x) (exact (truncate x)))

View file

@ -1,5 +1,5 @@
;; natives-parity.ss (jolt-cf1q.7) — native Chez shims for clojure.core fns that ;; natives-parity.ss — native Chez shims for clojure.core fns. Pure-Chez,
;; had no Chez shim, so they resolved to nil ("not a fn"). Pure-Chez, JVM-matching. ;; 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).

View file

@ -1,4 +1,4 @@
;; natives-queue.ss (jolt-b8he) — clojure.lang.PersistentQueue for the Chez host. ;; natives-queue.ss — clojure.lang.PersistentQueue for the Chez host.
;; ;;
;; A functional queue: a `front` Scheme list (the dequeue end, head = front of the ;; A functional queue: a `front` Scheme list (the dequeue end, head = front of the
;; queue) + a reversed `rear` Scheme list (the enqueue end, head = most recent). ;; queue) + a reversed `rear` Scheme list (the enqueue end, head = most recent).

View file

@ -1,9 +1,6 @@
;; seq-native shims (jolt-y6mv) — native seq fns the overlay assumes are ;; seq-native shims — native seq fns the overlay assumes are clojure.core
;; clojure.core natives but which have no def-var! in the assembled prelude and ;; natives. Each is a pure fn over the existing seq layer (seq.ss) — collection
;; resolve to jolt-nil on ;; arities only; the 1-arg transducer arities follow below. Loaded last (after
;; 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
;; only; the 1-arg transducer arities are jolt-kxsr. Loaded last (after
;; converters.ss for jolt-compare and seq.ss for the reduced record). ;; converters.ss for jolt-compare and seq.ss for the reduced record).
;; reduced / reduced? — the box itself is the jolt-reduced record from seq.ss ;; reduced / reduced? — the box itself is the jolt-reduced record from seq.ss
@ -14,7 +11,7 @@
(define (ensure-reduced x) (if (jolt-reduced? x) x (make-jolt-reduced x))) (define (ensure-reduced x) (if (jolt-reduced? x) x (make-jolt-reduced x)))
;; ============================================================================ ;; ============================================================================
;; transducers (jolt-kxsr) — the 1-arg arity of map/filter/take/... returns a ;; transducers — 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. rf and the mapping/predicate fns are jolt values, so every ;; []=init, [acc]=complete, [acc x]=step. 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

View file

@ -1,4 +1,4 @@
;; natives-str.ss (jolt-nfca) — java.lang.String method interop on Chez. ;; natives-str.ss — java.lang.String method interop on Chez.
;; ;;
;; (.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.
@ -316,10 +316,9 @@
;; (require ...) / (use ...) at runtime: register each spec's :as alias + :refer ;; (require ...) / (use ...) at runtime: register each spec's :as alias + :refer
;; names into the runtime ns tables (chez-register-spec!, ns.ss), keyed by the ;; names into the runtime ns tables (chez-register-spec!, ns.ss), keyed by the
;; current ns. The zero-Janet spine also pre-registers these at analyze time ;; current ns. The spine also pre-registers these at analyze time (idempotent),
;; (idempotent); but when the JANET analyzer compiled the form (the prelude path) ;; so ns-aliases/ns-resolve over an :as alias resolve. Specs arrive evaluated
;; the Chez tables were never populated, so ns-aliases/ns-resolve over an :as alias ;; (quoted).
;; need this runtime registration (jolt-cf1q.7). Specs arrive evaluated (quoted).
(define (chez-runtime-require . specs) (define (chez-runtime-require . specs)
(for-each (lambda (s) (chez-register-spec! (chez-current-ns) s)) specs) (for-each (lambda (s) (chez-register-spec! (chez-current-ns) s)) specs)
jolt-nil) jolt-nil)

View file

@ -1,10 +1,8 @@
;; volatiles + sequence / transduce (jolt-cf1q.3, jolt-xjx6) — the transducer ;; volatiles + sequence / transduce — the transducer application surface.
;; application surface.
;; ;;
;; `sequence` and `transduce` are seed natives that were jolt-nil on the prelude. ;; `sequence` and `transduce` are seed natives. The stateful transducer arities
;; The stateful transducer arities (take-nth/map-indexed/partition-by/dedupe/ ;; (take-nth/map-indexed/partition-by/dedupe/distinct, all overlay) use
;; distinct, all overlay) use volatile!/vswap!/vreset!/deref, also unshimmed — so ;; volatile!/vswap!/vreset!/deref, shimmed here.
;; the whole (sequence xform coll) / (transduce xform f coll) surface crashed.
;; ;;
;; Volatiles are a native mutable box (jvol) — the overlay vreset!/vswap! drive a ;; Volatiles are a native mutable box (jvol) — the overlay vreset!/vswap! drive a
;; volatile through jolt.host/ref-put!+get, but a Chez volatile is a record, not a ;; volatile through jolt.host/ref-put!+get, but a Chez volatile is a record, not a

View file

@ -1,15 +1,15 @@
;; namespaces (jolt-yxqm, Phase 2) — the namespace value model. ;; namespaces — the namespace value model.
;; ;;
;; Chez has no ctx, so the ctx-coupled seed natives (find-ns/resolve/in-ns/…) are ;; The namespace ops (find-ns/resolve/in-ns/…) work over the rt.ss var-table
;; reimplemented over the rt.ss var-table (cells carry ns + name + defined?) and ;; (cells carry ns + name + defined?) and the multimethods.ss chez-current-ns
;; the multimethods.ss chez-current-ns box. A namespace VALUE is a `jns` record ;; box. A namespace VALUE is a `jns` record carrying its name string — distinct
;; carrying its name string — distinct from a map/record so (map? ns) is #f, but ;; from a map/record so (map? ns) is #f, but the overlay's `ns-name` reads
;; the overlay's `ns-name` reads (get ns :name); that's overridden natively in ;; (get ns :name); that's overridden natively in post-prelude.ss (loads after
;; post-prelude.ss (loads after the overlay clobbers it). ;; the overlay clobbers it).
;; ;;
;; Loaded LAST from rt.ss. SCOPE (jolt-yxqm): the read/resolve/in-ns/*ns* ops. ;; Loaded LAST from rt.ss. The analyzer bakes a def's target ns at compile time,
;; use/require cross-ns SWITCHING is deferred (Phase 3) — the analyzer bakes a ;; so a runtime in-ns redirects only *ns* / str-of-ns, not later defs in the
;; def's target ns at compile time, so a runtime in-ns can't redirect later defs. ;; same program.
(define-record-type jns (fields name) (nongenerative chez-jns-v1)) (define-record-type jns (fields name) (nongenerative chez-jns-v1))
@ -24,11 +24,11 @@
(intern-ns! "user") (intern-ns! "user")
(intern-ns! "clojure.core") (intern-ns! "clojure.core")
;; --- namespace aliases (jolt-qjr0) ----------------------------------------- ;; --- namespace aliases ------------------------------------------------------
;; (require '[ns :as a]) registers a -> ns so the analyzer can resolve a/foo to ;; (require '[ns :as a]) registers a -> ns so the analyzer can resolve a/foo to
;; ns/foo. Keyed by (compile-ns . alias). On the zero-Janet spine the requires are ;; ns/foo. Keyed by (compile-ns . alias). The requires are pre-registered at
;; pre-registered at analyze time (compile-eval.ss) — analysis precedes eval, so a ;; analyze time (compile-eval.ss) — analysis precedes eval, so a runtime require
;; runtime require no-op is fine. Also drives jolt-ns-aliases below. ;; no-op is fine. Also drives jolt-ns-aliases below.
(define ns-alias-table (make-hashtable equal-hash equal?)) (define ns-alias-table (make-hashtable equal-hash equal?))
(define (chez-register-alias! cns alias target) (define (chez-register-alias! cns alias target)
(hashtable-set! ns-alias-table (cons cns alias) target)) (hashtable-set! ns-alias-table (cons cns alias) target))
@ -105,10 +105,10 @@
(define (jolt-create-ns desig) (intern-ns! (ns-desig->name desig))) (define (jolt-create-ns desig) (intern-ns! (ns-desig->name desig)))
;; in-ns: register + switch the current ns + re-bind *ns* + return the jns. NOTE ;; in-ns: register + switch the current ns + re-bind *ns* + return the jns. This
;; (Phase-3 deferral): this updates only the RUNTIME current ns — subsequent defs ;; updates only the RUNTIME current ns — subsequent defs in the same program were
;; in the same program were already ns-baked by the analyzer, so it does not ;; already ns-baked by the analyzer, so it does not redirect them. It is enough
;; redirect them. It is enough for *ns* / str-of-ns to track the switch. ;; for *ns* / str-of-ns to track the switch.
(define (jolt-in-ns desig) (define (jolt-in-ns desig)
(let* ((nm (ns-desig->name desig)) (n (intern-ns! nm))) (let* ((nm (ns-desig->name desig)) (n (intern-ns! nm)))
;; set the THREAD-LOCAL current ns; *ns* reads derive from it (dyn-binding.ss), ;; set the THREAD-LOCAL current ns; *ns* reads derive from it (dyn-binding.ss),
@ -140,7 +140,7 @@
m)) m))
(define (jolt-ns-publics desig) (ns-vars-pmap (ns-desig->name desig))) (define (jolt-ns-publics desig) (ns-vars-pmap (ns-desig->name desig)))
;; ns-aliases (jolt-cf1q.7): the {alias-sym -> ns-value} registered under `desig` ;; ns-aliases: the {alias-sym -> ns-value} registered under `desig`
;; (default the current ns) via require :as / alias. Reads ns-alias-table. ;; (default the current ns) via require :as / alias. Reads ns-alias-table.
(define (jolt-ns-aliases . desig) (define (jolt-ns-aliases . desig)
(let ((cns (if (pair? desig) (ns-desig->name (car desig)) (chez-current-ns))) (let ((cns (if (pair? desig) (ns-desig->name (car desig)) (chez-current-ns)))
@ -153,7 +153,7 @@
(hashtable-keys ns-alias-table)) (hashtable-keys ns-alias-table))
m)) m))
;; ns-refers (jolt-cf1q.7): the {sym -> var} referred into `desig` via refer/use. ;; ns-refers: the {sym -> var} referred into `desig` via refer/use.
(define (jolt-ns-refers desig) (define (jolt-ns-refers desig)
(let ((cns (ns-desig->name desig)) (m (jolt-hash-map))) (let ((cns (ns-desig->name desig)) (m (jolt-hash-map)))
(vector-for-each (vector-for-each
@ -225,7 +225,7 @@
(when c (var-cell-defined?-set! c #f) (var-cell-root-set! c jolt-unbound))) (when c (var-cell-defined?-set! c #f) (var-cell-root-set! c jolt-unbound)))
jolt-nil) jolt-nil)
;; --- ns runtime fns (jolt-cf1q.7) ------------------------------------------- ;; --- ns runtime fns ---------------------------------------------------------
;; ns-resolve: resolve `sym` as if reading it in namespace `ns-desig`. Qualified ;; ns-resolve: resolve `sym` as if reading it in namespace `ns-desig`. Qualified
;; syms consult that ns's :as aliases; unqualified resolve in the ns, its :refers, ;; syms consult that ns's :as aliases; unqualified resolve in the ns, its :refers,
;; then clojure.core. Returns the var or nil (never interns). ;; then clojure.core. Returns the var or nil (never interns).

View file

@ -1,4 +1,4 @@
;; png.ss (jolt-90sp) — jolt.png: a minimal PNG writer, the built-in the ;; png.ss — jolt.png: a minimal PNG writer, the built-in the
;; ray-tracer-multi example renders through. Truecolor (8-bit RGB), no ;; ray-tracer-multi example renders through. Truecolor (8-bit RGB), no
;; compression: the IDAT zlib stream uses DEFLATE "stored" (uncompressed) blocks, ;; compression: the IDAT zlib stream uses DEFLATE "stored" (uncompressed) blocks,
;; so there is no compressor to carry — just CRC-32 / Adler-32 framing over Chez ;; so there is no compressor to carry — just CRC-32 / Adler-32 framing over Chez

View file

@ -1,20 +1,16 @@
;; post-prelude overrides (jolt-9ziu) — loaded AFTER the assembled clojure.core ;; post-prelude overrides — loaded AFTER the assembled clojure.core
;; prelude, so these win over the overlay's own def-var!. ;; prelude, so these win over the overlay's own def-var!.
;; ;;
;; A few clojure.core predicates are implemented in the overlay by inspecting a ;; A few clojure.core predicates are implemented in the overlay by inspecting a
;; Janet-host tagged value's :jolt/type key (e.g. (get x :jolt/type)). That key ;; tagged value's :jolt/type key (e.g. (get x :jolt/type)). That key doesn't
;; doesn't exist for Chez-native representations: a jolt char is a Scheme char, ;; exist for native representations: a jolt char is a Scheme char, an atom is a
;; an atom is a Chez record. The overlay's def-var! loads after rt.ss, so it ;; Chez record. The overlay's def-var! loads after rt.ss, so it clobbers the
;; clobbers the correct native shims (predicates.ss / atoms.ss) with versions ;; correct native shims (predicates.ss / atoms.ss) with versions that return
;; that return false on every Chez value. Re-assert the native versions here. ;; false on every Chez value. Re-assert the native versions here.
;;
;; (Long-term these predicates want a host-neutral implementation that calls a
;; host primitive instead of reading :jolt/type; until then this is the Chez-host
;; override.)
(def-var! "clojure.core" "char?" jolt-char-pred?) (def-var! "clojure.core" "char?" jolt-char-pred?)
(def-var! "clojure.core" "atom?" jolt-atom?) (def-var! "clojure.core" "atom?" jolt-atom?)
;; atom watches/validators: the overlay drives these via jolt.host/ref-put! on a ;; atom watches/validators: the overlay drives these via jolt.host/ref-put! on a
;; Janet table (get a :watches), which a Chez atom record is not — re-assert the ;; tagged table (get a :watches), which a Chez atom record is not — re-assert the
;; native versions (defined in atoms.ss), and swap!/reset! notify+validate there. ;; native versions (defined in atoms.ss), and swap!/reset! notify+validate there.
(def-var! "clojure.core" "add-watch" jolt-add-watch) (def-var! "clojure.core" "add-watch" jolt-add-watch)
(def-var! "clojure.core" "remove-watch" jolt-remove-watch) (def-var! "clojure.core" "remove-watch" jolt-remove-watch)
@ -30,7 +26,7 @@
;; would wrongly report every var unbound. Native version (defined in vars.ss). ;; would wrongly report every var unbound. Native version (defined in vars.ss).
(def-var! "clojure.core" "bound?" jolt-bound?) (def-var! "clojure.core" "bound?" jolt-bound?)
;; uuid?/random-uuid/parse-uuid/tagged-literal? are overlay (read :jolt/type or ;; uuid?/random-uuid/parse-uuid/tagged-literal? are overlay (read :jolt/type or
;; build tagged tables) — re-assert the native versions (defined in natives-misc.ss). ;; build tagged tables) — re-assert the native versions (natives-misc.ss).
(def-var! "clojure.core" "uuid?" jolt-uuid-pred?) (def-var! "clojure.core" "uuid?" jolt-uuid-pred?)
(def-var! "clojure.core" "random-uuid" jolt-random-uuid) (def-var! "clojure.core" "random-uuid" jolt-random-uuid)
(def-var! "clojure.core" "parse-uuid" jolt-parse-uuid) (def-var! "clojure.core" "parse-uuid" jolt-parse-uuid)
@ -38,10 +34,10 @@
;; ns-name: the overlay reads (get ns :name) — nil on a jns namespace record. ;; ns-name: the overlay reads (get ns :name) — nil on a jns namespace record.
;; Native version (defined in ns.ss) returns the namespace's name symbol. ;; Native version (defined in ns.ss) returns the namespace's name symbol.
(def-var! "clojure.core" "ns-name" jolt-ns-name) (def-var! "clojure.core" "ns-name" jolt-ns-name)
;; concurrency (jolt-byjr): the overlay's future-done?/future-cancelled?/realized? ;; concurrency: the overlay's future-done?/future-cancelled?/realized? read a
;; read a Janet future-map's :cached/:cancelled keys, and promise/deliver are a ;; future-map's :cached/:cancelled keys, and promise/deliver are a non-blocking
;; non-blocking atom shim. A Chez future/promise is a record, and we want JVM ;; atom shim. A Chez future/promise is a record, and we want JVM (blocking,
;; (blocking, shared-heap) semantics — re-assert the native versions. realized? ;; shared-heap) semantics — re-assert the native versions. realized?
;; wraps the overlay (which still handles delay/lazy-seq/atom) for non-futures. ;; wraps the overlay (which still handles delay/lazy-seq/atom) for non-futures.
(def-var! "clojure.core" "future-done?" jolt-native-future-done?) (def-var! "clojure.core" "future-done?" jolt-native-future-done?)
(def-var! "clojure.core" "future-cancelled?" jolt-native-future-cancelled?) (def-var! "clojure.core" "future-cancelled?" jolt-native-future-cancelled?)
@ -68,8 +64,8 @@
;; realized? reads :jolt/type and throws on a jolt-lazyseq record. ;; realized? reads :jolt/type and throws on a jolt-lazyseq record.
((jolt-lazyseq? x) (jolt-lazyseq-realized? x)) ((jolt-lazyseq? x) (jolt-lazyseq-realized? x))
(else (jolt-invoke overlay-realized? x)))))) (else (jolt-invoke overlay-realized? x))))))
;; clojure.edn/read over a reader: the overlay edn.clj drain-reader uses janet/type; ;; clojure.edn/read over a reader: the overlay edn.clj drain-reader reads
;; the native Chez version (io.ss) drains the jhost reader instead (jolt-uicd/jolt-7t3l). ;; :jolt/type; the native version (io.ss) drains the jhost reader instead.
(def-var! "clojure.edn" "read" (def-var! "clojure.edn" "read"
(case-lambda (case-lambda
((reader) (chez-edn-read reader)) ((reader) (chez-edn-read reader))
@ -80,7 +76,7 @@
(def-var! "clojure.core" "line-seq" (def-var! "clojure.core" "line-seq"
(lambda (rdr) (lambda (rdr)
(if (reader-jhost? rdr) (chez-line-seq rdr) (jolt-invoke overlay-line-seq rdr))))) (if (reader-jhost? rdr) (chez-line-seq rdr) (jolt-invoke overlay-line-seq rdr)))))
;; JVM-parity numeric tower (jolt-n6al): the overlay (20-coll.clj) carries an ;; JVM-parity numeric tower: the overlay (20-coll.clj) carries an
;; all-flonum number-predicate web with no Ratio concept (ratio? -> false, ;; all-flonum number-predicate web with no Ratio concept (ratio? -> false,
;; double? -> not-integer, float? -> double?, rational? -> int?), which ;; double? -> not-integer, float? -> double?, rational? -> int?), which
;; misclassifies exact rationals on the Chez tower (e.g. (double? 1/2) -> true). ;; misclassifies exact rationals on the Chez tower (e.g. (double? 1/2) -> true).
@ -95,11 +91,11 @@
(def-var! "clojure.core" "decimal?" jolt-decimal?) (def-var! "clojure.core" "decimal?" jolt-decimal?)
(def-var! "clojure.core" "==" jolt-num-equiv) (def-var! "clojure.core" "==" jolt-num-equiv)
;; chunked-seq? is true for a vector's seq (a real chunked-seq); the overlay's ;; chunked-seq? is true for a vector's seq (a real chunked-seq); the overlay's
;; always-false stub loaded over the host fn, so re-assert it (jolt-hs5q). ;; always-false stub loaded over the host fn, so re-assert it.
(def-var! "clojure.core" "chunked-seq?" na-chunked-seq?) (def-var! "clojure.core" "chunked-seq?" na-chunked-seq?)
;; record? is a host type check (jrec?), not the overlay's (some? (get x ;; record? is a host type check (jrec?), not the overlay's (some? (get x
;; :jolt/deftype)) — the get-trick invokes a sorted-map's comparator on ;; :jolt/deftype)) — the get-trick invokes a sorted-map's comparator on
;; :jolt/deftype and throws (jolt-3bbj). Matches the JVM (instance? IRecord). ;; :jolt/deftype and throws. Matches the JVM (instance? IRecord).
(def-var! "clojure.core" "record?" (lambda (x) (jrec? x))) (def-var! "clojure.core" "record?" (lambda (x) (jrec? x)))
;; read / read+string over a HOST reader jhost (java.io StringReader/PushbackReader): ;; read / read+string over a HOST reader jhost (java.io StringReader/PushbackReader):

View file

@ -1,21 +1,19 @@
;; type predicates + simple accessors (jolt-9ziu) — host-coupled natives. ;; type predicates + simple accessors — host-coupled natives.
;; ;;
;; These are host 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. ;; def-var!'d by the assembled prelude; the Chez host must provide them.
;; map?/vector?/set? are STRICT ;; map?/vector?/set? are STRICT over the persistent-collection records, seq? is
;; over the persistent-collection records, seq? is true only for real sequences, ;; true only for real sequences, coll? is the union. Record arms are added by
;; coll? is the union. Records (shape-recs) are Phase 2, so the record arms of the ;; records.ss, which extends these dispatchers.
;; 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 ;; implements IPersistentVector, so (vector? (first {:a 1})) is true.
;; (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)))
;; (list? x): a list-marked cseq node or the empty list (). A lazy/vector-backed ;; (list? x): a list-marked cseq node or the empty list (). A lazy/vector-backed
;; seq, (rest list), (seq coll), (map …) are seqs but not lists (jolt-75sv). ;; seq, (rest list), (seq coll), (map …) are seqs but not lists.
(define (jolt-list-pred? x) (or (and (cseq? x) (cseq-list? x)) (empty-list-t? x))) (define (jolt-list-pred? x) (or (and (cseq? x) (cseq-list? x)) (empty-list-t? x)))
(define (jolt-coll-pred? x) (define (jolt-coll-pred? x)
(or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x))) (or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x)))

View file

@ -1,7 +1,6 @@
;; readable printer + output seams (jolt-cf1q.3 Phase 2 inc B) — the __pr-str1 / ;; readable printer + output seams — the __pr-str1 / __write / __with-out-str
;; __write / __with-out-str host seams the overlay's pr-str/pr/prn/print/println/ ;; host seams the overlay's pr-str/pr/prn/print/println/*-str family is built on
;; *-str family is built on (jolt-core/clojure/core/20-coll.clj). They resolved to ;; (jolt-core/clojure/core/20-coll.clj).
;; jolt-nil, so the whole print family hit the apply-jolt-nil crash bucket.
;; ;;
;; jolt-pr-str (rt.ss) is STR-style: strings render raw. pr-str needs READABLE ;; jolt-pr-str (rt.ss) is STR-style: strings render raw. pr-str needs READABLE
;; (pr) style: strings quoted+escaped at every nesting level. This adds the ;; (pr) style: strings quoted+escaped at every nesting level. This adds the

View file

@ -1,14 +1,12 @@
;; Chez-side Clojure data reader (jolt-r8ku, inc Y). ;; Chez-side Clojure data reader.
;; ;;
;; 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 jolt runtime values ;; ONE Clojure form off a string and produces jolt runtime values. Two host
;; (the analyzer/eval half — eval, load-string,
;; runtime defmacro — stays Phase-3, it needs the compiler at runtime). Two host
;; seams hang off it: ;; 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, stdlib/clojure/edn.clj).
;; ;;
;; Form shapes: ;; Form shapes:
;; sets -> {:jolt/type :jolt/set :value [...]} (a FORM, not a set) ;; sets -> {:jolt/type :jolt/set :value [...]} (a FORM, not a set)
@ -74,9 +72,6 @@
((char=? (string-ref str i) c) i) ((char=? (string-ref str i) c) i)
(else (loop (+ i 1))))))) (else (loop (+ i 1)))))))
;; jolt models EVERY number as a double (emit-const lowers integer literals to
;; flonums too), so the reader coerces every parsed number to inexact — else a
;; read int (exact) is not jolt= to a source int literal (flonum).
;; Numeric tower (JVM parity): integer literals read as exact integers (= Long/ ;; Numeric tower (JVM parity): integer literals read as exact integers (= Long/
;; BigInt, arbitrary precision), a/b ratios as exact rationals (= Ratio), and ;; BigInt, arbitrary precision), a/b ratios as exact rationals (= Ratio), and
;; decimal/exponent literals as flonums (= double). ;; decimal/exponent literals as flonums (= double).
@ -139,7 +134,7 @@
(let ((n (string->number (substring body 0 (- blen 1))))) (let ((n (string->number (substring body 0 (- blen 1)))))
(and n (integer? n) (* sign n)))) (and n (integer? n) (* sign n))))
;; bigdecimal suffix M -> a :bigdec form carrying the numeric text; the back ;; bigdecimal suffix M -> a :bigdec form carrying the numeric text; the back
;; end lowers it to a runtime jbigdec (jolt-i2jm). ;; end lowers it to a runtime jbigdec.
((and (> blen 1) (char=? (string-ref body (- blen 1)) #\M)) ((and (> blen 1) (char=? (string-ref body (- blen 1)) #\M))
(let ((n (string->number (substring body 0 (- blen 1))))) (let ((n (string->number (substring body 0 (- blen 1)))))
(and n (real? n) (and n (real? n)
@ -311,7 +306,7 @@
(else (jolt-list (jolt-symbol #f "with-meta") target meta)))) (else (jolt-list (jolt-symbol #f "with-meta") target meta))))
;; --- # dispatch ------------------------------------------------------------- ;; --- # dispatch -------------------------------------------------------------
;; #(...) anonymous fn shorthand (jolt-qjr0): % -> p1, %N -> pN, %& -> rest. The ;; #(...) anonymous fn shorthand: % -> 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. ;; as auto-gensyms.
@ -366,7 +361,7 @@
(if rest-sym (list (jolt-symbol #f "&") rest-sym) '())))) (if rest-sym (list (jolt-symbol #f "&") rest-sym) '()))))
(values (jolt-list (jolt-symbol #f "fn*") (apply jolt-vector params) body) j)))))) (values (jolt-list (jolt-symbol #f "fn*") (apply jolt-vector params) body) j))))))
;; reader conditionals (jolt-qjr0): jolt's feature set is {:jolt :clj :default}; ;; reader conditionals: jolt's feature set is {:jolt :clj :default};
;; the FIRST clause whose feature key is in the set wins (clause order, like ;; the FIRST clause whose feature key is in the set wins (clause order, like
;; Clojure). jolt is a Clojure/JVM-compatible host — it emulates clojure.lang.* ;; Clojure). jolt is a Clojure/JVM-compatible host — it emulates clojure.lang.*
;; and java.* interop — so it reads the :clj branch of a .cljc library (the JVM ;; and java.* interop — so it reads the :clj branch of a .cljc library (the JVM
@ -537,7 +532,7 @@
(jolt-vector form (substring s j end)))))) (jolt-vector form (substring s j end))))))
;; __read-tagged: apply a built-in data reader to an already-read form. The tag ;; __read-tagged: apply a built-in data reader to an already-read form. The tag
;; is the :#name keyword the reader produced; #uuid/#inst reuse the inc X ctors. ;; is the :#name keyword the reader produced; #uuid/#inst reuse the inst-time ctors.
(define (jolt-read-tagged tag form) (define (jolt-read-tagged tag form)
(cond (cond
((eq? tag (keyword #f "#uuid")) (jolt-uuid-from-string form)) ((eq? tag (keyword #f "#uuid")) (jolt-uuid-from-string form))

View file

@ -1,7 +1,5 @@
;; records + protocols (jolt-cf1q.3 Phase 2 inc D) — the deftype/defrecord + ;; records + protocols — the deftype/defrecord + defprotocol/extend-type
;; defprotocol/extend-type subsystem. These are ctx-capturing natives ;; subsystem.
;; that resolved to jolt-nil on the prelude, so every record
;; 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
;; declared field order. It is map?/coll?, equal to another jrec of the same tag ;; declared field order. It is map?/coll?, equal to another jrec of the same tag
@ -28,8 +26,8 @@
(define (jrec-has? r k) (define (jrec-has? r k)
(let loop ((ps (jrec-pairs r))) (let loop ((ps (jrec-pairs r)))
(cond ((null? ps) #f) ((jolt=2 (caar ps) k) #t) (else (loop (cdr ps)))))) (cond ((null? ps) #f) ((jolt=2 (caar ps) k) #t) (else (loop (cdr ps))))))
;; mutate a deftype's mutable field in place (jolt-c3q): the pairs are runtime ;; mutate a deftype's mutable field in place: the pairs are runtime cons cells,
;; cons cells, so set-cdr! updates the field. (set! field v) inside a method ;; so set-cdr! updates the field. (set! field v) inside a method
;; lowers to this; returns v, as set! does. ;; lowers to this; returns v, as set! does.
(define (jolt-set-field! inst k v) (define (jolt-set-field! inst k v)
(if (jrec? inst) (if (jrec? inst)
@ -97,8 +95,6 @@
(define %r-jolt-pr-readable jolt-pr-readable) (define %r-jolt-pr-readable jolt-pr-readable)
(set! jolt-pr-readable (lambda (x) (if (jrec? x) (jrec-pr x) (%r-jolt-pr-readable x)))) (set! jolt-pr-readable (lambda (x) (if (jrec? x) (jrec-pr x) (%r-jolt-pr-readable x))))
;; records are map? and coll? (Clojure: a record IS an associative map). Override
;; the public predicates to include jrec.
;; records are map? and coll? (Clojure: a record IS an associative map). The ;; records are map? and coll? (Clojure: a record IS an associative map). The
;; predicates.ss vars hold a snapshot, so re-def-var! after extending. record? is ;; predicates.ss vars hold a snapshot, so re-def-var! after extending. record? is
;; the overlay's (some? (get x :jolt/deftype)) — works for free since the get ;; the overlay's (some? (get x :jolt/deftype)) — works for free since the get
@ -244,7 +240,7 @@
;; protocol's extended impls over the reify's host tags ;; protocol's extended impls over the reify's host tags
;; (e.g. an Object/default extension). malli reifies some ;; (e.g. an Object/default extension). malli reifies some
;; protocols and relies on a protocol's default for the ;; protocols and relies on a protocol's default for the
;; rest (jolt-az9a). ;; rest.
(let loop ((tags (value-host-tags obj))) (let loop ((tags (value-host-tags obj)))
(cond ((null? tags) (error #f (string-append "No reified method " method-name))) (cond ((null? tags) (error #f (string-append "No reified method " method-name)))
((find-protocol-method (car tags) proto-name method-name) ((find-protocol-method (car tags) proto-name method-name)
@ -290,7 +286,7 @@
((reified-methods obj) ((reified-methods obj)
=> (lambda (rm) (let ((f (hashtable-ref rm method-name #f))) => (lambda (rm) (let ((f (hashtable-ref rm method-name #f)))
(if f (apply jolt-invoke f obj rest) (error #f (string-append "No method " method-name)))))) (if f (apply jolt-invoke f obj rest) (error #f (string-append "No method " method-name))))))
;; java.lang.String interop (jolt-nfca): defined in natives-str.ss, loaded ;; java.lang.String interop: defined in natives-str.ss, loaded
;; after this file (free reference, resolved at call time). ;; after this file (free reference, resolved at call time).
((string? obj) (jolt-string-method method-name obj rest)) ((string? obj) (jolt-string-method method-name obj rest))
((jiterator? obj) ((jiterator? obj)
@ -505,7 +501,7 @@
(let ((s (jrec-pr v))) (substring s 1 (string-length s))))) (let ((s (jrec-pr v))) (substring s 1 (string-length s)))))
(%r-str-render-one v)))) (%r-str-render-one v))))
;; `type` lives in natives-meta.ss (jolt-fmm4): it needs jolt-meta for the :type ;; `type` lives in natives-meta.ss: it needs jolt-meta for the :type
;; override and a total value->taxonomy mapping, so it sits with meta — a record ;; override and a total value->taxonomy mapping, so it sits with meta — a record
;; yields (jolt-symbol #f (jrec-tag x)), the ns.Name class-name symbol. ;; yields (jolt-symbol #f (jrec-tag x)), the ns.Name class-name symbol.

View file

@ -1,4 +1,4 @@
;; Phase 1 (jolt-cf1q.2) — regex on Chez via vendored irregex (jolt-i0s3). ;; regex on Chez via vendored irregex.
;; ;;
;; Chez has no regex at all. We vendor ;; Chez has no regex at all. 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
@ -33,7 +33,7 @@
(apply %chez-error args))) (apply %chez-error args)))
(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{...}: irregex's string syntax has no
;; \p{...}, so translate a fixed set of property names ;; \p{...}, so translate a fixed set of property names
;; to ASCII char classes before compiling. ASCII-only — \p{L} would need ;; to ASCII char classes before compiling. ASCII-only — \p{L} would need
;; UTF-8 high bytes counted as letters, which a Unicode-char Scheme string can't ;; UTF-8 high bytes counted as letters, which a Unicode-char Scheme string can't

View file

@ -1,4 +1,4 @@
;; Phase 1 (jolt-cf1q.2) — the minimal Chez RT the emitted Scheme rests on. ;; The minimal Chez RT the emitted Scheme rests on.
;; ;;
;; Sits above the value model (values.ss) and below an emitted program. Adds the ;; Sits above the value model (values.ss) and below an emitted program. Adds the
;; two things the back end's output references that aren't in the value layer: ;; two things the back end's output references that aren't in the value layer:
@ -20,7 +20,7 @@
;; 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 --------------------------------------------------------------
;; throw raises the jolt value RAW (no envelope); ;; throw raises the jolt value RAW (no envelope);
;; 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.
@ -50,7 +50,7 @@
jolt-kw-data jolt-nil jolt-kw-data jolt-nil
jolt-kw-cause (if (null? more) jolt-nil (car more)))) jolt-kw-cause (if (null? more) jolt-nil (car more))))
;; --- host interop (jolt-0kf5) ------------------------------------------------ ;; --- host interop ------------------------------------------------------------
;; (.method target arg*) lowers to (jolt-host-call "method" target arg*). JVM ;; (.method target arg*) lowers to (jolt-host-call "method" target arg*). JVM
;; interop has no general Chez analog, but the few methods jolt-core's io tier ;; interop has no general Chez analog, but the few methods jolt-core's io tier
;; calls map onto Chez equivalents: a writer's .write is a port display; a File's ;; calls map onto Chez equivalents: a writer's .write is a port display; a File's
@ -74,7 +74,7 @@
(define jolt-unbound (string->symbol "#<jolt-unbound>")) (define jolt-unbound (string->symbol "#<jolt-unbound>"))
;; `defined?` distinguishes a genuinely interned var (def / declare / a native-op ;; `defined?` distinguishes a genuinely interned var (def / declare / a native-op
;; cell) from a cell lazily materialised by a forward `var-deref` / `(var x)` on a ;; cell) from a cell lazily materialised by a forward `var-deref` / `(var x)` on a
;; not-yet-defined name — `resolve` returns the cell iff defined? (jolt-yxqm). ;; not-yet-defined name — `resolve` returns the cell iff defined?.
;; ns-unmap clears it. Avoids the (def x nil) edge of probing the root. ;; ns-unmap clears it. Avoids the (def x nil) edge of probing the root.
(define-record-type var-cell (fields ns name (mutable root) (mutable defined?)) (nongenerative var-cell-v2)) (define-record-type var-cell (fields ns name (mutable root) (mutable defined?)) (nongenerative var-cell-v2))
(define var-table (make-hashtable string-hash string=?)) (define var-table (make-hashtable string-hash string=?))
@ -93,7 +93,7 @@
;; (pr-str (def x 1)) is "#'ns/x". The prelude's def-var! forms discard the ;; (pr-str (def x 1)) is "#'ns/x". The prelude's def-var! forms discard the
;; return, so this is transparent there. ;; return, so this is transparent there.
(define (def-var! ns name v) (let ((c (jolt-var ns name))) (var-cell-root-set! c v) (var-cell-defined?-set! c #t) c)) (define (def-var! ns name v) (let ((c (jolt-var ns name))) (var-cell-root-set! c v) (var-cell-defined?-set! c #t) c))
;; var def-time metadata (jolt-zikh): the :def emit passes the def's reader meta ;; var def-time metadata: the :def emit passes the def's reader meta
;; (^:private / ^Type tag / docstring -> {:doc}) here, stored in an eq side-table ;; (^:private / ^Type tag / docstring -> {:doc}) here, stored in an eq side-table
;; keyed by the cell. jolt-meta (natives-meta.ss) merges it onto {:ns :name}, ;; keyed by the cell. jolt-meta (natives-meta.ss) merges it onto {:ns :name},
;; which it derives from the cell — so EVERY var (plain def, native-op, declare) ;; which it derives from the cell — so EVERY var (plain def, native-op, declare)
@ -103,7 +103,7 @@
(define jolt-kw-var-name (keyword #f "name")) (define jolt-kw-var-name (keyword #f "name"))
(define (def-var-with-meta! ns name v m) (define (def-var-with-meta! ns name v m)
(let ((c (def-var! ns name v))) (hashtable-set! var-meta-table c m) c)) (let ((c (def-var! ns name v))) (hashtable-set! var-meta-table c m) c))
;; runtime-macro registry (jolt-r9lm, inc6b): a var whose root holds a macro ;; runtime-macro registry: a var whose root holds a macro
;; expander fn is flagged here, so the ON-CHEZ analyzer's form-macro?/form-expand-1 ;; expander fn is flagged here, so the ON-CHEZ analyzer's form-macro?/form-expand-1
;; (host-contract.ss) expand it. The prelude emits each core/stdlib defmacro as a ;; (host-contract.ss) expand it. The prelude emits each core/stdlib defmacro as a
;; def-var! of its (cross-compiled) expander followed by (mark-macro! ns name). ;; def-var! of its (cross-compiled) expander followed by (mark-macro! ns name).
@ -124,17 +124,17 @@
(hashtable-set! var-table k c) (hashtable-set! var-table k c)
c)))) c))))
;; regex (jolt-i0s3): defines regex-t + the re-* fns (def-var!'d into ;; regex: defines regex-t + the re-* fns (def-var!'d into
;; clojure.core), so it loads after def-var! and before the printer below (which ;; clojure.core), so it loads after def-var! and before the printer below (which
;; renders a regex-t as #"source"). ;; renders a regex-t as #"source").
(load "host/chez/regex.ss") (load "host/chez/regex.ss")
;; atoms (jolt-9ziu): host-coupled mutable cells; def-var!'d into clojure.core ;; atoms: host-coupled mutable cells; def-var!'d into clojure.core
;; (atom/deref/swap!/reset! + the compare/vals kernel). Loads after def-var! and ;; (atom/deref/swap!/reset! + the compare/vals kernel). Loads after def-var! and
;; jolt-invoke (seq.ss) / jolt= (values.ss) / jolt-vector (collections.ss). ;; jolt-invoke (seq.ss) / jolt= (values.ss) / jolt-vector (collections.ss).
(load "host/chez/atoms.ss") (load "host/chez/atoms.ss")
;; type predicates + simple accessors (jolt-9ziu): seed natives the overlay ;; type predicates + simple accessors: seed natives the overlay
;; assumes (map?/vector?/nil?/number?/.../name/namespace), def-var!'d into ;; assumes (map?/vector?/nil?/number?/.../name/namespace), def-var!'d into
;; clojure.core. Loads after the value-model record predicates they wrap. ;; clojure.core. Loads after the value-model record predicates they wrap.
(load "host/chez/predicates.ss") (load "host/chez/predicates.ss")
@ -158,7 +158,6 @@
;; 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 is not a stable insertion 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.
(define (jolt-str-join strs) (define (jolt-str-join strs)
(cond ((null? strs) "") ((null? (cdr strs)) (car strs)) (cond ((null? strs) "") ((null? (cdr strs)) (car strs))
(else (string-append (car strs) " " (jolt-str-join (cdr strs)))))) (else (string-append (car strs) " " (jolt-str-join (cdr strs))))))
@ -197,174 +196,174 @@
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")")) (loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")"))
(else (format "~a" x)))) (else (format "~a" x))))
;; converters + string ops (jolt-t6cr): str/subs/vec/keyword/symbol/compare/int/ ;; converters + string ops: str/subs/vec/keyword/symbol/compare/int/
;; double/gensym — host-coupled seed natives def-var!'d into clojure.core. Loaded ;; double/gensym — host-coupled seed natives def-var!'d into clojure.core. Loaded
;; LAST because `str` reuses jolt-pr-str (defined just above). ;; LAST because `str` reuses jolt-pr-str (defined just above).
(load "host/chez/converters.ss") (load "host/chez/converters.ss")
;; transients (jolt-kl2l): copy-on-write transient collections + persistent disj; ;; transients: copy-on-write transient collections + persistent disj;
;; extends get/count/contains? to see through a transient. After collections.ss ;; extends get/count/contains? to see through a transient. After collections.ss
;; (the persistent ops it delegates to). ;; (the persistent ops it delegates to).
(load "host/chez/transients.ss") (load "host/chez/transients.ss")
;; seq-native shims (jolt-y6mv): mapcat/take-while/drop-while/partition/sort + ;; seq-native shims: mapcat/take-while/drop-while/partition/sort +
;; reduced/reduced?/identical? — seed-native fns the overlay assumes are core ;; reduced/reduced?/identical? — seed-native fns the overlay assumes are core
;; natives. Over the seq layer + jolt-compare, so loaded after converters.ss. ;; natives. Over the seq layer + jolt-compare, so loaded after converters.ss.
(load "host/chez/natives-seq.ss") (load "host/chez/natives-seq.ss")
;; readable printer + output seams (jolt-9zhh, Phase 2 inc B): __pr-str1/__write/ ;; readable printer + output seams: __pr-str1/__write/
;; __with-out-str/__eprint/__eprintf — the host seams the overlay print family ;; __with-out-str/__eprint/__eprintf — the host seams the overlay print family
;; (pr-str/pr/prn/print/println/*-str) is built on. After converters.ss (uses ;; (pr-str/pr/prn/print/println/*-str) is built on. After converters.ss (uses
;; jolt-pr-str/jolt-str-join) + seq.ss (jolt-invoke). ;; jolt-pr-str/jolt-str-join) + seq.ss (jolt-invoke).
(load "host/chez/printing.ss") (load "host/chez/printing.ss")
;; collection constructors + rand (jolt-agw6, Phase 2 inc A): bind the public ;; collection constructors + rand: bind the public
;; clojure.core names hash-map/hash-set/array-map/set/rand to the existing ;; clojure.core names hash-map/hash-set/array-map/set/rand to the existing
;; pmap/pset ctors. After collections.ss (the ctors) + seq.ss (seq->list). ;; pmap/pset ctors. After collections.ss (the ctors) + seq.ss (seq->list).
(load "host/chez/natives-coll.ss") (load "host/chez/natives-coll.ss")
;; bit ops + parse-long/parse-double (jolt-cf1q.3 inc C): host-coupled scalar ;; bit ops + parse-long/parse-double: host-coupled scalar
;; seed natives over the all-flonum number model. ;; seed natives over the all-flonum number model.
(load "host/chez/natives-num.ss") (load "host/chez/natives-num.ss")
;; multimethods (jolt-9ls5): defmulti/defmethod dispatch runtime. Needs jolt-invoke ;; multimethods: defmulti/defmethod dispatch runtime. Needs jolt-invoke
;; (seq.ss), jolt=/key-hash/jolt-hash-map (collections.ss), jolt-atom? (atoms.ss), ;; (seq.ss), jolt=/key-hash/jolt-hash-map (collections.ss), jolt-atom? (atoms.ss),
;; jolt-pr-str (above), and the var-cell machinery — so loaded last. ;; jolt-pr-str (above), and the var-cell machinery — so loaded last.
(load "host/chez/multimethods.ss") (load "host/chez/multimethods.ss")
;; records + protocols (jolt-jgoc, Phase 2 inc D): defrecord/deftype/defprotocol/ ;; records + protocols: defrecord/deftype/defprotocol/
;; extend-type/reify. A jrec record type set!-extended into the collection ;; extend-type/reify. A jrec record type set!-extended into the collection
;; dispatchers + a protocol registry. After multimethods.ss (chez-current-ns) and ;; dispatchers + a protocol registry. After multimethods.ss (chez-current-ns) and
;; the dispatchers/printers it wraps (collections/seq/values/converters/printing/ ;; the dispatchers/printers it wraps (collections/seq/values/converters/printing/
;; transients). ;; transients).
(load "host/chez/records.ss") (load "host/chez/records.ss")
;; metadata (jolt-rkbc, Phase 2 inc E): meta / with-meta over an identity-keyed ;; metadata: meta / with-meta over an identity-keyed
;; side-table. After records.ss (jrec) + the collection ctors it copies. ;; side-table. After records.ss (jrec) + the collection ctors it copies.
(load "host/chez/natives-meta.ss") (load "host/chez/natives-meta.ss")
;; host class tokens (jolt-13zk): bare class names (String/Keyword/File...) -> ;; host class tokens: bare class names (String/Keyword/File...) ->
;; canonical JVM class-name strings + (class x). After natives-meta.ss (jolt-type) ;; canonical JVM class-name strings + (class x). After natives-meta.ss (jolt-type)
;; 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 host ;; dynamic vars: *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")
;; host tables + sorted collections (jolt-0zoy, Phase 2): jolt.host/tagged-table/ ;; host tables + sorted collections: jolt.host/tagged-table/
;; ref-put!/ref-get + the 25-sorted tier's runtime (sorted-map/sorted-set routed ;; ref-put!/ref-get + the 25-sorted tier's runtime (sorted-map/sorted-set routed
;; through their :ops table). Loaded LAST — wraps the jrec-extended dispatchers ;; through their :ops table). Loaded LAST — wraps the jrec-extended dispatchers
;; (records.ss), jolt-disj (transients.ss), and value-host-tags (records.ss). ;; (records.ss), jolt-disj (transients.ss), and value-host-tags (records.ss).
(load "host/chez/host-table.ss") (load "host/chez/host-table.ss")
;; lazy-seq bridge (jolt-dmw9, Phase 2): make-lazy-seq / coll->cells over the ;; lazy-seq bridge: make-lazy-seq / coll->cells over the
;; cseq model — unblocks every overlay fn built on the lazy-seq macro (repeat/ ;; cseq model — unblocks every overlay fn built on the lazy-seq macro (repeat/
;; iterate/cycle/dedupe/take-nth/keep/interpose/reductions/tree-seq/lazy-cat). ;; iterate/cycle/dedupe/take-nth/keep/interpose/reductions/tree-seq/lazy-cat).
;; Loaded LAST so %ls-seq captures the fully-extended (sorted-aware) jolt-seq. ;; Loaded LAST so %ls-seq captures the fully-extended (sorted-aware) jolt-seq.
(load "host/chez/lazy-bridge.ss") (load "host/chez/lazy-bridge.ss")
;; volatiles + sequence / transduce (jolt-xjx6, Phase 2): native volatile boxes + ;; volatiles + sequence / transduce: native volatile boxes +
;; the transduce/sequence entry points over into-xform/reduce-seq. After ;; the transduce/sequence entry points over into-xform/reduce-seq. After
;; natives-seq.ss (into-xform), seq.ss (reduce-seq) + atoms.ss (deref). ;; natives-seq.ss (into-xform), seq.ss (reduce-seq) + atoms.ss (deref).
(load "host/chez/natives-xform.ss") (load "host/chez/natives-xform.ss")
;; vars as first-class objects (jolt-n7rz, Phase 2): var?/var-get/deref/invoke/=/ ;; vars as first-class objects: var?/var-get/deref/invoke/=/
;; pr-str over the rt.ss var-cell. After natives-xform.ss (chains deref) + the ;; pr-str over the rt.ss var-cell. After natives-xform.ss (chains deref) + the
;; printers. emit lowers :the-var to (jolt-var ns name). ;; printers. emit lowers :the-var to (jolt-var ns name).
(load "host/chez/vars.ss") (load "host/chez/vars.ss")
;; misc scalar natives (jolt-cf1q.3): UUID (random-uuid/parse-uuid/uuid?), format/ ;; misc scalar natives: UUID (random-uuid/parse-uuid/uuid?), format/
;; printf, tagged-literal, bigint. After the printers + converters (str/pr-str of ;; printf, tagged-literal, bigint. After the printers + converters (str/pr-str of
;; a uuid). Overlay names (uuid?/random-uuid/parse-uuid/tagged-literal?) re-asserted ;; a uuid). Overlay names (uuid?/random-uuid/parse-uuid/tagged-literal?) re-asserted
;; in post-prelude.ss. ;; in post-prelude.ss.
(load "host/chez/natives-misc.ss") (load "host/chez/natives-misc.ss")
;; namespaces (jolt-yxqm, Phase 2): the namespace value model — find-ns/ns-name/ ;; namespaces: the namespace value model — find-ns/ns-name/
;; all-ns/the-ns/create-ns/in-ns/ns-publics/ns-map/ns-interns/ns-aliases/resolve/ ;; all-ns/the-ns/create-ns/in-ns/ns-publics/ns-map/ns-interns/ns-aliases/resolve/
;; find-var/ns-unmap/*ns*, over the var-table + chez-current-ns. Loaded LAST: needs ;; find-var/ns-unmap/*ns*, over the var-table + chez-current-ns. Loaded LAST: needs
;; var-cell + var-cell-defined?, jolt-symbol/jolt-hash-map/jolt-assoc, chez-current-ns ;; var-cell + var-cell-defined?, jolt-symbol/jolt-hash-map/jolt-assoc, chez-current-ns
;; (multimethods.ss), list->cseq (seq.ss), and the fully-patched printers (vars.ss). ;; (multimethods.ss), list->cseq (seq.ss), and the fully-patched printers (vars.ss).
(load "host/chez/ns.ss") (load "host/chez/ns.ss")
;; dynamic var binding (jolt-2o7x, Phase 2): the per-thread binding stack + ;; dynamic var binding: the per-thread binding stack +
;; push/pop/get-thread-bindings/__thread-bound?/var-set/alter-var-root/__local-var. ;; push/pop/get-thread-bindings/__thread-bound?/var-set/alter-var-root/__local-var.
;; Chains var-deref (rt.ss) and jolt-var-get (vars.ss) onto the stack, so a `binding` ;; Chains var-deref (rt.ss) and jolt-var-get (vars.ss) onto the stack, so a `binding`
;; frame is seen by every var read. Loaded LAST: needs the fully-extended var-read ;; frame is seen by every var read. Loaded LAST: needs the fully-extended var-read
;; paths + jolt-hash-map/pmap-fold/pmap-assoc (collections.ss). ;; paths + jolt-hash-map/pmap-fold/pmap-assoc (collections.ss).
(load "host/chez/dyn-binding.ss") (load "host/chez/dyn-binding.ss")
;; java.lang.String method interop (jolt-nfca, Phase 2): jolt-string-method, the ;; java.lang.String method interop: jolt-string-method, the
;; portable String/CharSequence surface record-method-dispatch falls through to on ;; portable String/CharSequence surface record-method-dispatch falls through to on
;; a string target. After regex.ss (jolt-re-pattern/regex-t-irx) + records.ss ;; a string target. After regex.ss (jolt-re-pattern/regex-t-irx) + records.ss
;; (which references jolt-string-method). ;; (which references jolt-string-method).
(load "host/chez/natives-str.ss") (load "host/chez/natives-str.ss")
;; host class statics + constructors (jolt-avt6, Phase 2): host-static-ref/ ;; host class statics + constructors: host-static-ref/
;; host-static-call/host-new + the jhost method registry. Loads LAST — it extends ;; host-static-call/host-new + the jhost method registry. Loads LAST — it extends
;; record-method-dispatch (records.ss) and reuses natives-str helpers (str-trim, ;; record-method-dispatch (records.ss) and reuses natives-str helpers (str-trim,
;; ascii-string-down, re-split, str-split-drop-trailing) + the regex-t accessors. ;; ascii-string-down, re-split, str-split-drop-trailing) + the regex-t accessors.
(load "host/chez/host-static.ss") (load "host/chez/host-static.ss")
;; generic dot-form dispatch (jolt-kuic): field access + map/vector member access ;; generic dot-form dispatch: field access + map/vector member access
;; for the `.` / `.-field` desugar. Loads after host-static.ss so it wraps every ;; for the `.` / `.-field` desugar. Loads after host-static.ss so it wraps every
;; record-method-dispatch arm (jhost/number/regex/jrec/string) and falls through. ;; record-method-dispatch arm (jhost/number/regex/jrec/string) and falls through.
(load "host/chez/dot-forms.ss") (load "host/chez/dot-forms.ss")
;; java.io.File + host file I/O (jolt-yyud): path-backed jfile record, slurp/spit/ ;; java.io.File + host file I/O: path-backed jfile record, slurp/spit/
;; flush, file-seq dir primitives, clojure.java.io/file. Loads LAST so its jfile ;; flush, file-seq dir primitives, clojure.java.io/file. Loads LAST so its jfile
;; arm wraps the fully-built record-method-dispatch and the str/type/instance-check ;; arm wraps the fully-built record-method-dispatch and the str/type/instance-check
;; extensions sit over every prior shim. ;; extensions sit over every prior shim.
(load "host/chez/io.ss") (load "host/chez/io.ss")
;; #inst values + java.time formatting (jolt-at0a inc X): jinst (RFC3339 ms) + ;; #inst values + java.time formatting: jinst (RFC3339 ms) +
;; DateTimeFormatter/Instant/ZoneId/LocalDateTime/FormatStyle/Locale/Date. Loads ;; DateTimeFormatter/Instant/ZoneId/LocalDateTime/FormatStyle/Locale/Date. Loads
;; LAST — it extends record-method-dispatch / jolt-get / jolt= / jolt-hash / ;; LAST — it extends record-method-dispatch / jolt-get / jolt= / jolt-hash /
;; jolt-pr-str / jolt-type / instance-check and uses host-static.ss's registries. ;; jolt-pr-str / jolt-type / instance-check and uses host-static.ss's registries.
(load "host/chez/inst-time.ss") (load "host/chez/inst-time.ss")
;; Chez-side data reader (jolt-r8ku inc Y): read-string / __parse-next / ;; Chez-side data reader: read-string / __parse-next /
;; __read-tagged. Loads after inst-time.ss — __read-tagged reuses its #uuid/#inst ;; __read-tagged. Loads after inst-time.ss — __read-tagged reuses its #uuid/#inst
;; constructors, and the reader needs the full value/collection layer above. ;; constructors, and the reader needs the full value/collection layer above.
(load "host/chez/reader.ss") (load "host/chez/reader.ss")
;; clojure.math (jolt-22vo): native flonum-math shims def-var!'d into the ;; clojure.math: native flonum-math shims def-var!'d into the
;; clojure.math ns. Self-contained (only def-var! + Chez math), order-independent. ;; clojure.math ns. Self-contained (only def-var! + Chez math), order-independent.
(load "host/chez/math.ss") (load "host/chez/math.ss")
;; parity shims (jolt-cf1q.7): native clojure.core fns missing on the zero-Janet ;; parity shims: native clojure.core fns not covered by the overlay
;; spine (hash family / rseq / cat / transient?). After host-table.ss (sorted), ;; (hash family / rseq / cat / transient?). After host-table.ss (sorted),
;; transients.ss, values.ss (jolt-hash), seq.ss. ;; transients.ss, values.ss (jolt-hash), seq.ss.
(load "host/chez/natives-parity.ss") (load "host/chez/natives-parity.ss")
;; Java-style arrays (jolt-cf1q.7): object/typed array constructors + a jolt-array ;; Java-style arrays: object/typed array constructors + a jolt-array
;; backing; extends count/nth/seq/get/ref-put! so the overlay aget/aset/alength see ;; backing; extends count/nth/seq/get/ref-put! so the overlay aget/aset/alength see
;; it. After the dispatchers it chains. ;; it. After the dispatchers it chains.
(load "host/chez/natives-array.ss") (load "host/chez/natives-array.ss")
;; clojure.lang.PersistentQueue (jolt-b8he): a functional queue + EMPTY static. ;; clojure.lang.PersistentQueue: a functional queue + EMPTY static.
;; Chains seq/count/empty?/peek/pop/conj/sequential?/class/instance?/printer, so ;; Chains seq/count/empty?/peek/pop/conj/sequential?/class/instance?/printer, so
;; load after natives-array (the dispatchers it extends). ;; load after natives-array (the dispatchers it extends).
(load "host/chez/natives-queue.ss") (load "host/chez/natives-queue.ss")
;; syntax-quote form builders (jolt-r9lm, inc6b): __sqcat/__sqvec/__sqmap/__sqset/ ;; syntax-quote form builders: __sqcat/__sqvec/__sqmap/__sqset/
;; __sq1, def-var!'d into clojure.core. A cross-compiled macro expander (analyzer ;; __sq1, def-var!'d into clojure.core. A cross-compiled macro expander (analyzer
;; on Chez, inc6b) calls these to build its expansion as reader forms. Needs the ;; on Chez) calls these to build its expansion as reader forms. Needs the
;; collection/seq layer + def-var!; order-independent past those. ;; collection/seq layer + def-var!; order-independent past those.
(load "host/chez/syntax-quote.ss") (load "host/chez/syntax-quote.ss")
;; concurrency (jolt-byjr): real OS-thread futures + blocking promises, shared-heap ;; concurrency: real OS-thread futures + blocking promises, shared-heap
;; (JVM) semantics. Loaded LAST — chains the fully-built jolt-deref and conveys the ;; (JVM) semantics. Loaded LAST — chains the fully-built jolt-deref and conveys the
;; thread-local binding stack (dyn-binding.ss) into workers. pmap/pcalls/pvalues ;; thread-local binding stack (dyn-binding.ss) into workers. pmap/pcalls/pvalues
;; (overlay, over `future`) light up once future-call exists here. ;; (overlay, over `future`) light up once future-call exists here.
(load "host/chez/concurrency.ss") (load "host/chez/concurrency.ss")
;; clojure.core.async (jolt-byjr): real-thread blocking channels + go/go-loop/ ;; clojure.core.async: real-thread blocking channels + go/go-loop/
;; thread macros, def-var!'d into clojure.core.async. After concurrency.ss (reuses ;; thread macros, def-var!'d into clojure.core.async. After concurrency.ss (reuses
;; ms->duration) and the collection/seq layer. ;; ms->duration) and the collection/seq layer.
(load "host/chez/async.ss") (load "host/chez/async.ss")
;; BigDecimal (jolt-i2jm): the jbigdec value type + bigdec/decimal?/class/equality/ ;; BigDecimal: the jbigdec value type + bigdec/decimal?/class/equality/
;; printing. Loads LAST so its set!-wraps of jolt-class/jolt=2/the printers sit ;; printing. Loads LAST so its set!-wraps of jolt-class/jolt=2/the printers sit
;; outermost over every earlier extension. ;; outermost over every earlier extension.
(load "host/chez/bigdec.ss") (load "host/chez/bigdec.ss")

View file

@ -1,7 +1,7 @@
;; run-corpus.ss — the standing correctness gate, pure Chez. NO Janet. ;; run-corpus.ss — the standing correctness gate.
;; ;;
;; Loads the checked-in seed (host/chez/seed/{prelude,image}.ss) + the zero-Janet ;; Loads the checked-in seed (host/chez/seed/{prelude,image}.ss) + the spine,
;; spine, reads test/chez/corpus.edn, and for each row evaluates :actual and ;; reads test/chez/corpus.edn, and for each row evaluates :actual and
;; :expected through jolt-compile-eval and compares by value-equality (jolt=). The ;; :expected through jolt-compile-eval and compares by value-equality (jolt=). The
;; corpus :expected is JVM-sourced (test/conformance/regen-corpus.clj), so this ;; corpus :expected is JVM-sourced (test/conformance/regen-corpus.clj), so this
;; measures jolt-on-Chez against reference Clojure. ;; measures jolt-on-Chez against reference Clojure.
@ -170,7 +170,7 @@
(define n-eval (+ pass (length crashes) (length diverged) (length known-hit))) (define n-eval (+ pass (length crashes) (length diverged) (length known-hit)))
(define secs (let ((d (time-difference (current-time) t0))) (define secs (let ((d (time-difference (current-time) t0)))
(+ (time-second d) (/ (time-nanosecond d) 1e9)))) (+ (time-second d) (/ (time-nanosecond d) 1e9))))
(printf "\nZero-Janet corpus parity: ~a/~a evaluated cases pass (~as)\n" (printf "\nCorpus parity: ~a/~a evaluated cases pass (~as)\n"
pass n-eval (/ (round (* secs 10)) 10.0)) pass n-eval (/ (round (* secs 10)) 10.0))
(printf " crash: ~a NEW divergence: ~a known: ~a (throws skipped: ~a)\n" (printf " crash: ~a NEW divergence: ~a known: ~a (throws skipped: ~a)\n"
(length crashes) (length diverged) (length known-hit) throws) (length crashes) (length diverged) (length known-hit) throws)

View file

@ -1,6 +1,6 @@
;; run-sci.ss — SCI conformance: load borkdude/sci's own source (vendor/sci) through ;; run-sci.ss — SCI conformance: load borkdude/sci's own source (vendor/sci) through
;; joltc and require its forms to compile+eval. A real-world Clojure-compatibility ;; joltc and require its forms to compile+eval. A real-world Clojure-compatibility
;; stress test. Pure Chez, no Janet. Floor-gated like the corpus: a regression below ;; stress test. Floor-gated like the corpus: a regression below
;; the floor (or the count today, 205/218) fails. Raise the floor as host gaps close ;; the floor (or the count today, 205/218) fails. Raise the floor as host gaps close
;; (the tail is genuine gaps — set! on vars, some macro/def shapes). ;; (the tail is genuine gaps — set! on vars, some macro/def shapes).
;; ;;
@ -54,7 +54,7 @@
(define verbose (and (getenv "SCI_VERBOSE") #t)) (define verbose (and (getenv "SCI_VERBOSE") #t))
;; stubs first (host shims SCI's source expects) ;; stubs first (host shims SCI's source expects)
(for-each (lambda (f) (load-forms (string-append "src/jolt/clojure/sci/" f) verbose)) (for-each (lambda (f) (load-forms (string-append "stdlib/clojure/sci/" f) verbose))
'("lang_stubs.clj" "io_stubs.clj" "host_stubs.clj")) '("lang_stubs.clj" "io_stubs.clj" "host_stubs.clj"))
(define sci-base "vendor/sci/src/sci/") (define sci-base "vendor/sci/src/sci/")

View file

@ -1,4 +1,4 @@
;; run-unit.ss — host-specific unit gate, pure Chez. NO Janet. ;; run-unit.ss — host-specific unit gate.
;; ;;
;; Loads the checked-in seed + spine, reads test/chez/unit.edn, and for each case ;; Loads the checked-in seed + spine, reads test/chez/unit.edn, and for each case
;; evaluates :expr (wrapped in (do ...), as `joltc -e` does) and compares its PRINTED ;; evaluates :expr (wrapped in (do ...), as `joltc -e` does) and compares its PRINTED

View file

@ -1,4 +1,4 @@
;; Phase 1 (jolt-cf1q.2, inc 3b) — the seq tier on the Chez RT. ;; The seq tier on the Chez RT.
;; ;;
;; One lazy-capable node (cseq) models Clojure's list, cons, and lazy seq — all ;; One lazy-capable node (cseq) models Clojure's list, cons, and lazy seq — all
;; print as (...), all sequential-= to each other AND to vectors. `jolt-seq` ;; print as (...), all sequential-= to each other AND to vectors. `jolt-seq`
@ -21,13 +21,13 @@
;; list? : #t when this cell is a PersistentList node (list literal / (list ...) ;; list? : #t when this cell is a PersistentList node (list literal / (list ...)
;; / cons / reverse / conj-onto-list) vs a lazy or vector-backed seq cell — the ;; / cons / reverse / conj-onto-list) vs a lazy or vector-backed seq cell — the
;; 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?). 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?. ;; cells and are not list?.
;; cvec/ci: for a vector-backed seq cell, the backing vector and this cell's ;; cvec/ci: for a vector-backed seq cell, the backing vector and this cell's
;; element index — so it is a real chunked-seq (chunked-seq? true, chunk-first ;; element index — so it is a real chunked-seq (chunked-seq? true, chunk-first
;; hands out a 32-element block, chunk-rest is the seq at the next block) and ;; hands out a 32-element block, chunk-rest is the seq at the next block) and
;; reduce iterates the vector directly with no per-element cells (jolt-hs5q). ;; reduce iterates the vector directly with no per-element cells.
;; cvec is #f for every other seq; stored as two fields (not a cons) so a vector ;; cvec is #f for every other seq; stored as two fields (not a cons) so a vector
;; seq cell costs no extra allocation. The rest of the seq layer ignores them, so ;; seq cell costs no extra allocation. The rest of the seq layer ignores them, so
;; first/rest/count/printing are unchanged. ;; first/rest/count/printing are unchanged.
@ -45,7 +45,7 @@
(define-record-type empty-list-t (fields) (nongenerative empty-list-v1)) (define-record-type empty-list-t (fields) (nongenerative empty-list-v1))
(define jolt-empty-list (make-empty-list-t)) (define jolt-empty-list (make-empty-list-t))
;; reduced (jolt-y6mv): a box a reducing fn returns to stop reduce early. The ;; reduced: a box a reducing fn returns to stop reduce early. The
;; reduce machinery below unwraps it; (deref a-reduced) / unreduced also read it. ;; reduce machinery below unwraps it; (deref a-reduced) / unreduced also read it.
;; reduced?/reduced are def-var!'d into clojure.core in natives-seq.ss. ;; reduced?/reduced are def-var!'d into clojure.core in natives-seq.ss.
(define-record-type jolt-reduced (fields val) (nongenerative jolt-reduced-v1)) (define-record-type jolt-reduced (fields val) (nongenerative jolt-reduced-v1))
@ -213,7 +213,7 @@
(if (if (> step 0.0) (< n end) (> n end)) (if (if (> step 0.0) (< n end) (> n end))
(cseq-lazy n (lambda () (range-bounded (+ n step) end step))) (cseq-lazy n (lambda () (range-bounded (+ n step) end step)))
jolt-nil)) jolt-nil))
;; numeric tower (jolt-n6al): exact 0/1 defaults so (range 3) yields exact ints ;; numeric tower: exact 0/1 defaults so (range 3) yields exact ints
;; (= JVM longs); flonum args still produce flonums (Scheme arithmetic preserves). ;; (= JVM longs); flonum args still produce flonums (Scheme arithmetic preserves).
(define jolt-range (define jolt-range
(case-lambda (case-lambda

View file

@ -1,8 +1,8 @@
;; syntax-quote form builders (jolt-r9lm, inc6b). A macro expander whose body was a ;; syntax-quote form builders. A macro expander whose body was a syntax-quote
;; syntax-quote template (lowered by jolt.host/form-syntax-quote-lower) calls these ;; template (lowered by jolt.host/form-syntax-quote-lower) calls these at RUNTIME
;; at RUNTIME on Chez to build the EXPANSION as ;; to build the EXPANSION as READER forms (cseq list / pvec / pmap / tagged-set
;; Chez READER forms (cseq list / pvec / pmap / tagged-set pmap) so the on-Chez ;; pmap) so the on-Chez analyzer can re-analyze it. def-var!'d into clojure.core,
;; analyzer can re-analyze it. def-var!'d into clojure.core, so the lowered body's ;; 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
;; in prelude mode) resolve here. ;; in prelude mode) resolve here.
;; ;;
@ -36,7 +36,7 @@
;; pmap that __sqcat/__sqvec/__sqmap build double as their own form rep — but a set ;; pmap that __sqcat/__sqvec/__sqmap build double as their own form rep — but a set
;; value (pset) differs from the reader's set FORM ({:jolt/type :jolt/set :value ;; value (pset) differs from the reader's set FORM ({:jolt/type :jolt/set :value
;; <pvec>}), so building the tagged form here would make a runtime `#{~@xs} a map, ;; <pvec>}), so building the tagged form here would make a runtime `#{~@xs} a map,
;; not a set (jolt-r9lm regression). Build the value; the analyzer's form-set? ;; not a set. Build the value; the analyzer's form-set?
;; (host-contract.ss) additionally recognizes a pset, so a macro template's #{...} ;; (host-contract.ss) additionally recognizes a pset, so a macro template's #{...}
;; expansion still re-analyzes as a set literal. ;; expansion still re-analyzes as a set literal.
(define (jolt-sqset . parts) (apply jolt-hash-set (sq-flatten parts))) (define (jolt-sqset . parts) (apply jolt-hash-set (sq-flatten parts)))

View file

@ -1,13 +1,12 @@
;; transients (jolt-kl2l) — mutable backing per collection kind, snapshotted to ;; transients — mutable backing per collection kind, snapshotted to the immutable
;; the immutable collection on persistent!. A faithful port of the Janet host's ;; collection on persistent!. conj!/assoc!/dissoc!/disj!/pop! mutate in place
;; mutable transients: conj!/assoc!/dissoc!/disj!/pop! mutate in place (amortized ;; (amortized O(1)); persistent! converts back to a pvec / pmap / pset once.
;; O(1)); persistent! converts back to a pvec / pmap / pset once.
;; ;;
;; vec : a growable Scheme vector (capacity) + a fill count `n`. conj!/pop! are ;; vec : a growable Scheme vector (capacity) + a fill count `n`. conj!/pop! are
;; O(1) amortized — the old copy-on-write rebuilt the whole vector per op, ;; O(1) amortized — the old copy-on-write rebuilt the whole vector per op,
;; so building an N-vector was O(N^2). ;; so building an N-vector was O(N^2).
;; map : a Chez hashtable keyed by key-hash / jolt= (value-equality, nil-safe — ;; map : a Chez hashtable keyed by key-hash / jolt= (value-equality, nil-safe —
;; a jolt-nil key stores fine here, unlike a Janet table). ;; a jolt-nil key stores fine here).
;; set : a Chez hashtable of elements. ;; set : a Chez hashtable of elements.
;; cow : fallback for anything else (e.g. a sorted coll) — copy-on-write over ;; cow : fallback for anything else (e.g. a sorted coll) — copy-on-write over
;; the persistent ops, preserving jolt's superset of Clojure's transients. ;; the persistent ops, preserving jolt's superset of Clojure's transients.

View file

@ -1,16 +1,16 @@
;; Jolt value model on Chez Scheme — Phase 0a (jolt-cf1q.1). ;; Jolt value model on Chez Scheme.
;; ;;
;; The irreducible value layer the self-hosted RT rests on. Maps Clojure's value ;; The irreducible value layer the self-hosted RT rests on. Maps Clojure's value
;; types onto Chez natives where possible, and adds records only where Chez lacks ;; types onto Chez natives where possible, and adds records only where Chez lacks
;; a distinct type (nil sentinel, keywords, ns-bearing symbols). Loaded into an ;; a distinct type (nil sentinel, keywords, ns-bearing symbols). Loaded into an
;; env that has already (import (chezscheme)); becomes a real library in Phase 1. ;; env that has already (import (chezscheme)).
;; ;;
;; Design notes: ;; Design notes:
;; - nil is a UNIQUE sentinel, distinct from #f and '() (the classic Lisp-on-Lisp ;; - nil is a UNIQUE sentinel, distinct from #f and '() (the classic Lisp-on-Lisp
;; trap). jolt false -> Chez #f, jolt true -> #t. ;; trap). jolt false -> Chez #f, jolt true -> #t.
;; - Chez's numeric tower IS Clojure's: long->exact integer, double->flonum, ;; - Chez's numeric tower IS Clojure's: long->exact integer, double->flonum,
;; ratio->exact rational, bigint->bignum. A windfall vs Janet (ratios/bignums ;; ratio->exact rational, bigint->bignum. Clojure `=` is exactness-aware:
;; for free). Clojure `=` is exactness-aware: (= 1 1.0) is FALSE. ;; (= 1 1.0) is FALSE.
;; --- nil --------------------------------------------------------------------- ;; --- nil ---------------------------------------------------------------------
(define-record-type jolt-nil-t (fields) (nongenerative jolt-nil-v1)) (define-record-type jolt-nil-t (fields) (nongenerative jolt-nil-v1))
@ -42,7 +42,7 @@
;; chars/strings: Chez natives (strings treated immutable). ;; chars/strings: Chez natives (strings treated immutable).
;; --- jolt equality (Clojure =) — scalars; collections land in Phase 2 -------- ;; --- jolt equality (Clojure =) — scalars + collections ----------------------
(define (jolt=2 a b) (define (jolt=2 a b)
(cond (cond
((and (jolt-nil? a) (jolt-nil? b)) #t) ((and (jolt-nil? a) (jolt-nil? b)) #t)
@ -69,7 +69,7 @@
((jolt=2 a (car rest)) (loop (car rest) (cdr rest))) ((jolt=2 a (car rest)) (loop (car rest) (cdr rest)))
(else #f)))) (else #f))))
;; --- jolt hash — consistent with jolt= (for the HAMT in 0c / Phase 2) --------- ;; --- jolt hash — consistent with jolt= (for the HAMT) -----------------------
(define (jolt-hash x) (define (jolt-hash x)
(cond (cond
((jolt-nil? x) 0) ((jolt-nil? x) 0)

View file

@ -1,4 +1,4 @@
;; vars as first-class objects (jolt-cf1q.3, jolt-n7rz) — (var x) / #'x. ;; vars as first-class objects — (var x) / #'x.
;; ;;
;; The emitter lowers :the-var to (jolt-var ns name) — the rt.ss var-cell, which ;; The emitter lowers :the-var to (jolt-var ns name) — the rt.ss var-cell, which
;; is now also a Clojure VAR value. var? / var-get / deref-of-var / var-as-IFn / ;; is now also a Clojure VAR value. var? / var-get / deref-of-var / var-as-IFn /
@ -6,8 +6,8 @@
;; in post-prelude.ss (the overlay reads (get v :root), nil on a record). ;; in post-prelude.ss (the overlay reads (get v :root), nil on a record).
;; ;;
;; Dynamic binding (binding / with-bindings* / var-set / thread-bound? / ;; Dynamic binding (binding / with-bindings* / var-set / thread-bound? /
;; with-redefs) is a separate follow-up — those crash on nil host primitives, ;; with-redefs) lives in dyn-binding.ss, which chains the var-read paths set up
;; which is safe (a crash stays a crash, not a divergence). ;; here.
;; ;;
;; Loaded LAST (after natives-xform.ss): chains jolt-deref (atom/volatile arms) ;; Loaded LAST (after natives-xform.ss): chains jolt-deref (atom/volatile arms)
;; and the printers. ;; and the printers.

View file

@ -25,7 +25,7 @@
(throw (str "zero? requires a number, got: " x))))) (throw (str "zero? requires a number, got: " x)))))
;; pos? checks number? explicitly: this tier is recompiled by the staged pass, ;; pos? checks number? explicitly: this tier is recompiled by the staged pass,
;; where a bare (> x 0) emits the native janet op that happily orders strings ;; where a bare (> x 0) emits the native op that happily orders strings
;; (the documented native-ops relaxation) — the guard keeps Clojure's throw. ;; (the documented native-ops relaxation) — the guard keeps Clojure's throw.
(def pos? (def pos?
(fn* pos? [x] (fn* pos? [x]
@ -111,7 +111,7 @@
;; of 00-syntax has loaded, so using them here is fine. ;; of 00-syntax has loaded, so using them here is fine.
(defmacro ns [nm & clauses] (defmacro ns [nm & clauses]
;; ^{:map} metadata on the ns name reads as a (with-meta sym {...}) form, not an ;; ^{:map} metadata on the ns name reads as a (with-meta sym {...}) form, not an
;; annotated symbol (jolt-8w2). Real libraries put :author/:doc there ;; annotated symbol. Real libraries put :author/:doc there
;; (clojure.tools.logging), so unwrap to the bare symbol; jolt does not track ;; (clojure.tools.logging), so unwrap to the bare symbol; jolt does not track
;; namespace metadata, so the map is dropped. ;; namespace metadata, so the map is dropped.
(let [nm (if (and (seq? nm) (= 'with-meta (first nm))) (second nm) nm) (let [nm (if (and (seq? nm) (= 'with-meta (first nm))) (second nm) nm)
@ -152,7 +152,7 @@
;; Forward declaration interns unbound vars (Clojure semantics). The interpreter ;; Forward declaration interns unbound vars (Clojure semantics). The interpreter
;; resolves forward refs lazily either way, but the COMPILER classifies globals at ;; resolves forward refs lazily either way, but the COMPILER classifies globals at
;; compile time: without the var, a declared name that collides with a Janet root ;; compile time: without the var, a declared name that collides with a host root
;; binding (parse, hash, …) would compile to the host fn instead of the var. ;; binding (parse, hash, …) would compile to the host fn instead of the var.
(defmacro declare [& syms] (defmacro declare [& syms]
`(do ~@(map (fn* [s] `(def ~s)) syms))) `(do ~@(map (fn* [s] `(def ~s)) syms)))
@ -309,8 +309,8 @@
(if (seq ps) (if (seq ps)
(if (symbol? (first ps)) (if (symbol? (first ps))
(go (next ps) (conj nps (first ps)) lets) (go (next ps) (conj nps (first ps)) lets)
;; bare (gensym) here is Janet's (a Janet symbol the destructurer ;; a bare (gensym) returns a host symbol the destructurer rejects;
;; rejects); round-trip through str for a jolt symbol. ;; round-trip through str for a jolt symbol.
(let [g (symbol (str (gensym)))] (let [g (symbol (str (gensym)))]
(go (next ps) (conj nps g) (conj (conj lets (first ps)) g)))) (go (next ps) (conj nps g) (conj (conj lets (first ps)) g))))
[nps lets])) [nps lets]))
@ -348,18 +348,18 @@
body (if (and (seq body) (map? (first body)) (not (symbol? (first body)))) body (if (and (seq body) (map? (first body)) (not (symbol? (first body))))
(rest body) body) (rest body) body)
;; ^{:map} metadata on the name reads as a (with-meta sym …) form, not an ;; ^{:map} metadata on the name reads as a (with-meta sym …) form, not an
;; annotated symbol (jolt-8w2). def attaches the metadata, but fn needs a ;; annotated symbol. def attaches the metadata, but fn needs a
;; bare symbol, so unwrap it for the fn name. ;; bare symbol, so unwrap it for the fn name.
fn-only-name (if (symbol? fn-name) fn-name (first (rest fn-name)))] fn-only-name (if (symbol? fn-name) fn-name (first (rest fn-name)))]
;; pass the name through to fn: the compiled fn's janet name carries it, ;; pass the name through to fn: the compiled fn's host name carries it,
;; so stack traces read app.deep/level3 instead of a gensym (jolt-2o7.1) ;; so stack traces read app.deep/level3 instead of a gensym
`(def ~fn-name (fn ~fn-only-name ~@body)))) `(def ~fn-name (fn ~fn-only-name ~@body))))
;; Jolt doesn't enforce privacy, so defn- is just defn (matching how Clojure's own ;; Jolt doesn't enforce privacy, so defn- is just defn (matching how Clojure's own
;; defn- delegates to defn with :private metadata). ;; defn- delegates to defn with :private metadata).
(defmacro defn- [fn-name & body] `(defn ~fn-name ~@body)) (defmacro defn- [fn-name & body] `(defn ~fn-name ~@body))
;; A fresh jolt symbol inside a macro body (a bare (gensym) returns a Janet symbol ;; A fresh jolt symbol inside a macro body (a bare (gensym) returns a host symbol
;; the destructurer rejects). This defn compiles fine: by the time a tier triggers ;; the destructurer rejects). This defn compiles fine: by the time a tier triggers
;; the analyzer build the kernel is in place (the build is gated until then). ;; the analyzer build the kernel is in place (the build is gated until then).
(defn- fresh-sym [] (symbol (str (gensym)))) (defn- fresh-sym [] (symbol (str (gensym))))
@ -422,9 +422,9 @@
;; Per binding group: :when wraps the inner form in (if test (list inner) []) so ;; Per binding group: :when wraps the inner form in (if test (list inner) []) so
;; mapcat drops it when false; :let wraps it in a let*; :while wraps the coll in ;; mapcat drops it when false; :let wraps it in a let*; :while wraps the coll in
;; take-while. The last group with no modifiers is a plain map (no flatten needed). ;; take-while. The last group with no modifiers is a plain map (no flatten needed).
;; Faithful port of the prior Janet macro (single body expr). The body uses only ;; Single body expr. The body uses only kernel/seed fns so it runs at
;; kernel/seed fns so it runs at analyzer-build time. `fn` (not fn*) carries the ;; analyzer-build time. `fn` (not fn*) carries the binding so destructuring forms
;; binding so destructuring forms work. ;; work.
(defmacro for [bindings body] (defmacro for [bindings body]
(let [scan (fn scan [bvec i bind coll mods] (let [scan (fn scan [bvec i bind coll mods]
(if (and (< i (count bvec)) (keyword? (nth bvec i))) (if (and (< i (count bvec)) (keyword? (nth bvec i)))
@ -471,9 +471,9 @@
(build 0 (parse-groups bindings 0 [])) (build 0 (parse-groups bindings 0 []))
body))) body)))
;; doseq runs body for side effects across the bindings, returning nil. Same ;; doseq runs body for side effects across the bindings, returning nil. Realizes
;; shortcut as the prior Janet macro: realize a `for` comprehension with count ;; a `for` comprehension with count (for handles :when/:let/:while and multiple
;; (for handles :when/:let/:while and multiple bindings). ;; bindings).
(defmacro doseq [bindings & body] (defmacro doseq [bindings & body]
`(do (count (for ~bindings (do ~@body nil))) nil)) `(do (count (for ~bindings (do ~@body nil))) nil))
@ -489,7 +489,7 @@
;; lazy-seq / lazy-cat live here (not 30-macros) because the seq/coll tiers use ;; lazy-seq / lazy-cat live here (not 30-macros) because the seq/coll tiers use
;; them and compile-as-they-load: the macro must be registered before those tiers ;; them and compile-as-they-load: the macro must be registered before those tiers
;; or (lazy-seq …) compiles to a call of the macro-as-function and leaks its ;; or (lazy-seq …) compiles to a call of the macro-as-function and leaks its
;; expansion at runtime (jolt-r81). They use only seed fns (make-lazy-seq/ ;; expansion at runtime. They use only seed fns (make-lazy-seq/
;; coll->cells/concat) + map, all available from the start. ;; coll->cells/concat) + map, all available from the start.
;; lazy-seq defers its body: make-lazy-seq holds a thunk that realizes the body ;; lazy-seq defers its body: make-lazy-seq holds a thunk that realizes the body
;; to cells when forced. lazy-cat wraps each coll in a lazy-seq and concats. ;; to cells when forced. lazy-cat wraps each coll in a lazy-seq and concats.

View file

@ -3,14 +3,14 @@
;; 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
;; compiler/core-renames (that map emits core-X Janet symbols directly), (2) have ;; compiler/core-renames (that map emits core-X symbols directly), (2) have
;; no internal Janet callers of its core-X binding, and (3) NOT be used by the ;; no internal callers of its core-X binding, and (3) NOT be used by the
;; self-hosted compiler (jolt-core/jolt/*.clj). Compiler-facing structural fns go ;; self-hosted compiler (jolt-core/jolt/*.clj). Compiler-facing structural fns go
;; in the kernel tier (00-kernel) instead — see its header. ;; in the kernel tier (00-kernel) instead — see its header.
;; Volatiles (moved up from 20-coll: this tier's transducers use them, and the ;; Volatiles (this tier's transducers use them, and the analyzer ERRORS on
;; analyzer now ERRORS on unresolved forward references — jolt-2o7.3). The ;; unresolved forward references). The constructor (volatile!) stays native;
;; constructor (volatile!) stays native; these are pure over ref-put!/get. ;; these are pure over ref-put!/get.
(defn vreset! [vol newval] (defn vreset! [vol newval]
(jolt.host/ref-put! vol :val newval) newval) (jolt.host/ref-put! vol :val newval) newval)
(defn vswap! [vol f & args] (defn vswap! [vol f & args]
@ -21,7 +21,7 @@
(defn fnext [coll] (first (next coll))) (defn fnext [coll] (first (next coll)))
(defn nnext [coll] (next (next coll))) (defn nnext [coll] (next (next coll)))
;; Canonical Clojure defs: pure first/next/loop/recur, no Janet realize-for-iteration. ;; Canonical Clojure defs: pure first/next/loop/recur.
(defn last [s] (defn last [s]
(if (next s) (recur (next s)) (first s))) (if (next s) (recur (next s)) (first s)))

View file

@ -4,7 +4,7 @@
;; redefinable. Loaded after the seq tier; self-hosted in compile mode. ;; redefinable. Loaded after the seq tier; self-hosted in compile mode.
;; ;;
;; Same migration rule as the seq tier (see 10-seq.clj): not in core-renames, no ;; Same migration rule as the seq tier (see 10-seq.clj): not in core-renames, no
;; internal Janet callers, not used by the self-hosted compiler. ;; internal callers, not used by the self-hosted compiler.
;; Tiny leaves first — fns below in this tier (and 25-sorted) use them. ;; Tiny leaves first — fns below in this tier (and 25-sorted) use them.
(defn some? [x] (not (nil? x))) (defn some? [x] (not (nil? x)))
@ -20,7 +20,7 @@
;; 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
;; (__bit-* seams). 2-arg call sites still compile to the native janet op via ;; (__bit-* seams). 2-arg call sites still compile to the native op via
;; the backend's native-ops table, so the binary fast path is unchanged. ;; the backend's native-ops table, so the binary fast path is unchanged.
(defn bit-and (defn bit-and
([x y] (__bit-and x y)) ([x y] (__bit-and x y))
@ -87,8 +87,8 @@
;; Distinct keys are recorded in a side vector so the buckets can be frozen in ;; Distinct keys are recorded in a side vector so the buckets can be frozen in
;; place (no second map rebuild). A bucket's FIRST element is stored as a cheap ;; place (no second map rebuild). A bucket's FIRST element is stored as a cheap
;; persistent [x]; only the second element promotes it to a transient — so an ;; persistent [x]; only the second element promotes it to a transient — so an
;; all-singletons grouping pays no transient alloc and matches the old cost, ;; all-singletons grouping pays no transient alloc, while any bucket that
;; while any bucket that actually grows rides the O(1) push. ;; actually grows rides the O(1) push.
(defn group-by [f coll] (defn group-by [f coll]
(let [tm (transient {}) (let [tm (transient {})
ks (reduce (fn [ks x] ks (reduce (fn [ks x]
@ -355,7 +355,7 @@
(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 host primitives ---- ;; --- pure-over-core leaves expressed off the host primitives -----------------
;; Representation predicates over the overlay's own predicates. ;; Representation predicates over the overlay's own predicates.
(defn sequential? [x] (or (vector? x) (seq? x))) (defn sequential? [x] (or (vector? x) (seq? x)))
@ -364,7 +364,7 @@
(or (vector? x) (map? x) (set? x) (list? x) (string? x))) (or (vector? x) (map? x) (set? x) (list? x) (string? x)))
(defn indexed? [x] (vector? x)) (defn indexed? [x] (vector? x))
;; sorted? is defined by the next tier (25-sorted) — declared here so this ;; sorted? is defined by the next tier (25-sorted) — declared here so this
;; tier compiles (forward references are analysis errors now, jolt-2o7.3). ;; tier compiles (forward references are analysis errors).
(declare sorted?) (declare sorted?)
(defn reversible? [x] (or (vector? x) (sorted? x))) (defn reversible? [x] (or (vector? x) (sorted? x)))
@ -377,7 +377,7 @@
(defn infinite? [x] (and (number? x) (or (= x ##Inf) (= x ##-Inf)))) (defn infinite? [x] (and (number? x) (or (= x ##Inf) (= x ##-Inf))))
;; qualified-/simple- keyword?/symbol? moved above qualified-ident? (forward ;; qualified-/simple- keyword?/symbol? moved above qualified-ident? (forward
;; references are analysis errors now — jolt-2o7.3). ;; references are analysis errors).
;; realized?: defined on the pending types only (delay/lazy-seq/future read ;; realized?: defined on the pending types only (delay/lazy-seq/future read
@ -453,7 +453,7 @@
(defn println-str [& xs] (__with-out-str (fn* [] (apply println xs)))) (defn println-str [& xs] (__with-out-str (fn* [] (apply println xs))))
(defn prn-str [& xs] (__with-out-str (fn* [] (apply prn xs)))) (defn prn-str [& xs] (__with-out-str (fn* [] (apply prn xs))))
;; --- Phase 2 leaf batch 4 (jolt-ded): over the rand / sort host seams -------- ;; --- leaves over the rand / sort host seams ----------------------------------
;; Canonical truncation toward zero via int (the kernel fn floored, which is ;; Canonical truncation toward zero via int (the kernel fn floored, which is
;; wrong for a negative n). ;; wrong for a negative n).
@ -549,11 +549,11 @@
;; file-seq: the tree of paths under root (root included), directories walked ;; file-seq: the tree of paths under root (root included), directories walked
;; via the host dir primitives. Paths (strings), not File objects. (Lives below ;; via the host dir primitives. Paths (strings), not File objects. (Lives below
;; tree-seq: forward references are analysis errors now — jolt-2o7.3.) ;; tree-seq: forward references are analysis errors.)
(defn file-seq [root] (defn file-seq [root]
(if (__file? root) (if (__file? root)
;; java.io.File tree: walk via the File method surface so leaves are File ;; java.io.File tree: walk via the File method surface so leaves are File
;; values callers can invoke .isFile/.getName/slurp on (jolt-hjw). ;; values callers can invoke .isFile/.getName/slurp on.
(tree-seq (fn [f] (.isDirectory f)) (fn [f] (seq (.listFiles f))) root) (tree-seq (fn [f] (.isDirectory f)) (fn [f] (seq (.listFiles f))) root)
(tree-seq __dir? __list-dir root))) (tree-seq __dir? __list-dir root)))
@ -587,10 +587,6 @@
;; No ratio type on Jolt, so rationalize is identity. ;; No ratio type on Jolt, so rationalize is identity.
(defn rationalize [x] x) (defn rationalize [x] x)
;; trampoline: repeatedly calls f with args until a non-function result.
;; rand-int: random integer in [0, n). Uses Janet math/random.
;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel ;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel
;; value is needed). 1-arg: eager dedupe of consecutive equal elements. ;; value is needed). 1-arg: eager dedupe of consecutive equal elements.
(defn dedupe (defn dedupe
@ -625,8 +621,7 @@
;; canonical Clojure 1.11 shape (core.clj seq-to-map-for-destructuring): ;; canonical Clojure 1.11 shape (core.clj seq-to-map-for-destructuring):
;; even pairs build a map (later keys win, as createAsIfByAssoc), a SINGLE ;; even pairs build a map (later keys win, as createAsIfByAssoc), a SINGLE
;; element is returned as-is (the trailing-map calling convention), and an ;; element is returned as-is (the trailing-map calling convention), and an
;; unpaired key past pairs throws. The old jolt version silently dropped the ;; unpaired key past pairs throws.
;; trailing element, losing (f {:b 2}) kwargs calls.
(defn seq-to-map-for-destructuring [s] (defn seq-to-map-for-destructuring [s]
(if (next s) (if (next s)
(loop [m {} xs (seq s)] (loop [m {} xs (seq s)]
@ -637,8 +632,8 @@
m)) m))
(if (seq s) (first s) {}))) (if (seq s) (first s) {})))
;; Phase 4 (jolt-1j0): host-coupled fns that are pure logic over existing core ;; Host-coupled fns that are pure logic over existing core primitives, so they
;; primitives, so they need no new jolt.host surface. ;; need no new jolt.host surface.
;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and ;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and
;; with-meta are the irreducible host primitives; vary-meta is just their compose. ;; with-meta are the irreducible host primitives; vary-meta is just their compose.
@ -650,9 +645,8 @@
(apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s))))) (apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s)))))
;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce, ;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce,
;; so reduced short-circuits — and the vector path indexes correctly. (The prior ;; so reduced short-circuits — and the vector path indexes correctly. nil folds
;; Janet version saw a pvec as a table and folded over its internal keys; it also ;; to init, matching Clojure.
;; ignored reduced.) nil folds to init, matching Clojure.
(defn reduce-kv [f init coll] (defn reduce-kv [f init coll]
(cond (cond
(vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll))) (vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll)))
@ -660,7 +654,7 @@
(nil? coll) init (nil? coll) init
:else (throw (str "reduce-kv not supported on: " coll)))) :else (throw (str "reduce-kv not supported on: " coll))))
;; ex-info accessors. The Janet constructor (ex-info) stays — it builds the tagged ;; ex-info accessors. The constructor (ex-info) stays native — it builds the tagged
;; value and wires into throw — but the value exposes :jolt/type/:message/:data/ ;; value and wires into throw — but the value exposes :jolt/type/:message/:data/
;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives ;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives
;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first. ;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first.
@ -724,7 +718,7 @@
(when (< i (count vars)) (when (< i (count vars))
(var-set (nth vars i) (nth saved i)) (var-set (nth vars i) (nth saved i))
(recur (inc i)))))))) (recur (inc i))))))))
;; Jolt has no chunked seqs (Phase 5 territory), so this is always false. ;; Jolt has no chunked seqs, so this is always false.
(defn chunked-seq? [x] false) (defn chunked-seq? [x] false)
;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler ;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler
@ -733,7 +727,7 @@
;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches ;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches
;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal ;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal
;; mutation kernel the overlay can't express over core fns (a nil value removes the ;; mutation kernel the overlay can't express over core fns (a nil value removes the
;; key). compare-and-set! compares by value, matching the prior Janet behavior. ;; key). compare-and-set! compares by value.
(defn swap-vals! [a f & args] (defn swap-vals! [a f & args]
(let [old (deref a)] [old (apply swap! a f args)])) (let [old (deref a)] [old (apply swap! a f args)]))
(defn reset-vals! [a newval] (defn reset-vals! [a newval]
@ -777,7 +771,7 @@
(jolt.host/ref-put! target (nth idxs+val (- n 2)) val) (jolt.host/ref-put! target (nth idxs+val (- n 2)) val)
val)) val))
;; --- Phase 2 leaf batch (jolt-ded): fn combinators + host-free stubs --------- ;; --- fn combinators + host-free stubs ----------------------------------------
(defn complement (defn complement
"Takes a fn f and returns a fn that takes the same arguments as f, has the "Takes a fn f and returns a fn that takes the same arguments as f, has the
@ -785,8 +779,7 @@
[f] [f]
(fn [& args] (not (apply f args)))) (fn [& args] (not (apply f args))))
;; Canonical Clojure fnil: patches only the FIRST 1-3 arguments (the old Janet ;; Canonical Clojure fnil: patches only the FIRST 1-3 arguments.
;; kernel patched every position it had a default for, which Clojure does not).
(defn fnil (defn fnil
([f x] ([f x]
(fn [a & args] (apply f (if (nil? a) x a) args))) (fn [a & args] (apply f (if (nil? a) x a) args)))
@ -818,7 +811,7 @@
(let [t (:test (meta v))] (let [t (:test (meta v))]
(if t (do (t) :ok) :no-test))) (if t (do (t) :ok) :no-test)))
;; --- Phase 2 leaf batch 2 (jolt-ded): canonical Clojure ports ---------------- ;; --- canonical Clojure ports -------------------------------------------------
;; key/val/find first — merge-with and memoize below use them. ;; key/val/find first — merge-with and memoize below use them.
;; Strict, as in Clojure: an entry is what (seq m) yields (a host tuple), NOT ;; Strict, as in Clojure: an entry is what (seq m) yields (a host tuple), NOT
@ -882,8 +875,7 @@
(recur nxt (next ks)))) (recur nxt (next ks))))
m))))) m)))))
;; find-based, so nil RESULTS are cached too (the old kernel fn re-computed ;; find-based, so nil RESULTS are cached too; args canonicalize as a collection key.
;; them); args canonicalize as a collection key.
(defn memoize [f] (defn memoize [f]
(let [mem (atom (hash-map))] (let [mem (atom (hash-map))]
(fn [& args] (fn [& args]
@ -920,11 +912,9 @@
(defn reverse [coll] (reduce conj (list) coll)) (defn reverse [coll] (reduce conj (list) coll))
;; --- Phase 2 leaf batch 3 (jolt-ded) -----------------------------------------
;; An empty coll of the same category; sorted colls keep their comparator (the ;; An empty coll of the same category; sorted colls keep their comparator (the
;; value's own :empty op). Strings and scalars are nil, as in Clojure; a lazy ;; value's own :empty op). Strings and scalars are nil, as in Clojure; a lazy
;; seq empties to () (the old kernel fn returned a host table for it). ;; seq empties to ().
(defn empty [coll] (defn empty [coll]
(cond (cond
(nil? coll) nil (nil? coll) nil
@ -948,8 +938,6 @@
(assoc m k (apply f (get m k) args)))))] (assoc m k (apply f (get m k) args)))))]
(up m ks f args))) (up m ks f args)))
;; --- jolt-brh: the last missing-portable vars --------------------------------
;; jolt keywords have no intern table (any keyword "exists"), so find-keyword ;; jolt keywords have no intern table (any keyword "exists"), so find-keyword
;; always finds — babashka makes the same call. ;; always finds — babashka makes the same call.
(defn find-keyword (defn find-keyword
@ -962,7 +950,7 @@
;; Canonical comp — here rather than a host primitive 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.
(defn comp (defn comp
([] identity) ([] identity)
([f] f) ([f] f)
@ -977,17 +965,15 @@
([x y z & args] (f (apply g x y z args))))) ([x y z & args] (f (apply g x y z args)))))
([f g & fs] (reduce comp (comp f g) fs))) ([f g & fs] (reduce comp (comp f g) fs)))
;; Canonical IFn set (jolt-1vx): fns, keywords, symbols, maps (sorted incl.), ;; Canonical IFn set: fns, keywords, symbols, maps (sorted incl.),
;; sets, vectors, and vars — NOT lists ((ifn? '(1 2)) is false in Clojure). ;; sets, vectors, and vars — NOT lists ((ifn? '(1 2)) is false in Clojure).
;; Mutable-mode caveat: vectors and lists share the array representation
;; there, so vector? can't separate them and lists read as ifn?.
(defn ifn? [x] (defn ifn? [x]
(or (fn? x) (keyword? x) (symbol? x) (map? x) (set? x) (vector? x) (var? x))) (or (fn? x) (keyword? x) (symbol? x) (map? x) (set? x) (vector? x) (var? x)))
;; Auto-promoting (') and unchecked arithmetic. Jolt numbers don't overflow, ;; Auto-promoting (') and unchecked arithmetic. Jolt numbers don't overflow,
;; so all of these are the checked ops; fixed arities mirror Clojure's ;; so all of these are the checked ops; fixed arities mirror Clojure's
;; signatures. unchecked-divide-int goes through quot, so dividing by zero ;; signatures. unchecked-divide-int goes through quot, so dividing by zero
;; throws as on the JVM (the old seed fn silently truncated infinity). ;; throws as on the JVM.
(def +' +) (def +' +)
(def -' -) (def -' -)
(def *' *) (def *' *)
@ -1079,7 +1065,7 @@
(defn unchecked-float [x] (double x)) (defn unchecked-float [x] (double x))
(defn unchecked-double [x] (double x)) (defn unchecked-double [x] (double x))
;; --- transduce / into / eduction (seed-shrink round 5) --------------------- ;; --- transduce / into / eduction ---------------------------------------------
;; Canonical transduce: build the stacked rf once, reduce (which honors ;; Canonical transduce: build the stacked rf once, reduce (which honors
;; `reduced` and steps lazy seqs incrementally), then run the completion arity. ;; `reduced` and steps lazy seqs incrementally), then run the completion arity.
(defn transduce (defn transduce
@ -1089,9 +1075,9 @@
(xf (reduce xf init coll))))) (xf (reduce xf init coll)))))
;; into stays a host primitive: 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?).
;; eduction is EAGER on jolt (documented divergence, as before): the composed ;; eduction is EAGER on jolt (documented divergence): the composed
;; xforms applied to coll, realized into a vector. ;; xforms applied to coll, realized into a vector.
(defn eduction [& args] (defn eduction [& args]
(let [coll (last args) (let [coll (last args)
@ -1102,7 +1088,7 @@
(defn ->Eduction [xform coll] (into [] xform coll)) (defn ->Eduction [xform coll] (into [] xform coll))
;; --- JVM-shape stubs and trivial shells (seed-shrink batch 2) -------------- ;; --- JVM-shape stubs and trivial shells --------------------------------------
;; Pure compositions or documented jolt stubs; the host keeps nothing. ;; Pure compositions or documented jolt stubs; the host keeps nothing.
(defn enumeration-seq [e] (seq e)) (defn enumeration-seq [e] (seq e))
(defn iterator-seq [i] (seq i)) (defn iterator-seq [i] (seq i))

View file

@ -1,4 +1,4 @@
;; clojure.core — sorted collections tier (stage 3, jolt-0lj). ;; clojure.core — sorted collections tier.
;; ;;
;; A sorted-map / sorted-set is a tagged host table ;; A sorted-map / sorted-set is a tagged host table
;; {:jolt/type :jolt/sorted-map|:jolt/sorted-set ;; {:jolt/type :jolt/sorted-map|:jolt/sorted-set
@ -10,8 +10,7 @@
;; The tree is a left-leaning-free red-black tree — Rich Hickey's algorithm, ;; The tree is a left-leaning-free red-black tree — Rich Hickey's algorithm,
;; ported from the ClojureScript PersistentTreeMap (cljs.core: tree-map-add / ;; ported from the ClojureScript PersistentTreeMap (cljs.core: tree-map-add /
;; balance-left / balance-right / tree-map-append / balance-*-del). assoc / get / ;; balance-left / balance-right / tree-map-append / balance-*-del). assoc / get /
;; dissoc / contains are O(log n); the old sorted-VECTOR rep was O(n) per assoc, ;; dissoc / contains are O(log n). cljs uses BlackNode/RedNode
;; O(n^2) to build (jolt-684u's sibling, jolt-0hbr). cljs uses BlackNode/RedNode
;; deftypes, but this tier loads before 30-macros (no deftype), so a node is a ;; deftypes, but this tier loads before 30-macros (no deftype), so a node is a
;; plain vector [color k v left right] (color :red/:black; left/right node|nil) ;; plain vector [color k v left right] (color :red/:black; left/right node|nil)
;; and the methods become functions — the algorithm is identical. ;; and the methods become functions — the algorithm is identical.

View file

@ -1,6 +1,6 @@
;; clojure.core — macro tier. Macros expressed in Clojure (defmacro + syntax-quote) ;; clojure.core — macro tier. Macros expressed in Clojure (defmacro + syntax-quote).
;; rather than as hand-built Janet form-transformers. Loaded after the fn tiers, ;; Loaded after the fn tiers, so a macro here may use any already-frozen core
;; so a macro here may use any already-frozen core fn/macro. ;; fn/macro.
;; ;;
;; 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/
@ -34,7 +34,7 @@
(defmacro defmethod [mm dispatch-val & fn-tail] (defmacro defmethod [mm dispatch-val & fn-tail]
`(defmethod-setup (quote ~mm) ~dispatch-val (fn ~@fn-tail))) `(defmethod-setup (quote ~mm) ~dispatch-val (fn ~@fn-tail)))
;; Multimethod table ops (tier 6c): a multimethod's method table lives on its ;; Multimethod table ops: a multimethod's method table lives on its
;; VAR (the value is just the dispatch closure), so these pass the name quoted ;; VAR (the value is just the dispatch closure), so these pass the name quoted
;; to ctx-capturing setups — the same shape as defmulti/defmethod above. ;; to ctx-capturing setups — the same shape as defmulti/defmethod above.
(defmacro prefer-method [mm dval-a dval-b] (defmacro prefer-method [mm dval-a dval-b]
@ -48,7 +48,7 @@
;; methods/get-method take the multimethod VALUE (Clojure semantics); the setup ;; methods/get-method take the multimethod VALUE (Clojure semantics); the setup
;; maps it back to its var via the registry, so a bare multifn ref works from a ;; maps it back to its var via the registry, so a bare multifn ref works from a
;; compiled fn in any namespace (jolt multimethod table-visibility fix). ;; compiled fn in any namespace.
(defmacro get-method [mm dval] (defmacro get-method [mm dval]
`(get-method-setup ~mm ~dval)) `(get-method-setup ~mm ~dval))
@ -75,7 +75,7 @@
`(do ~x ~@body)) `(do ~x ~@body))
;; defonce: define name only if it isn't already bound to a non-nil root; ;; defonce: define name only if it isn't already bound to a non-nil root;
;; returns the existing var untouched otherwise (matching the prior arm). ;; returns the existing var untouched otherwise.
;; time: evaluate expr, print the elapsed wall-clock, return the value. ;; time: evaluate expr, print the elapsed wall-clock, return the value.
;; current-time-ms is the host's monotonic clock. ;; current-time-ms is the host's monotonic clock.
(defmacro time [expr] (defmacro time [expr]
@ -164,14 +164,12 @@
(loop [~i 0] (loop [~i 0]
(when (< ~i n#) ~@body (recur (inc ~i))))))) (when (< ~i n#) ~@body (recur (inc ~i)))))))
;; A fresh jolt symbol inside a macro body: (gensym) here resolves to Janet's ;; A fresh jolt symbol inside a macro body: a bare (gensym) returns a host symbol
;; builtin (a Janet symbol the destructurer rejects), so round-trip through str. ;; the destructurer rejects, so round-trip through str.
(defn- fresh-sym [] (symbol (str (gensym)))) (defn- fresh-sym [] (symbol (str (gensym))))
;; Lazy-safe: take only the head via first (Clojure uses (seq coll), but Jolt's ;; Lazy-safe: take only the head via first (Clojure uses (seq coll), but Jolt's
;; eager seq would realize an infinite coll like (repeat nil) and hang). Matches ;; eager seq would realize an infinite coll like (repeat nil) and hang).
;; the prior Janet behavior; the nil/false-head distinction waits on Phase 5
;; laziness.
(defmacro when-first [bindings & body] (defmacro when-first [bindings & body]
(let [x (bindings 0) coll (bindings 1)] (let [x (bindings 0) coll (bindings 1)]
`(when-let [~x (first ~coll)] ~@body))) `(when-let [~x (first ~coll)] ~@body)))
@ -289,7 +287,7 @@
;; a seq of field keywords; spliced into a vector LITERAL below ([~@…]) so ;; a seq of field keywords; spliced into a vector LITERAL below ([~@…]) so
;; the analyzer sees a vector form, not a runtime pvec value. ;; the analyzer sees a vector form, not a runtime pvec value.
field-kws (map (fn [f] (keyword (name f))) fields) field-kws (map (fn [f] (keyword (name f))) fields)
;; per-field TYPE HINT (jolt-3ko): ^Vec3 origin -> "Vec3" (a record type ;; per-field TYPE HINT: ^Vec3 origin -> "Vec3" (a record type
;; name), ^:num x -> "num", else nil. Lets the inference know a field's ;; name), ^:num x -> "num", else nil. Lets the inference know a field's
;; exact type up front, so reading it back carries that type (not :any) — ;; exact type up front, so reading it back carries that type (not :any) —
;; the key to fast nested-record code. Spliced as a vector literal too. ;; the key to fast nested-record code. Spliced as a vector literal too.
@ -298,7 +296,7 @@
(and mt (:num mt)) "num" (and mt (:num mt)) "num"
:else nil))) :else nil)))
fields) fields)
;; per-field MUTABILITY (jolt-c3q): ^:unsynchronized-mutable / ^:volatile- ;; per-field MUTABILITY: ^:unsynchronized-mutable / ^:volatile-
;; mutable marks a field set!-able. A type with any mutable field opts out ;; mutable marks a field set!-able. A type with any mutable field opts out
;; of the immutable shape-rec layout and uses the mutable table form, so ;; of the immutable shape-rec layout and uses the mutable table form, so
;; set! can mutate it (the ctor reads this vector). Spliced as a literal. ;; set! can mutate it (the ctor reads this vector). Spliced as a literal.
@ -309,7 +307,7 @@
fields) fields)
;; mutable field symbols (^:unsynchronized-mutable / ^:volatile-mutable): ;; mutable field symbols (^:unsynchronized-mutable / ^:volatile-mutable):
;; (set! field v) in a method body lowers to (set! (.-field inst) v), the ;; (set! field v) in a method body lowers to (set! (.-field inst) v), the
;; in-place field write the analyzer compiles to jolt-set-field! (jolt-c3q). ;; in-place field write the analyzer compiles to jolt-set-field!.
mutable-syms (map first (filter second (map vector fields field-muts))) mutable-syms (map first (filter second (map vector fields field-muts)))
mutable? (fn [s] (boolean (some (fn [m] (= m s)) mutable-syms))) mutable? (fn [s] (boolean (some (fn [m] (= m s)) mutable-syms)))
rewrite-set (fn rw [inst form] rewrite-set (fn rw [inst form]
@ -359,7 +357,7 @@
{} sigs)] {} sigs)]
`(do `(do
(def ~pname (make-protocol ~(name pname) ~methods)) (def ~pname (make-protocol ~(name pname) ~methods))
;; register method var-keys for devirtualization (jolt-41m); the inference ;; register method var-keys for devirtualization; the inference
;; reads this (via infer-unit!) to resolve a protocol call on a known record ;; reads this (via infer-unit!) to resolve a protocol call on a known record
(register-protocol-methods! ~(name pname) [~@(map (fn [s] (name (first s))) sigs)]) (register-protocol-methods! ~(name pname) [~@(map (fn [s] (name (first s))) sigs)])
~@(map (fn [sig] ~@(map (fn [sig]
@ -431,8 +429,7 @@
`(do ~@(map (fn [g] `(extend-type ~(first g) ~psym ~@(rest g))) `(do ~@(map (fn [g] `(extend-type ~(first g) ~psym ~@(rest g)))
(group-by-head type-impls)))) (group-by-head type-impls))))
;; extend (the fn form) is not supported — stub to nil, as before. ;; extend is a real FUNCTION — defined above extend-type.
;; extend is a real FUNCTION now — defined above extend-type.
;; JVM proxies are unsupported. ;; JVM proxies are unsupported.
(defmacro proxy [& args] nil) (defmacro proxy [& args] nil)
;; definterface is JVM-only; bind the name to a marker and return the name (not a ;; definterface is JVM-only; bind the name to a marker and return the name (not a
@ -474,7 +471,7 @@
(let [argv (nth spec 1) (let [argv (nth spec 1)
inst (first argv) inst (first argv)
;; hint `this` with the record type so the inference ;; hint `this` with the record type so the inference
;; types it (jolt-3ko) and its field reads bare-index ;; types it and its field reads bare-index
;; instead of going through the runtime tag guard. ;; instead of going through the runtime tag guard.
hinted (assoc argv 0 (vary-meta inst assoc :tag (name name-sym))) hinted (assoc argv 0 (vary-meta inst assoc :tag (name name-sym)))
binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))] binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
@ -492,8 +489,8 @@
;; lazy-seq / lazy-cat moved to the 00-syntax tier: the seq/coll tiers (10-seq, ;; lazy-seq / lazy-cat moved to the 00-syntax tier: the seq/coll tiers (10-seq,
;; 20-coll) use lazy-seq, and in compile mode a tier's forms are compiled as it ;; 20-coll) use lazy-seq, and in compile mode a tier's forms are compiled as it
;; loads — so the macro must be registered BEFORE those tiers, else (lazy-seq …) ;; loads — so the macro must be registered BEFORE those tiers, else (lazy-seq …)
;; compiles as a call to the macro-as-function and leaks its expansion at runtime ;; compiles as a call to the macro-as-function and leaks its expansion at runtime.
;; (jolt-r81). They only need seed fns (make-lazy-seq/coll->cells/concat). ;; They only need seed fns (make-lazy-seq/coll->cells/concat).
;; memfn: a fn wrapping a method call, (memfn toUpperCase) => #(.toUpperCase %). ;; memfn: a fn wrapping a method call, (memfn toUpperCase) => #(.toUpperCase %).
;; The method symbol is rewritten to jolt's .method call sugar; extra arg names ;; The method symbol is rewritten to jolt's .method call sugar; extra arg names

View file

@ -105,7 +105,7 @@
;; --- 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 — the §6.3 laziness counters depend on this. ;; minimally — the laziness counters depend on this.
;; (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]
@ -139,7 +139,7 @@
(cons (take n s) (go (nthrest s step))))))] (cons (take n s) (go (nthrest s step))))))]
(go coll)))) (go coll))))
;; --- Phase 2 leaf batch 3 (jolt-ded): canonical lazy + transducer arities ---- ;; --- canonical lazy + transducer arities -------------------------------------
(defn interpose (defn interpose
([sep] ([sep]
@ -176,7 +176,7 @@
(when-let [s (seq coll)] (when-let [s (seq coll)]
(cons (first s) (take-nth n (drop n s))))))) (cons (first s) (take-nth n (drop n s)))))))
;; --- pmap family (jolt-oeu): parallel map over real-thread futures ---------- ;; --- pmap family: parallel map over real-thread futures ----------------------
;; Each element's work runs on its own OS thread with SNAPSHOT semantics ;; Each element's work runs on its own OS thread with SNAPSHOT semantics
;; (futures marshal captured state — pure fns only, mutations don't propagate ;; (futures marshal captured state — pure fns only, mutations don't propagate
;; back). All futures are spawned up front (doall), then derefed in order: ;; back). All futures are spawned up front (doall), then derefed in order:

View file

@ -1,4 +1,4 @@
;; clojure.core — IO tier: the *in* reader family (jolt-0d9). ;; clojure.core — IO tier: the *in* reader family.
;; ;;
;; *in* is a dynamic var holding a READER: a plain map whose two ops close ;; *in* is a dynamic var holding a READER: a plain map whose two ops close
;; over their source — :read-line-fn (next line, newline ;; over their source — :read-line-fn (next line, newline
@ -135,7 +135,7 @@
(when line (when line
(cons line (line-seq rdr))))))) (cons line (line-seq rdr)))))))
;; --- print-method (jolt-g1r) ------------------------------------------------ ;; --- print-method ------------------------------------------------
;; Canonical dispatch (clojure/core.clj 3693): the :type metadata when it's a ;; Canonical dispatch (clojure/core.clj 3693): the :type metadata when it's a
;; keyword, else the value's type. On jolt, type is the keyword tag for ;; keyword, else the value's type. On jolt, type is the keyword tag for
;; builtins and the deftype name SYMBOL for records — so a record method is ;; builtins and the deftype name SYMBOL for records — so a record method is

View file

@ -1,8 +1,8 @@
(ns jolt.analyzer (ns jolt.analyzer
"Portable Clojure analyzer: reader form -> host-neutral IR (see jolt.ir). "Portable Clojure analyzer: reader form -> host-neutral IR (see jolt.ir).
Pure jolt-core depends only on the host contract (jolt.host) and IR Depends only on the host contract (jolt.host) and IR
constructors (jolt.ir), never on Janet. The contract fns are referred unqualified constructors (jolt.ir). The contract fns are referred unqualified
(host form predicates are `form-*` to avoid colliding with clojure.core), so the (host form predicates are `form-*` to avoid colliding with clojure.core), so the
bootstrap can compile this namespace via its plain :var path. ctx is an opaque 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.
@ -50,7 +50,7 @@
(defn- add-locals [env names] (update env :locals #(reduce conj % names))) (defn- add-locals [env names] (update env :locals #(reduce conj % names)))
(defn- with-recur [env name] (assoc env :recur name)) (defn- with-recur [env name] (assoc env :recur name))
;; Type hints (jolt-94n). The reader keeps ^hint metadata on the binding symbol. ;; Type hints. The reader keeps ^hint metadata on the binding symbol.
;; Two hints resolve to the :struct fast path (a constant-keyword lookup skips ;; Two hints resolve to the :struct fast path (a constant-keyword lookup skips
;; the :jolt/type guard and emits a bare get): ^:struct (a plain struct/record ;; the :jolt/type guard and emits a bare get): ^:struct (a plain struct/record
;; map) and ^TypeName where TypeName is a defrecord/deftype (its instances are ;; map) and ^TypeName where TypeName is a defrecord/deftype (its instances are
@ -138,7 +138,7 @@
;; param an ordinary positional slot (holding the collected seq), so recur ;; param an ordinary positional slot (holding the collected seq), so recur
;; is a self-call carrying the rest seq directly — Clojure semantics. ;; is a self-call carrying the rest seq directly — Clojure semantics.
;; The recur target doubles as the COMPILED FN'S NAME, which is what a ;; The recur target doubles as the COMPILED FN'S NAME, which is what a
;; janet stack trace shows — so carry the Clojure ns/fn-name (jolt-2o7.1): ;; host stack trace shows — so carry the Clojure ns/fn-name:
;; an error inside app.deep/level3 traces as _r$app.deep/level3--N ;; an error inside app.deep/level3 traces as _r$app.deep/level3--N
;; (report-error demangles the _r$/--N wrapper). gen-name's counter ;; (report-error demangles the _r$/--N wrapper). gen-name's counter
;; keeps recur targets unique per compilation unit. ;; keeps recur targets unique per compilation unit.
@ -215,7 +215,7 @@
;; the arity :rest key above). Assoc'ing them nil-when-absent would give the ;; the arity :rest key above). Assoc'ing them nil-when-absent would give the
;; node a nil-valued key, which makes it a phm in jolt's map representation ;; node a nil-valued key, which makes it a phm in jolt's map representation
;; and forces the back end to densify it (norm-node) before reading :op — the ;; and forces the back end to densify it (norm-node) before reading :op — the
;; map-nil-representation trap Phase 2 cleaned up for def/fn/arity nodes. The ;; map-nil-representation trap, also avoided for def/fn/arity nodes. The
;; back end reads each key with a nil-safe (node :k) and gates on it, so an ;; back end reads each key with a nil-safe (node :k) and gates on it, so an
;; absent key is indistinguishable from a present-nil one. ;; absent key is indistinguishable from a present-nil one.
(let [n {:op :try :body (analyze-seq ctx @body env)} (let [n {:op :try :body (analyze-seq ctx @body env)}
@ -282,13 +282,13 @@
(let [nm (form-sym-name name-sym) (let [nm (form-sym-name name-sym)
cur (compile-ns ctx) cur (compile-ns ctx)
;; (def name docstring value): docstring is form 2, value form 3. ;; (def name docstring value): docstring is form 2, value form 3.
;; Matches the interpreter; without this the docstring was taken ;; Matches the interpreter; otherwise the docstring is taken as
;; as the value and the real init dropped (jolt-6ym). ;; the value and the real init dropped.
has-doc (and (> (count items) 3) (string? (nth items 2))) has-doc (and (> (count items) 3) (string? (nth items 2)))
val-form (nth items (if has-doc 3 2)) val-form (nth items (if has-doc 3 2))
base0 (or (form-sym-meta name-sym) {}) base0 (or (form-sym-meta name-sym) {})
;; resolve a ^Type hint to its canonical class name at def ;; resolve a ^Type hint to its canonical class name at def
;; time (jolt-a1ir), as the JVM compiler does: ^String -> ;; time, as the JVM compiler does: ^String ->
;; java.lang.String. A record/unknown hint is left untouched. ;; java.lang.String. A record/unknown hint is left untouched.
tag (get base0 :tag) tag (get base0 :tag)
tag-name (cond (form-sym? tag) (form-sym-name tag) tag-name (cond (form-sym? tag) (form-sym-name tag)
@ -365,7 +365,7 @@
:else (uncompilable "set! of an unsupported target"))) :else (uncompilable "set! of an unsupported target")))
(uncompilable (str "special form " op)))) (uncompilable (str "special form " op))))
;; Host interop method call (jolt-0kf5). `(.method target arg*)` — a head that ;; Host interop method call. `(.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 Chez back end lowers it to a jolt-host-call dispatch. ;; :host-call node; the Chez back end lowers it to a jolt-host-call dispatch.
(defn- method-head? [nm] (defn- method-head? [nm]
@ -391,11 +391,11 @@
;; `(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 Chez back end lowers it to a runtime ;; token and the analyzed args. The Chez back end lowers it to a runtime
;; constructor dispatch (jolt-avt6). ;; constructor dispatch.
(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)))
;; jolt.ffi/__cfn (jolt-ffi): the low-level foreign-function form a jolt library ;; jolt.ffi/__cfn: the low-level foreign-function form a jolt library
;; uses (via the jolt.ffi/foreign-fn macro) to bind native code. Shape: ;; uses (via the jolt.ffi/foreign-fn macro) to bind native code. Shape:
;; (jolt.ffi/__cfn "c_symbol" [:argtype ...] :rettype) ; non-blocking ;; (jolt.ffi/__cfn "c_symbol" [:argtype ...] :rettype) ; non-blocking
;; (jolt.ffi/__cfn "c_symbol" [:argtype ...] :rettype :blocking) ; may block ;; (jolt.ffi/__cfn "c_symbol" [:argtype ...] :rettype :blocking) ; may block
@ -417,8 +417,7 @@
;; 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 Chez back end dispatches it through record-method-dispatch ;; it as a field). The Chez back end dispatches it through record-method-dispatch.
;; (jolt-kuic).
(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")))
@ -457,15 +456,15 @@
(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 Chez back end ;; (Math/sqrt, Long/MAX_VALUE, System/getenv). The Chez back end
;; lowers it to a runtime static dispatch (jolt-avt6). ;; lowers it to a runtime static dispatch.
(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)
:var (var-ref (:ns r) (:name r)) :var (var-ref (:ns r) (:name r))
:host (host-ref (:name r)) :host (host-ref (:name r))
;; :unresolved — previously emitted a var-ref that auto-interned ;; :unresolved — emitting a var-ref here would auto-intern an
;; an UNBOUND var, so a typo'd symbol died later as 'Cannot call ;; UNBOUND var, so a typo'd symbol would die later as 'Cannot call
;; nil as a function' with no hint which symbol (jolt-2o7.3). ;; nil as a function' with no hint which symbol.
;; Punt to the interpreter: its resolver raises Clojure's ;; Punt to the interpreter: its resolver raises Clojure's
;; 'Unable to resolve symbol' when the form actually runs (at ;; 'Unable to resolve symbol' when the form actually runs (at
;; eval for top-level forms, at call for fn bodies). A punt ;; eval for top-level forms, at call for fn bodies). A punt
@ -524,7 +523,7 @@
(and hname (not shadowed) (form-special? hname)) (and hname (not shadowed) (form-special? hname))
(uncompilable (str "special form " hname)) (uncompilable (str "special form " hname))
:else :else
;; stamp the list form's source offset onto the :invoke (jolt-fqy) ;; stamp the list form's source offset onto the :invoke
;; so the success checker can report file:line:col. nil when the ;; so the success checker can report file:line:col. nil when the
;; reader did not record it (synthetic/macro-built forms). ;; reader did not record it (synthetic/macro-built forms).
(let [n (invoke (analyze ctx head env) (let [n (invoke (analyze ctx head env)

View file

@ -1,25 +1,12 @@
(ns jolt.backend-scheme (ns jolt.backend-scheme
"Portable Clojure IR -> Chez Scheme emitter (Chez Phase 3, jolt-cf1q.4). "Lowers the host-neutral IR (jolt.ir) to Chez Scheme source text.
Consumes the The analyzer produces IR; this emitter turns each IR op into a string of Scheme
host-neutral IR (jolt.ir, see jolt-core/jolt/ir.clj) the analyzer produces and source, which the host compiles with (eval (read ...)). It depends only on
emits Chez Scheme source TEXT. Pure jolt-core (clojure.core + clojure.string clojure.core and clojure.string, so once cross-compiled it runs on Chez and can
only) so that, once cross-compiled, it runs ON Chez and the analyzer can emit emit its own code the bootstrap spine. Quoted forms are walked through the
its own code the bootstrap spine. portable jolt.host form-* contract, the same seam the analyzer uses, so the
emitter never touches a concrete host representation directly."
Output is a STRING of Scheme source; `host/compile` on Chez is `(eval (read
...))`. Lowers each IR op to Scheme.
INCREMENT 1 (jolt-hg7z): const/local/var/the-var/if/do/let/loop/recur/invoke
(+ native-ops)/fn/def + the escaping/flonum/munge helpers.
INCREMENT 2 (jolt-7jvp): collection literals (vector/map/set, emit-ordered) +
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).
INCREMENT 3 (jolt-me6m): try/throw + host-call + regex/inst/uuid + def-meta +
quoted-symbol-meta. With this the emitter covers every IR op.
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
assembly + the prelude driver port land with compile-from-source (inc 4+)."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-sym-meta [jolt.host :refer [form-sym? form-sym-name form-sym-ns form-sym-meta
form-list? form-vec? form-map? form-set? form-char? form-list? form-vec? form-map? form-set? form-char?
@ -83,13 +70,13 @@
(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
;; :if test built from them needs no jolt-truthy? wrapper (jolt-nkcb). ;; :if test built from them needs no jolt-truthy? wrapper.
(def ^:private bool-returning-ops (def ^:private bool-returning-ops
#{"<" "<=" ">" ">=" "jolt=" "jolt-not" #{"<" "<=" ">" ">=" "jolt=" "jolt-not"
"jolt-even?" "jolt-odd?" "jolt-pos?" "jolt-neg?" "jolt-even?" "jolt-odd?" "jolt-pos?" "jolt-neg?"
"jolt-zero?" "jolt-empty?" "jolt-contains?"}) "jolt-zero?" "jolt-empty?" "jolt-contains?"})
;; PRELUDE MODE (inc 3d). The default (subset) mode rejects any clojure.core ref ;; PRELUDE MODE. The default (subset) mode rejects any clojure.core ref
;; that isn't a native-op — a clean "out of subset" signal for user-facing `-e`. ;; that isn't a native-op — a clean "out of subset" signal for user-facing `-e`.
;; When emitting clojure.core ITSELF as a prelude, core fns reference each other ;; When emitting clojure.core ITSELF as a prelude, core fns reference each other
;; constantly; those lower to var-deref (resolved at runtime). ;; constantly; those lower to var-deref (resolved at runtime).
@ -131,7 +118,7 @@
(declare emit) (declare emit)
;; A Chez string literal (jolt-x0os). Every char outside printable ASCII becomes a ;; A Chez string literal. Every char outside printable ASCII becomes a
;; codepoint hex escape \x<cp>; ; the named escapes (\n \t \r \" \\) match what ;; codepoint hex escape \x<cp>; ; the named escapes (\n \t \r \" \\) match what
;; Chez's reader accepts. For pure printable ASCII this is byte-identical to %j. ;; Chez's reader accepts. For pure printable ASCII this is byte-identical to %j.
(defn- char-escape [cp] (defn- char-escape [cp]
@ -151,7 +138,7 @@
(cond (cond
(nil? v) "jolt-nil" (nil? v) "jolt-nil"
(boolean? v) (if v "#t" "#f") (boolean? v) (if v "#t" "#f")
;; Numeric tower (jolt-n6al): emit a literal Chez re-reads as the SAME number. ;; Numeric tower: emit a literal Chez re-reads as the SAME number.
;; Exact integers -> "42", exact ratios -> "1/2" (str renders both faithfully); ;; Exact integers -> "42", exact ratios -> "1/2" (str renders both faithfully);
;; a flonum must carry a decimal point/exponent or Chez reads it back as exact, ;; a flonum must carry a decimal point/exponent or Chez reads it back as exact,
;; so a whole flonum (str drops its .0) gets ".0" appended. ##Inf/##-Inf/##NaN ;; so a whole flonum (str drops its .0) gets ".0" appended. ##Inf/##-Inf/##NaN
@ -169,9 +156,9 @@
(str "(keyword " (chez-str-lit kns) " " (chez-str-lit (name v)) ")") (str "(keyword " (chez-str-lit kns) " " (chez-str-lit (name v)) ")")
(str "(keyword #f " (chez-str-lit (name v)) ")")) (str "(keyword #f " (chez-str-lit (name v)) ")"))
;; char literal -> (integer->char <codepoint>). Get the codepoint via the host ;; char literal -> (integer->char <codepoint>). Get the codepoint via the host
;; contract (form-char-code), NOT (get v :ch): on Janet a char is a struct with ;; contract (form-char-code), NOT (get v :ch): on Chez (the self-hosted spine)
;; a :ch field, but on Chez (the self-hosted spine) it's a native char, so the ;; a char is a native char, so a struct-field read returns nil and would emit
;; struct-field read returns nil and emits (integer->char) with no arg. ;; (integer->char) with no arg.
(form-char? v) (str "(integer->char " (form-char-code v) ")") (form-char? v) (str "(integer->char " (form-char-code v) ")")
:else (throw (ex-info (str "emit-const: unsupported literal " (pr-str v)) {})))) :else (throw (ex-info (str "emit-const: unsupported literal " (pr-str v)) {}))))
@ -211,7 +198,7 @@
(str "(let* (" binds ") " (build tmps) ")")) (str "(let* (" binds ") " (build tmps) ")"))
(build strs))) (build strs)))
;; Quoted literals (jolt-u8j7). A :quote node's :form is the RAW reader form; ;; Quoted literals. A :quote node's :form is the RAW reader form;
;; 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
@ -417,7 +404,7 @@
:else :else
(invoke)))) (invoke))))
;; try/catch/finally (jolt-vcsl). throw raises the jolt value RAW (jolt-throw = ;; try/catch/finally. throw raises the jolt value RAW (jolt-throw =
;; Scheme `raise`); catch lowers to `guard` with an `else` clause (the IR drops ;; Scheme `raise`); catch lowers to `guard` with an `else` clause (the IR drops
;; the class), finally to `dynamic-wind`'s after-thunk (runs on success, catch and ;; the class), finally to `dynamic-wind`'s after-thunk (runs on success, catch and
;; escape — Clojure finally semantics). Both keys optional on the node. ;; escape — Clojure finally semantics). Both keys optional on the node.
@ -496,7 +483,7 @@
;; a namespace value spliced into a form (~*ns*) -> reconstruct by name. ;; a namespace value spliced into a form (~*ns*) -> reconstruct by name.
:the-ns (str "(intern-ns! " (chez-str-lit (:name node)) ")") :the-ns (str "(intern-ns! " (chez-str-lit (:name node)) ")")
;; (.method target arg*) -> jolt-host-call for an rt-shimmed method, else ;; (.method target arg*) -> jolt-host-call for an rt-shimmed method, else
;; record-method-dispatch (a reify/record protocol method, jolt-jgoc). ;; record-method-dispatch (a reify/record protocol method).
:host-call (let [m (:method node) :host-call (let [m (:method node)
target (emit (:target node)) target (emit (:target node))
args (map emit (:args node))] args (map emit (:args node))]

View file

@ -23,8 +23,8 @@
;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT. ;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT.
(defn rt [name] {:op :rt :name name}) (defn rt [name] {:op :rt :name name})
;; A name that resolves only via the host's own environment (e.g. + or int? on ;; A name that resolves only via the host's own environment (e.g. + or int?) —
;; Janet) — the back end emits a host-appropriate reference. ;; the back end emits a host-appropriate reference.
(defn host-ref [name] {:op :host :name name}) (defn host-ref [name] {:op :host :name name})
;; 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.
@ -72,7 +72,7 @@
(defn op [node] (:op node)) (defn op [node] (:op node))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; Structural recursion over IR child nodes (jolt-26dm / phase 3a). ;; Structural recursion over IR child nodes.
;; ;;
;; A tree-rewriting pass recurses into each op's child NODE positions and ;; A tree-rewriting pass recurses into each op's child NODE positions and
;; rebuilds the node; this combinator does that one place, so the per-op child ;; rebuilds the node; this combinator does that one place, so the per-op child

View file

@ -1,11 +1,11 @@
(ns jolt.passes (ns jolt.passes
"IR optimization passes (nanopass-lite, jolt-2om) + the inference/checking "IR optimization passes (nanopass-lite) + the inference/checking
driver. Façade over three weakly-coupled namespaces, loaded with the compiler: driver. Façade over three weakly-coupled namespaces, loaded with the compiler:
jolt.passes.fold const-fold (always-on) + the shared const-shape predicate. jolt.passes.fold const-fold (always-on) + the shared const-shape predicate.
jolt.passes.inline inline + flatten-lets + scalar-replace (direct-link only). jolt.passes.inline inline + flatten-lets + scalar-replace (direct-link only).
jolt.passes.types collection-type inference + success-type checking jolt.passes.types collection-type inference + success-type checking
(RFC 0006) + the inter-procedural driver API (jolt-767). (RFC 0006) + the inter-procedural driver API.
run-passes (below) is the single entry the back end applies to every analyzed run-passes (below) is the single entry the back end applies to every analyzed
form. The driver/checker fns the back end looks up by name (check-form, form. The driver/checker fns the back end looks up by name (check-form,
@ -25,18 +25,18 @@
(defn run-passes (defn run-passes
"All passes, in order. The back end applies this to every analyzed form. When "All passes, in order. The back end applies this to every analyzed form. When
inlining is enabled for the unit (user code under direct-linking, jolt-87f), inlining is enabled for the unit (user code under direct-linking),
run inline + flatten + scalar-replace + const-fold to a capped fixpoint run inline + flatten + scalar-replace + const-fold to a capped fixpoint
inlining exposes map literals to lookups, scalar-replace collapses them, which inlining exposes map literals to lookups, scalar-replace collapses them, which
may expose more then a collection-type inference pass (jolt-99x, optionally may expose more then a collection-type inference pass (optionally
also emitting success diagnostics) that auto-drops the lookup guard where the also emitting success diagnostics) that auto-drops the lookup guard where the
type is proven. Otherwise (core + bootstrap) just const-fold, as before." type is proven. Otherwise (core + bootstrap) just const-fold, as before."
[node ctx] [node ctx]
(if (inline-enabled? ctx) (if (inline-enabled? ctx)
(let [_ (set-rec-shapes! (record-shapes ctx)) ;; record ctor fold (jolt-15jq) (let [_ (set-rec-shapes! (record-shapes ctx)) ;; record ctor fold
;; resolve ^Record param hints (incl. defrecord/extend-type method ;; resolve ^Record param hints (incl. defrecord/extend-type method
;; `this`) to bare field reads per-form, not only under whole-program ;; `this`) to bare field reads per-form, not only under whole-program.
;; (jolt-3ko). Same shapes the inline pass uses. ;; Same shapes the inline pass uses.
_ (set-record-shapes! (record-shapes ctx)) _ (set-record-shapes! (record-shapes ctx))
opt (loop [i 0 n (const-fold node)] opt (loop [i 0 n (const-fold node)]
(reset! dirty false) (reset! dirty false)
@ -45,6 +45,6 @@
(recur (inc i) n2) (recur (inc i) n2)
n2)))] n2)))]
;; a final const-fold after inference propagates any predicate folded to a ;; a final const-fold after inference propagates any predicate folded to a
;; constant (jolt-wcw), collapsing the `if` it gates to the taken branch. ;; constant, collapsing the `if` it gates to the taken branch.
(const-fold (run-inference opt))) (const-fold (run-inference opt)))
(const-fold node))) (const-fold node)))

View file

@ -1,6 +1,6 @@
(ns jolt.passes.inline (ns jolt.passes.inline
"Inlining + flatten-lets + scalar-replace (AOT escape analysis). These run only "Inlining + flatten-lets + scalar-replace (AOT escape analysis). These run only
when host/inline-enabled? (user code opted into direct-linking, jolt-87f); they when host/inline-enabled? (user code opted into direct-linking); they
share the alpha-rename invariant (every spliced binder is made globally fresh) share the alpha-rename invariant (every spliced binder is made globally fresh)
and the `dirty` fixpoint flag. Portable Clojure (compiler-tier)." and the `dirty` fixpoint flag. Portable Clojure (compiler-tier)."
(:require [jolt.host :refer [inline-ir]] (:require [jolt.host :refer [inline-ir]]
@ -18,10 +18,10 @@
;; per unit by run-passes (set-rec-shapes!) before the fixpoint so scalar-replace ;; per unit by run-passes (set-rec-shapes!) before the fixpoint so scalar-replace
;; can recognize a (->Rec ..) call and map its positional args to declared fields ;; can recognize a (->Rec ..) call and map its positional args to declared fields
;; — the record analogue of the inline keys a map literal already carries in the ;; — the record analogue of the inline keys a map literal already carries in the
;; IR (jolt-15jq). ;; IR.
(def ^:private rec-shapes (atom {})) (def ^:private rec-shapes (atom {}))
(defn set-rec-shapes! (defn set-rec-shapes!
"Install the record-ctor shape registry the record fold consults (jolt-15jq)." "Install the record-ctor shape registry the record fold consults."
[m] (reset! rec-shapes (or m {}))) [m] (reset! rec-shapes (or m {})))
(def ^:private fresh-counter (atom 0)) (def ^:private fresh-counter (atom 0))
@ -31,7 +31,7 @@
(str base "__il" n))) (str base "__il" n)))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; Inlining (jolt-87f). The back end stashes {:params [..] :body ir} on the var ;; Inlining. The back end stashes {:params [..] :body ir} on the var
;; cell of each single-fixed-arity defn compiled under :inline?; here we splice ;; cell of each single-fixed-arity defn compiled under :inline?; here we splice
;; that body at a call site. To stay capture-safe we ALPHA-RENAME the body — ;; that body at a call site. To stay capture-safe we ALPHA-RENAME the body —
;; every param and every inner let-bound name becomes a globally fresh name — ;; every param and every inner let-bound name becomes a globally fresh name —
@ -89,7 +89,7 @@
(= op :local) (let [r (get env (get node :name))] (= op :local) (let [r (get env (get node :name))]
;; carry the param's ^:struct hint onto a let-bound fresh ;; carry the param's ^:struct hint onto a let-bound fresh
;; local, so lookups inside the inlined body keep the bare ;; local, so lookups inside the inlined body keep the bare
;; (no-guard) path (jolt-dad). The param hint asserts the ;; (no-guard) path. The param hint asserts the
;; arg is a struct; inlining doesn't change that contract. ;; arg is a struct; inlining doesn't change that contract.
(if r (if r
(if (and (= :local (get r :op)) (get node :hint) (not (get r :hint))) (if (and (= :local (get r :op)) (get node :hint) (not (get r :hint)))
@ -256,7 +256,7 @@
;; forward ref: a record ctor (allocating an immutable struct from its args) is ;; forward ref: a record ctor (allocating an immutable struct from its args) is
;; side-effect-free, so pure? treats (->Rec pure-args..) as pure — which lets a ;; side-effect-free, so pure? treats (->Rec pure-args..) as pure — which lets a
;; nested record (a Ray holding a Vec3) fold bottom-up (jolt-15jq). ;; nested record (a Ray holding a Vec3) fold bottom-up.
(declare ctor-shape) (declare ctor-shape)
(defn- pure? (defn- pure?
@ -427,7 +427,7 @@
(= op :def) (local-escapes? (get node :init) nm) (= op :def) (local-escapes? (get node :init) nm)
:else true))) :else true)))
;; --- record constructors as foldable struct sources (jolt-15jq) ------------- ;; --- record constructors as foldable struct sources -------------------------
;; A record ctor (->Rec a b ..) is a positional struct: the registry maps its ;; A record ctor (->Rec a b ..) is a positional struct: the registry maps its
;; ctor key ("ns/->Name", exactly how the IR names the call head) to the DECLARED ;; ctor key ("ns/->Name", exactly how the IR names the call head) to the DECLARED
;; field order. A field read on a non-escaping ctor folds to the matching arg, ;; field order. A field read on a non-escaping ctor folds to the matching arg,

View file

@ -1,14 +1,14 @@
(ns jolt.passes.types (ns jolt.passes.types
"Collection-type inference (jolt-99x) and success-type checking (RFC 0006). "Collection-type inference and success-type checking (RFC 0006).
A forward, soft-typing pass (simplified HM: monovariant, never-fails, lattice A forward, soft-typing pass (simplified HM: monovariant, never-fails, lattice
top = :any) that types expressions and reuses the SAME walk as a loose success top = :any) that types expressions and reuses the same walk as a loose success
checker. Also the inter-procedural driver API (jolt-767) the back end calls to checker. Also the inter-procedural driver API the back end calls to
propagate param types across a unit / the whole program. Weakly coupled to the propagate param types across a unit / the whole program. Weakly coupled to the
IR-rewriting passes shares only the const-shape predicate (jolt.passes.fold)." IR-rewriting passes shares only the const-shape predicate (jolt.passes.fold)."
(:require [jolt.passes.fold :refer [scalar-const?]])) (:require [jolt.passes.fold :refer [scalar-const?]]))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; Collection-type inference (jolt-99x), Phase 0: intra-procedural. A forward, ;; Collection-type inference, intra-procedural. A forward,
;; soft-typing-style pass (simplified HM: monovariant, never-fails, lattice top ;; soft-typing-style pass (simplified HM: monovariant, never-fails, lattice top
;; = :any) that types expressions from literals/arithmetic and flows the type ;; = :any) that types expressions from literals/arithmetic and flows the type
;; through let bindings and if-joins. Where a keyword-lookup subject is PROVEN a ;; through let bindings and if-joins. Where a keyword-lookup subject is PROVEN a
@ -39,7 +39,7 @@
(defn- mk-set [t] {:set (if t t :any)}) (defn- mk-set [t] {:set (if t t :any)})
(defn- mk-struct [fs] {:struct fs}) (defn- mk-struct [fs] {:struct fs})
;; Bounded union types (RFC 0006 / jolt-pz5). A union {:union #{T...}} records ;; Bounded union types (RFC 0006). A union {:union #{T...}} records
;; that a value is provably one of a small, fixed set of SCALAR types — what ;; that a value is provably one of a small, fixed set of SCALAR types — what
;; differing if-branches used to collapse to :any. It exists so the success ;; differing if-branches used to collapse to :any. It exists so the success
;; checker can reject a use where EVERY member is in the op's error domain ;; checker can reject a use where EVERY member is in the op's error domain
@ -86,7 +86,7 @@
(and (struct-type? a) (struct-type? b)) (and (struct-type? a) (struct-type? b))
(let [merged (mk-struct (merge-fields (sfields a) (sfields b)))] (let [merged (mk-struct (merge-fields (sfields a) (sfields b)))]
;; joining two values of the SAME complete shape preserves it — the ;; joining two values of the SAME complete shape preserves it — the
;; merged struct has the same key set (jolt-t34 R2). Different shapes ;; merged struct has the same key set. Different shapes
;; (or an incomplete side) drop it, as the layout is no longer proven. ;; (or an incomplete side) drop it, as the layout is no longer proven.
(if (and (get a :shape) (= (get a :shape) (get b :shape))) (if (and (get a :shape) (= (get a :shape) (get b :shape)))
(assoc merged :shape (get a :shape)) (assoc merged :shape (get a :shape))
@ -94,7 +94,7 @@
(and (vec-type? a) (vec-type? b)) (mk-vec (join-t (velem a) (velem b))) (and (vec-type? a) (vec-type? b)) (mk-vec (join-t (velem a) (velem b)))
(and (set-type? a) (set-type? b)) (mk-set (join-t (selem a) (selem b))) (and (set-type? a) (set-type? b)) (mk-set (join-t (selem a) (selem b)))
;; differing kinds: form a scalar union when both sides reduce to scalars ;; differing kinds: form a scalar union when both sides reduce to scalars
;; (or scalar unions); anything compound on either side stays :any (jolt-pz5) ;; (or scalar unions); anything compound on either side stays :any
:else (let [ma (cond (union-type? a) (umembers a) (scalar-t? a) #{a} :else nil) :else (let [ma (cond (union-type? a) (umembers a) (scalar-t? a) #{a} :else nil)
mb (cond (union-type? b) (umembers b) (scalar-t? b) #{b} :else nil)] mb (cond (union-type? b) (umembers b) (scalar-t? b) #{b} :else nil)]
(if (and ma mb) (union-of (reduce conj ma mb)) :any)))) (if (and ma mb) (union-of (reduce conj ma mb)) :any))))
@ -108,25 +108,25 @@
(struct-type? t) (struct-type? t)
;; capping truncates VALUES below depth d, but the KEY SET is unchanged, so ;; capping truncates VALUES below depth d, but the KEY SET is unchanged, so
;; a complete :shape survives — keep it so nested/container field reads can ;; a complete :shape survives — keep it so nested/container field reads can
;; still bare-index (jolt-t34 R2). cap recurses into fields, so a nested ;; still bare-index. cap recurses into fields, so a nested
;; shaped value (a vec3 inside a hit-info) keeps its own :shape too. ;; shaped value (a vec3 inside a hit-info) keeps its own :shape too.
(let [capped (mk-struct (reduce (fn [m k] (assoc m k (cap (get (sfields t) k) (dec d)))) (let [capped (mk-struct (reduce (fn [m k] (assoc m k (cap (get (sfields t) k) (dec d))))
{} (keys (sfields t)))) {} (keys (sfields t))))
;; the record :type tag (and :shape) are independent of field-value ;; the record :type tag (and :shape) are independent of field-value
;; depth, so they survive truncation — a record read from a deep ;; depth, so they survive truncation — a record read from a deep
;; container keeps its identity, so devirtualization (jolt-41m), ;; container keeps its identity, so devirtualization, record? folding,
;; record? folding, and the record fast path still fire on it. ;; and the record fast path still fire on it.
capped (if (get t :shape) (assoc capped :shape (get t :shape)) capped) capped (if (get t :shape) (assoc capped :shape (get t :shape)) capped)
capped (if (get t :type) (assoc capped :type (get t :type)) capped)] capped (if (get t :type) (assoc capped :type (get t :type)) capped)]
capped) capped)
(vec-type? t) (mk-vec (cap (velem t) (dec d))) (vec-type? t) (mk-vec (cap (velem t) (dec d)))
(set-type? t) (mk-set (cap (selem t) (dec d))) (set-type? t) (mk-set (cap (selem t) (dec d)))
:else t)) :else t))
;; raw-get-safe (a Janet struct / record): a struct type. The field type of key ;; raw-get-safe (a struct / record): a struct type. The field type of key
;; k, if known, else :any. ;; k, if known, else :any.
(defn- struct-safe? [t] (struct-type? t)) (defn- struct-safe? [t] (struct-type? t))
(defn- field-type [t k] (if (struct-type? t) (get (sfields t) k :any) :any)) (defn- field-type [t k] (if (struct-type? t) (get (sfields t) k :any) :any))
;; Shape (hidden class, jolt-t34). A struct type built from a map LITERAL carries ;; Shape (hidden class). A struct type built from a map LITERAL carries
;; its complete layout — :shape, the canonical (str-sorted) key vector. The back ;; its complete layout — :shape, the canonical (str-sorted) key vector. The back
;; end represents such a map as a shape tuple and reads a field by bare index. ;; end represents such a map as a shape tuple and reads a field by bare index.
;; A struct type from a JOIN or from field-access inference has no :shape ;; A struct type from a JOIN or from field-access inference has no :shape
@ -141,7 +141,7 @@
;; a lookup whose SUBJECT is that node — this is what makes nested access work: ;; a lookup whose SUBJECT is that node — this is what makes nested access work:
;; (:direction ray) is tagged struct, so (:r (:direction ray)) drops its guard. ;; (:direction ray) is tagged struct, so (:r (:direction ray)) drops its guard.
;; tag a lookup subject as a struct, carrying the complete shape when known ;; tag a lookup subject as a struct, carrying the complete shape when known
;; (so the back end bare-indexes) — jolt-t34 ;; (so the back end bare-indexes).
(defn- mark-struct [node t] (defn- mark-struct [node t]
(let [n (assoc node :hint :struct)] (let [n (assoc node :hint :struct)]
(if (get t :shape) (assoc n :shape (get t :shape)) n))) (if (get t :shape) (assoc n :shape (get t :shape)) n)))
@ -159,7 +159,7 @@
"bit-and" "bit-or" "bit-xor" "count"}) "bit-and" "bit-or" "bit-xor" "count"})
(def ^:private vector-ret-fns #{"vec" "vector" "mapv" "filterv" "subvec"}) (def ^:private vector-ret-fns #{"vec" "vector" "mapv" "filterv" "subvec"})
;; Inter-procedural state (jolt-767, Phase 1). The Janet orchestrator (backend ;; Inter-procedural state. The orchestrator (backend
;; infer-unit!) drives a whole-unit fixpoint: before typing a fn body it installs ;; infer-unit!) drives a whole-unit fixpoint: before typing a fn body it installs
;; the current return-type estimates of all unit fns here, and after typing it ;; the current return-type estimates of all unit fns here, and after typing it
;; reads back the call sites this body made (callee + inferred arg types) to ;; reads back the call sites this body made (callee + inferred arg types) to
@ -168,12 +168,12 @@
(def ^:private calls-box (atom [])) ;; collected [ "ns/name" [arg-types...] ] (def ^:private calls-box (atom [])) ;; collected [ "ns/name" [arg-types...] ]
(def ^:private escapes-box (atom #{})) ;; var-keys used as a VALUE (not a call head) (def ^:private escapes-box (atom #{})) ;; var-keys used as a VALUE (not a call head)
(def ^:private diag-box (atom [])) ;; success-type-check diagnostics (RFC 0006) (def ^:private diag-box (atom [])) ;; success-type-check diagnostics (RFC 0006)
;; jolt-d6u: a var reference's VALUE type — a fn var is :truthy (non-nil), a def ;; a var reference's VALUE type — a fn var is :truthy (non-nil), a def
;; var carries its inferred init type (e.g. a color table -> {:vec :struct-map}). ;; var carries its inferred init type (e.g. a color table -> {:vec :struct-map}).
;; The orchestrator populates this from sealed (opt-mode) cell roots + def inits. ;; The orchestrator populates this from sealed (opt-mode) cell roots + def inits.
(def ^:private vtype-box (atom {})) ;; "ns/name" -> value type (def ^:private vtype-box (atom {})) ;; "ns/name" -> value type
;; User-function error domains (jolt-zo1), opt-in. As the checker walks defs it ;; User-function error domains, opt-in. As the checker walks defs it
;; registers each non-redefinable single-fixed-arity user fn's {:params :body} ;; registers each non-redefinable single-fixed-arity user fn's {:params :body}
;; here, keyed "ns/name". At a later call site (strict mode only) the body is ;; here, keyed "ns/name". At a later call site (strict mode only) the body is
;; re-checked with ONE parameter bound to its concrete argument type — if that ;; re-checked with ONE parameter bound to its concrete argument type — if that
@ -181,17 +181,17 @@
;; provably wrong and the CALL is reported. Module state, like rtenv-box: a def ;; provably wrong and the CALL is reported. Module state, like rtenv-box: a def
;; must precede its call (the same closed-world ordering RFC 0005 assumes). ;; must precede its call (the same closed-world ordering RFC 0005 assumes).
(def ^:private user-sig-box (atom {})) ;; "ns/name" -> {:params [..] :body ir} (def ^:private user-sig-box (atom {})) ;; "ns/name" -> {:params [..] :body ir}
;; jolt-t34: a record constructor's return shape. "ns/->Name" -> [field-kw ...] ;; a record constructor's return shape. "ns/->Name" -> [field-kw ...]
;; in DECLARED order (the runtime lays records out in declared field order, so ;; in DECLARED order (the runtime lays records out in declared field order, so
;; the back end bare-indexes by that order). A call (->Point a b) types as a ;; the back end bare-indexes by that order). A call (->Point a b) types as a
;; struct of this shape, so field reads on the result bare-index — declared ;; struct of this shape, so field reads on the result bare-index — declared
;; shapes are clean fuel: a lookup, not fragile inference. ;; shapes are clean fuel: a lookup, not fragile inference.
(def ^:private record-shapes-box (atom {})) (def ^:private record-shapes-box (atom {}))
;; jolt-41m: protocol-method registry "ns/method" -> [proto method], for ;; protocol-method registry "ns/method" -> [proto method], for
;; devirtualizing a protocol call whose receiver is a known record type. ;; devirtualizing a protocol call whose receiver is a known record type.
(def ^:private protocol-methods-box (atom {})) (def ^:private protocol-methods-box (atom {}))
;; jolt-3ko: build a record's struct TYPE from its registry entry, resolving each ;; build a record's struct TYPE from its registry entry, resolving each
;; field's declared type hint. A field tagged with a record type (its ctor-key) ;; field's declared type hint. A field tagged with a record type (its ctor-key)
;; recurses, so a Vec3 stored in a Ray field reads back as Vec3 — not :any — ;; recurses, so a Vec3 stored in a Ray field reads back as Vec3 — not :any —
;; which is what lets nested-record code prove its reads. Depth-bounded so a ;; which is what lets nested-record code prove its reads. Depth-bounded so a
@ -211,7 +211,7 @@
(field-type-from-tag (when tags (nth tags i)) (dec depth)))) (field-type-from-tag (when tags (nth tags i)) (dec depth))))
{} (range (count fields)))] {} (range (count fields)))]
(assoc (mk-struct fmap) :shape (vec fields) :type (get rs :type)))) (assoc (mk-struct fmap) :shape (vec fields) :type (get rs :type))))
;; jolt-t34: whether to shape generic const-key MAP literals (opt-in, JOLT_SHAPE). ;; whether to shape generic const-key MAP literals (opt-in, JOLT_SHAPE).
;; Records are shaped regardless; maps only when this is on. ;; Records are shaped regardless; maps only when this is on.
(def ^:private map-shapes-box (atom false)) (def ^:private map-shapes-box (atom false))
(def ^:private checking-box (atom #{})) ;; keys mid-recheck — cycle guard (def ^:private checking-box (atom #{})) ;; keys mid-recheck — cycle guard
@ -238,10 +238,10 @@
;; a user fn whose return type the fixpoint has estimated ;; a user fn whose return type the fixpoint has estimated
(= op :var) (let [rs (get @record-shapes-box (var-key fnode))] (= op :var) (let [rs (get @record-shapes-box (var-key fnode))]
(if rs (if rs
;; record ctor -> struct of declared shape (jolt-t34); :shape ;; record ctor -> struct of declared shape; :shape
;; is the DECLARED field order the back end indexes by, :type ;; is the DECLARED field order the back end indexes by, :type
;; the record tag (devirt), and field types come from the ;; the record tag (devirt), and field types come from the
;; declared hints so nested records stay typed (jolt-3ko) ;; declared hints so nested records stay typed
(record-type-from-entry rs type-depth) (record-type-from-entry rs type-depth)
(let [r (get @rtenv-box (var-key fnode))] (let [r (get @rtenv-box (var-key fnode))]
(if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))] (if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))]
@ -255,7 +255,7 @@
:else :any)) :else :any))
:else :any))) :else :any)))
;; Predicate folding (jolt-wcw): a type predicate whose argument's type is ;; Predicate folding: a type predicate whose argument's type is
;; PROVEN folds to a compile-time boolean. Only the precise tags are folded — ;; PROVEN folds to a compile-time boolean. Only the precise tags are folded —
;; :num/:str/:kw mean exactly that scalar, and a record carries its defrecord ;; :num/:str/:kw mean exactly that scalar, and a record carries its defrecord
;; :type tag. NOT folded: vector?/set?/map?, because the :vec tag conflates a ;; :type tag. NOT folded: vector?/set?/map?, because the :vec tag conflates a
@ -289,8 +289,8 @@
(declare infer) (declare infer)
;; HOFs that apply their fn arg to the ELEMENTS of a collection (jolt-d6u, ;; HOFs that apply their fn arg to the ELEMENTS of a collection. :epos is which
;; Phase 3). :epos is which param of the fn receives an element. reduce is ;; param of the fn receives an element. reduce is
;; handled separately (its arity changes the coll position, and its closure ;; handled separately (its arity changes the coll position, and its closure
;; also takes an accumulator). ;; also takes an accumulator).
(def ^:private hof-table (def ^:private hof-table
@ -353,7 +353,7 @@
base (when struct? base (when struct?
(cap (mk-struct (reduce (fn [m r] (assoc m (nth r 3) (nth r 2))) {} res)) type-depth)) (cap (mk-struct (reduce (fn [m r] (assoc m (nth r 3) (nth r 2))) {} res)) type-depth))
;; a literal is a COMPLETE shape: carry its sorted key vector so the ;; a literal is a COMPLETE shape: carry its sorted key vector so the
;; back end can lay it out and bare-index lookups (jolt-t34) ;; back end can lay it out and bare-index lookups
shp (when (and @map-shapes-box base (struct-type? base)) (shape-order (keys (sfields base)))) shp (when (and @map-shapes-box base (struct-type? base)) (shape-order (keys (sfields base))))
t (if base (if shp (assoc base :shape shp) base) :any) t (if base (if shp (assoc base :shape shp) base) :any)
node' (assoc node :pairs (mapv (fn [r] [(nth r 0) (nth r 1)]) res))] node' (assoc node :pairs (mapv (fn [r] [(nth r 0) (nth r 1)]) res))]
@ -393,7 +393,7 @@
args (get node :args) args (get node :args)
n (count args)] n (count args)]
(cond (cond
;; predicate folding (jolt-wcw): a type predicate over a single, ;; predicate folding: a type predicate over a single,
;; side-effect-free argument whose type PROVES the answer becomes a ;; side-effect-free argument whose type PROVES the answer becomes a
;; boolean constant — eliminating the call, and (once const-fold runs ;; boolean constant — eliminating the call, and (once const-fold runs
;; after inference) collapsing any `if` it gates. Falls through to the ;; after inference) collapsing any `if` it gates. Falls through to the
@ -427,7 +427,7 @@
dr (when (= n 3) (infer (nth args 2) tenv))] dr (when (= n 3) (infer (nth args 2) tenv))]
[(if dr (join ft (nth dr 0)) ft) [(if dr (join ft (nth dr 0)) ft)
(assoc node :args (if dr [msub (nth kr 1) (nth dr 1)] [msub (nth kr 1)]))]) (assoc node :args (if dr [msub (nth kr 1) (nth dr 1)] [msub (nth kr 1)]))])
;; reduce over a typed vector with a fn-literal (jolt-d6u): seed the ;; reduce over a typed vector with a fn-literal: seed the
;; closure's accumulator (param 0) to the init type and its element ;; closure's accumulator (param 0) to the init type and its element
;; (param 1) to the vector's element type, so its body — and any calls ;; (param 1) to the vector's element type, so its body — and any calls
;; it makes — see those types. ;; it makes — see those types.
@ -471,7 +471,7 @@
fnode' (if iscall-var fnode (nth fr 1)) fnode' (if iscall-var fnode (nth fr 1))
;; the callee's value type: a var's from vtype-box (a fn is ;; the callee's value type: a var's from vtype-box (a fn is
;; :truthy, a def carries its inferred type), else the inferred ;; :truthy, a def carries its inferred type), else the inferred
;; type of the callee expression (jolt-wwy) ;; type of the callee expression
callee-t (if iscall-var (get @vtype-box (var-key fnode)) (nth fr 0)) callee-t (if iscall-var (get @vtype-box (var-key fnode)) (nth fr 0))
ares (mapv (fn [a] (infer a tenv)) args)] ares (mapv (fn [a] (infer a tenv)) args)]
(when iscall-var (when iscall-var
@ -482,7 +482,7 @@
(when @checking? (when @checking?
(let [ats (mapv (fn [r] (nth r 0)) ares) pos (get node :pos)] (let [ats (mapv (fn [r] (nth r 0)) ares) pos (get node :pos)]
(when cn (check-invoke cn args ats pos)) (when cn (check-invoke cn args ats pos))
;; calling a provably non-function (jolt-wwy) ;; calling a provably non-function
(when (not-callable? callee-t) (when (not-callable? callee-t)
(swap! diag-box conj (swap! diag-box conj
{:op :call :type (type-name callee-t) :pos pos {:op :call :type (type-name callee-t) :pos pos
@ -490,7 +490,7 @@
(when (and @strict-box iscall-var) (when (and @strict-box iscall-var)
(let [k (var-key fnode) usig (get @user-sig-box k)] (let [k (var-key fnode) usig (get @user-sig-box k)]
(when usig (check-user-call k usig ats pos)))))) (when usig (check-user-call k usig ats pos))))))
;; devirtualization (jolt-41m): a protocol-method call whose receiver ;; devirtualization: a protocol-method call whose receiver
;; (arg 0) is a known record type resolves to a direct method call. ;; (arg 0) is a known record type resolves to a direct method call.
;; Annotate the node with [type-tag proto method]; the back end looks ;; Annotate the node with [type-tag proto method]; the back end looks
;; up the impl at emit time and calls it directly, skipping the ;; up the impl at emit time and calls it directly, skipping the
@ -517,7 +517,7 @@
[(nth br 0) (assoc node :bindings (nth res 1) :body (nth br 1))]) [(nth br 0) (assoc node :bindings (nth res 1) :body (nth br 1))])
(= op :loop) (= op :loop)
;; conservative + sound: loop bindings join across recur, which we don't ;; conservative + sound: loop bindings join across recur, which we don't
;; track in Phase 0, so they stay :any. Still descend to annotate any ;; track here, so they stay :any. Still descend to annotate any
;; known-type lookups inside the body. ;; known-type lookups inside the body.
[:any (assoc node [:any (assoc node
:bindings (mapv (fn [b] [(nth b 0) (nth (infer (nth b 1) tenv) 1)]) (get node :bindings)) :bindings (mapv (fn [b] [(nth b 0) (nth (infer (nth b 1) tenv) 1)]) (get node :bindings))
@ -531,7 +531,7 @@
;; (:phints, name -> ctor-key) — then seed it to that record type so field ;; (:phints, name -> ctor-key) — then seed it to that record type so field
;; reads off it bare-index per-form, not only under whole-program. This is ;; reads off it bare-index per-form, not only under whole-program. This is
;; what makes a protocol method's `this` (hinted by defrecord/extend-type) ;; what makes a protocol method's `this` (hinted by defrecord/extend-type)
;; read its fields without the runtime tag guard (jolt-3ko). ;; read its fields without the runtime tag guard.
[:any (assoc node :arities [:any (assoc node :arities
(mapv (fn [a] (mapv (fn [a]
(let [phm (reduce (fn [m pr] (assoc m (nth pr 0) (nth pr 1))) (let [phm (reduce (fn [m pr] (assoc m (nth pr 0) (nth pr 1)))
@ -565,7 +565,7 @@
;; cases; lenient ops ((get 5 :k) -> nil, (:k 5) -> nil) are NOT listed. ;; cases; lenient ops ((get 5 :k) -> nil, (:k 5) -> nil) are NOT listed.
;; concrete non-numbers: arithmetic provably throws on these. A union is in the ;; concrete non-numbers: arithmetic provably throws on these. A union is in the
;; error domain only when EVERY member is (jolt-pz5) — if any member is an ;; error domain only when EVERY member is — if any member is an
;; accepted type the call is accepted (no false positive). ;; accepted type the call is accepted (no false positive).
(defn- not-number? [t] (defn- not-number? [t]
(if (union-type? t) (if (union-type? t)
@ -581,7 +581,7 @@
(every? not-seqable? (umembers t)) (every? not-seqable? (umembers t))
(or (= t :num) (= t :kw)))) (or (= t :num) (= t :kw))))
;; concrete non-callable values (jolt-wwy): calling them throws "Cannot call X ;; concrete non-callable values: calling them throws "Cannot call X
;; as a function". Only :num and :str — keywords/maps/vectors/sets are IFn, ;; as a function". Only :num and :str — keywords/maps/vectors/sets are IFn,
;; :truthy/:any/:nil are ambiguous (accepted). A union is non-callable only when ;; :truthy/:any/:nil are ambiguous (accepted). A union is non-callable only when
;; every member is. ;; every member is.
@ -615,7 +615,7 @@
(defn- check-invoke (defn- check-invoke
"If node is a core-op call whose argument type is provably in the error domain, "If node is a core-op call whose argument type is provably in the error domain,
conj a diagnostic. arg-types is the vector of inferred argument types; pos is conj a diagnostic. arg-types is the vector of inferred argument types; pos is
the call form's source offset (jolt-fqy), carried into each diagnostic." the call form's source offset, carried into each diagnostic."
[cn args arg-types pos] [cn args arg-types pos]
(cond (cond
(contains? num-ops cn) (contains? num-ops cn)
@ -638,7 +638,7 @@
", but argument 1 is " (type-name t))}))) ", but argument 1 is " (type-name t))})))
:else nil)) :else nil))
;; --- user-function error domains (jolt-zo1), opt-in -------------------------- ;; --- user-function error domains, opt-in -------------------------------------
(defn- all-any-env (defn- all-any-env
"tenv binding every param name to :any (the all-ambiguous baseline)." "tenv binding every param name to :any (the all-ambiguous baseline)."
[params] [params]
@ -677,7 +677,7 @@
(defn- check-user-call (defn- check-user-call
"Strict mode: report a call to a registered user fn that provably throws "Strict mode: report a call to a registered user fn that provably throws
either a WRONG ARITY (the registered fn has one fixed arity, so a different either a WRONG ARITY (the registered fn has one fixed arity, so a different
arg count always throws, jolt-wwy) or an argument whose concrete type the body arg count always throws) or an argument whose concrete type the body
rejects. For the latter, re-check the body with ONLY that parameter bound to rejects. For the latter, re-check the body with ONLY that parameter bound to
its arg type (others :any); a diagnostic the all-:any body did not already its arg type (others :any); a diagnostic the all-:any body did not already
have means the argument alone is provably wrong. Monotonic binding a have means the argument alone is provably wrong. Monotonic binding a
@ -715,13 +715,13 @@
nil (range npar))))) nil (range npar)))))
(reset! checking-box prev)))) (reset! checking-box prev))))
;; --- Inter-procedural driver API (jolt-767) consumed by the back end -------- ;; --- Inter-procedural driver API consumed by the back end -------------------
(defn set-rtenv! (defn set-rtenv!
"Install the current return-type estimates (a map \"ns/name\" -> type) used to "Install the current return-type estimates (a map \"ns/name\" -> type) used to
type call results during the fixpoint." type call results during the fixpoint."
[m] (reset! rtenv-box m)) [m] (reset! rtenv-box m))
;; jolt-t34: install record-ctor shapes ("ns/->Name" -> [field-kw ...]) and the ;; install record-ctor shapes ("ns/->Name" -> [field-kw ...]) and the
;; map-shaping flag (opt-in JOLT_SHAPE), both read by infer. ;; map-shaping flag (opt-in JOLT_SHAPE), both read by infer.
(defn set-record-shapes! [m] (reset! record-shapes-box (or m {}))) (defn set-record-shapes! [m] (reset! record-shapes-box (or m {})))
(defn set-protocol-methods! [m] (reset! protocol-methods-box (or m {}))) (defn set-protocol-methods! [m] (reset! protocol-methods-box (or m {})))
@ -729,7 +729,7 @@
(defn set-vtypes! (defn set-vtypes!
"Install var VALUE types (a map \"ns/name\" -> type): fn vars are :truthy "Install var VALUE types (a map \"ns/name\" -> type): fn vars are :truthy
(non-nil), def vars carry their inferred init type (jolt-d6u)." (non-nil), def vars carry their inferred init type."
[m] (reset! vtype-box m)) [m] (reset! vtype-box m))
(defn join-types (defn join-types
@ -747,7 +747,7 @@
usable in normal builds (the decoupled checking path). usable in normal builds (the decoupled checking path).
With strict? true, also reports calls to registered user functions whose With strict? true, also reports calls to registered user functions whose
concrete argument types provably make the body throw (jolt-zo1, opt-in, concrete argument types provably make the body throw (opt-in,
closed-world). user-sig-box accumulates registered defs across forms, so a closed-world). user-sig-box accumulates registered defs across forms, so a
def must precede its call the same ordering RFC 0005 already assumes." def must precede its call the same ordering RFC 0005 already assumes."
([node] (check-form node false)) ([node] (check-form node false))
@ -810,7 +810,7 @@
propagates to a fn's callees DURING inference not only at the final re-emit propagates to a fn's callees DURING inference not only at the final re-emit
(reinfer-def). Without it a hinted param with no callers stays :any through the (reinfer-def). Without it a hinted param with no callers stays :any through the
fixpoint, so a field read off it (e.g. (:origin ^Ray r)) never tells a shared fixpoint, so a field read off it (e.g. (:origin ^Ray r)) never tells a shared
callee its arg is a Vec3 (jolt-3ko)." callee its arg is a Vec3."
[params phints] [params phints]
(let [m (reduce (fn [acc pr] (assoc acc (nth pr 0) (nth pr 1))) {} phints)] (let [m (reduce (fn [acc pr] (assoc acc (nth pr 0) (nth pr 1))) {} phints)]
(mapv (fn [nm] (mapv (fn [nm]

View file

@ -1,22 +1,16 @@
(ns jolt.reader (ns jolt.reader
"Portable Clojure reader: source text -> reader forms (Chez Phase 3, jolt-cf1q.4). "Reads Clojure source text into reader forms.
All the lexing/parsing LOGIC The lexing and parsing is portable Clojure; form construction and
is portable Clojure; form CONSTRUCTION and string->number parsing delegate to the string->number parsing delegate to the jolt.host contract (form-make-symbol/
jolt.host contract (form-make-symbol/char, form-char-from-name, form-scan-number) char, form-char-from-name, form-scan-number). A Clojure source file can't write
a Clojure source file cannot write a {:jolt/type :symbol} literal (it parses as a {:jolt/type :symbol} literal it would parse as a tagged reader form and
a tagged reader form), and the concrete form representation is the host's to own. the concrete form representation belongs to the host. The analyzer uses the same
Same split the analyzer uses for the form-* readers. Once cross-compiled this runs split. Once cross-compiled this runs on Chez to drive compile-from-source.
ON Chez to drive compile-from-source.
Positions are CHARACTER indices; for ASCII Positions are character indices; for ASCII source they coincide with byte
source they coincide with byte indices, and form VALUES are identical either way the parity gate indices, and form values are identical either way the parity gate compares
compares values, not positions. values, not positions."
INCREMENT 5a (jolt-50xx): the ATOM layer whitespace/comments, symbols (+ nil/
true/false), keywords, strings, numbers (sign/hex/radix/ratio/fractional/
exponent, trailing N/M), characters. Collections, quote/deref/meta, and dispatch
(#) land in 5b/5c (they throw not-yet-ported so a hit is loud)."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[jolt.host :refer [form-make-symbol form-make-char form-char-from-name [jolt.host :refer [form-make-symbol form-make-char form-char-from-name
form-scan-number form-make-list form-make-vector form-scan-number form-make-list form-make-vector
@ -213,8 +207,8 @@
[:form (form-make-vector items) end])) [:form (form-make-vector items) end]))
;; Map: pair up keys and values, skipping comments/#_ in either slot while keeping ;; Map: pair up keys and values, skipping comments/#_ in either slot while keeping
;; the pending key (dropping both desyncs the pairing). Splice in a map slot lands ;; the pending key (dropping both desyncs the pairing). A key/value is always a
;; in inc 5c; here a key/value is always a single :form (or :skip). ;; single :form (or :skip) — splice in a map slot is not supported.
(defn- read-map* [s pos] (defn- read-map* [s pos]
(loop [pos (inc pos) kvs []] (loop [pos (inc pos) kvs []]
(let [pos (skip-whitespace s pos)] (let [pos (skip-whitespace s pos)]

View file

@ -1,119 +0,0 @@
;; Phase 0c — persistent-collection perf experiment.
;;
;; Decides shim-vs-self-hosted for collections: is a persistent HAMT fast enough
;; on the Chez substrate that we can afford to SELF-HOST it (in Clojure compiled
;; by Chez) rather than keep it in the Scheme shim? This measures the substrate
;; ceiling with a hand-written Scheme HAMT (what the backend would emit) against
;; Chez's native mutable hashtable (the non-persistent lower bound), on the
;; collections-bench map workload (freq-map + sum-vals, n keys mod 4096).
;; chez --script collections-experiment.ss [n=30000] [optlevel=2]
(import (chezscheme))
(optimize-level
(let ((a (command-line-arguments)))
(if (and (pair? a) (pair? (cdr a))) (string->number (cadr a)) 2)))
;; ---- persistent bitmap HAMT (assoc/get), 5 bits/level, integer-key hash ------
(define-record-type hnode (fields bitmap arr) (nongenerative hnode-v1))
(define empty-map (make-hnode 0 (vector)))
(define (popcount n)
(let loop ((n n) (c 0)) (if (fx=? n 0) c (loop (fxand n (fx- n 1)) (fx+ c 1)))))
(define (mask h shift) (fxand (fxsra h shift) 31))
(define (idxof bitmap bit) (popcount (fxand bitmap (fx- bit 1))))
(define (vec-insert v i x)
(let* ((n (vector-length v)) (out (make-vector (fx+ n 1))))
(let loop ((j 0))
(when (fx<? j i) (vector-set! out j (vector-ref v j)) (loop (fx+ j 1))))
(vector-set! out i x)
(let loop ((j i)) (when (fx<? j n) (vector-set! out (fx+ j 1) (vector-ref v j)) (loop (fx+ j 1))))
out))
(define (vec-set v i x)
(let ((out (vector-copy v))) (vector-set! out i x) out))
;; leaf = (cons key val); subtree = hnode
(define (merge-leaves shift k1h e1 k2h k2 v2)
(if (fx>? shift 30)
;; hash exhausted (won't happen for distinct small ints) — chain via assoc-list leaf
(cons 'collision (list e1 (cons k2 v2)))
(let ((i1 (mask k1h shift)) (i2 (mask k2h shift)))
(if (fx=? i1 i2)
(let ((sub (merge-leaves (fx+ shift 5) k1h e1 k2h k2 v2)))
(make-hnode (fxsll 1 i1) (vector sub)))
(let* ((b1 (fxsll 1 i1)) (b2 (fxsll 1 i2)))
(if (fx<? i1 i2)
(make-hnode (fxior b1 b2) (vector e1 (cons k2 v2)))
(make-hnode (fxior b1 b2) (vector (cons k2 v2) e1))))))))
(define (assoc-h node shift h key val)
(let* ((bit (fxsll 1 (mask h shift)))
(bm (hnode-bitmap node))
(arr (hnode-arr node)))
(if (fx=? 0 (fxand bm bit))
(make-hnode (fxior bm bit) (vec-insert arr (idxof bm bit) (cons key val)))
(let* ((i (idxof bm bit)) (child (vector-ref arr i)))
(cond
((hnode? child)
(make-hnode bm (vec-set arr i (assoc-h child (fx+ shift 5) h key val))))
((eqv? (car child) key) ; leaf, same key -> replace
(make-hnode bm (vec-set arr i (cons key val))))
(else ; leaf, diff key -> split
(make-hnode bm (vec-set arr i (merge-leaves (fx+ shift 5)
(car child) child h key val)))))))))
(define (assoc-map m key val) (assoc-h m 0 key key val)) ; hash = key (distinct small ints)
(define (get-h node shift h key default)
(let* ((bit (fxsll 1 (mask h shift))) (bm (hnode-bitmap node)))
(if (fx=? 0 (fxand bm bit)) default
(let ((child (vector-ref (hnode-arr node) (idxof bm bit))))
(cond ((hnode? child) (get-h child (fx+ shift 5) h key default))
((eqv? (car child) key) (cdr child))
(else default))))))
(define (get-map m key default) (get-h m 0 key key default))
;; ---- workloads (mirror bench/collections.clj freq-map + sum-vals) ------------
(define buckets 4096)
(define (freq-hamt n)
(let loop ((i 0) (m empty-map))
(if (fx<? i n)
(let ((k (fxmod (fx* i 2654435761) buckets)))
(loop (fx+ i 1) (assoc-map m k (fx+ 1 (get-map m k 0)))))
m)))
(define (freq-native n)
(let ((m (make-eqv-hashtable)))
(let loop ((i 0))
(if (fx<? i n)
(let ((k (fxmod (fx* i 2654435761) buckets)))
(hashtable-set! m k (fx+ 1 (hashtable-ref m k 0)))
(loop (fx+ i 1)))
m))))
;; sum back: HAMT walk vs native walk
(define (sum-hamt m)
(let walk ((node m) (acc 0))
(let ((arr (hnode-arr node)))
(let loop ((j 0) (acc acc))
(if (fx<? j (vector-length arr))
(let ((c (vector-ref arr j)))
(loop (fx+ j 1) (if (hnode? c) (walk c acc) (fx+ acc (cdr c)))))
acc)))))
(define (sum-native m) (call-with-values (lambda () (hashtable-entries m))
(lambda (ks vs) (let ((acc 0)) (vector-for-each (lambda (v) (set! acc (fx+ acc v))) vs) acc))))
;; ---- bench harness -----------------------------------------------------------
(define (now-ns) (let ((t (current-time 'time-monotonic)))
(+ (* (time-second t) 1000000000) (time-nanosecond t))))
(define (bench name build sum n)
(sum (build (quotient n 4))) (sum (build (quotient n 4))) ; warmup
(let loop ((k 0) (acc '()) (r 0))
(if (fx<? k 3)
(let* ((t0 (now-ns)) (m (build n)) (s (sum m))
(ms (/ (- (now-ns) t0) 1000000.0)))
(loop (fx+ k 1) (cons ms acc) s))
(printf "~a result ~a mean ~a ms\n" name r
(exact->inexact (/ (apply + acc) 3.0))))))
(let* ((a (command-line-arguments))
(n (if (pair? a) (string->number (car a)) 30000)))
(printf "collections map-churn (n=~a, ~a buckets)\n" n buckets)
(bench "persistent HAMT (self-hostable) " freq-hamt sum-hamt n)
(bench "native hashtable (mutable, ceil)" freq-native sum-native n))

View file

@ -1,25 +0,0 @@
;; fib spike — translated from bench/fib.clj. Pure call + integer arith.
;; chez --script fib.ss [n=30] [optlevel=2]
(import (chezscheme))
(optimize-level
(let ((a (command-line-arguments)))
(if (and (pair? a) (pair? (cdr a))) (string->number (cadr a)) 2)))
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
(define (run n) (fib n))
(define (now-ns)
(let ((t (current-time 'time-monotonic)))
(+ (* (time-second t) 1000000000) (time-nanosecond t))))
(let* ((a (command-line-arguments))
(n (if (pair? a) (string->number (car a)) 30)))
(run (- n 6)) (run (- n 6)) ; warmup
(let loop ((k 0) (acc '()))
(if (< k 3)
(let* ((t0 (now-ns)) (r (run n)) (ms (/ (- (now-ns) t0) 1000000.0)))
(loop (+ k 1) (cons ms acc)))
(begin
(printf "fib n ~a result ~a\n" n (run n))
(printf "runs: ~a\n" (reverse acc))
(printf "mean: ~a ms\n" (exact->inexact (/ (apply + acc) 3.0)))))))

View file

@ -1,45 +0,0 @@
;; mandelbrot, flonum-specialized — what a type-aware jolt->Chez backend would
;; emit (fl*/fl+/fl< unbox; fx ops for the integer counter). This is the real
;; substrate ceiling vs the generic version (which boxes every flonum).
;; chez --script mandelbrot-fl.ss [n=200] [optlevel=3]
(import (chezscheme))
(optimize-level
(let ((a (command-line-arguments)))
(if (and (pair? a) (pair? (cdr a))) (string->number (cadr a)) 3)))
(define (count-point cr ci cap)
(let loop ((i 0) (zr 0.0) (zi 0.0))
(if (or (fx>= i cap) (fl> (fl+ (fl* zr zr) (fl* zi zi)) 4.0))
i
(loop (fx+ i 1)
(fl+ (fl- (fl* zr zr) (fl* zi zi)) cr)
(fl+ (fl* 2.0 (fl* zr zi)) ci)))))
(define (run n)
(let ((cap 200) (nd (fixnum->flonum n)))
(let loopy ((y 0) (acc 0))
(if (fx< y n)
(let* ((ci (fl- (fl/ (fl* 2.0 (fixnum->flonum y)) nd) 1.0))
(row (let loopx ((x 0) (a 0))
(if (fx< x n)
(let ((cr (fl- (fl/ (fl* 2.0 (fixnum->flonum x)) nd) 1.5)))
(loopx (fx+ x 1) (fx+ a (count-point cr ci cap))))
a))))
(loopy (fx+ y 1) (fx+ acc row)))
acc))))
(define (now-ns)
(let ((t (current-time 'time-monotonic)))
(+ (* (time-second t) 1000000000) (time-nanosecond t))))
(let* ((a (command-line-arguments))
(n (if (pair? a) (string->number (car a)) 200)))
(run n) (run n)
(let loop ((k 0) (acc '()))
(if (< k 3)
(let* ((t0 (now-ns)) (r (run n)) (ms (/ (- (now-ns) t0) 1000000.0)))
(loop (+ k 1) (cons ms acc)))
(begin
(printf "mandelbrot-fl n ~a result ~a\n" n (run n))
(printf "runs: ~a\n" (reverse acc))
(printf "mean: ~a ms\n" (exact->inexact (/ (apply + acc) 3.0)))))))

View file

@ -1,44 +0,0 @@
;; mandelbrot spike — translated from bench/mandelbrot.clj. Pure float compute,
;; tight recur loops (here named-let tail loops). cap=200 like the .clj.
;; chez --script mandelbrot.ss [n=200] [optlevel=2]
(import (chezscheme))
(optimize-level
(let ((a (command-line-arguments)))
(if (and (pair? a) (pair? (cdr a))) (string->number (cadr a)) 2)))
(define (count-point cr ci cap)
(let loop ((i 0) (zr 0.0) (zi 0.0))
(if (or (>= i cap) (> (+ (* zr zr) (* zi zi)) 4.0))
i
(loop (+ i 1)
(+ (- (* zr zr) (* zi zi)) cr)
(+ (* 2.0 (* zr zi)) ci)))))
(define (run n)
(let ((cap 200) (nd (* 1.0 n)))
(let loopy ((y 0) (acc 0))
(if (< y n)
(let* ((ci (- (/ (* 2.0 y) nd) 1.0))
(row (let loopx ((x 0) (a 0))
(if (< x n)
(let ((cr (- (/ (* 2.0 x) nd) 1.5)))
(loopx (+ x 1) (+ a (count-point cr ci cap))))
a))))
(loopy (+ y 1) (+ acc row)))
acc))))
(define (now-ns)
(let ((t (current-time 'time-monotonic)))
(+ (* (time-second t) 1000000000) (time-nanosecond t))))
(let* ((a (command-line-arguments))
(n (if (pair? a) (string->number (car a)) 200)))
(run n) (run n) ; warmup
(let loop ((k 0) (acc '()))
(if (< k 3)
(let* ((t0 (now-ns)) (r (run n)) (ms (/ (- (now-ns) t0) 1000000.0)))
(loop (+ k 1) (cons ms acc)))
(begin
(printf "mandelbrot n ~a result ~a\n" n (run n))
(printf "runs: ~a\n" (reverse acc))
(printf "mean: ~a ms\n" (exact->inexact (/ (apply + acc) 3.0)))))))

View file

@ -1,165 +0,0 @@
(ns jolt.lang.persistent-vector
"PersistentVector: 32-way branching trie with tail optimization.")
(def branch-factor 32)
(def shift-increment 5)
(def tail-max 31)
(deftype VectorNode [^:volatile-mutable arr])
(deftype PersistentVector [cnt shift root tail _meta])
(def empty-array (object-array 0))
(def EMPTY (PersistentVector. 0 shift-increment nil empty-array nil))
(defn- tailoff [pv]
(int (- (.-cnt pv) (unsigned-bit-shift-right (.-cnt pv) shift-increment))))
(defn- new-path [level node]
(if (= level 0)
node
(let [arr (object-array branch-factor)]
(aset arr 0 (new-path (int (- level shift-increment)) node))
(VectorNode. arr))))
(defn- push-tail [parent level tailnode cnt]
(let [subidx (int (bit-and (unsigned-bit-shift-right (int cnt) (int level)) tail-max))
ret (VectorNode. (aclone (.-arr parent)))]
(if (= level shift-increment)
(do (aset (.-arr ret) subidx tailnode) ret)
(let [child (aget (.-arr parent) subidx)]
(aset (.-arr ret) subidx
(if child
(push-tail child (int (- level shift-increment)) tailnode cnt)
(new-path (int (- level shift-increment)) tailnode)))
ret))))
(defn- do-assoc [level node i val]
(let [ret (VectorNode. (aclone (.-arr node)))]
(if (= level 0)
(do (aset (.-arr ret) (int (bit-and i tail-max)) val) ret)
(let [subidx (int (bit-and (unsigned-bit-shift-right (int i) (int level)) tail-max))]
(aset (.-arr ret) subidx
(do-assoc (int (- level shift-increment)) (aget (.-arr node) subidx) i val))
ret))))
(defn- array-for [pv i]
(if (and (<= 0 i) (< i (.-cnt pv)))
(if (>= i (tailoff pv))
(.-tail pv)
(loop [node (.-root pv) level (.-shift pv)]
(if (> level 0)
(recur (aget (.-arr node)
(int (bit-and (unsigned-bit-shift-right (int i) (int level)) tail-max)))
(int (- level shift-increment)))
(.-arr node))))
nil))
(defn pv-conj [pv val]
(let [cnt (.-cnt pv)]
(if (< (- cnt (tailoff pv)) branch-factor)
(let [old-len (alength (.-tail pv))
new-tail (object-array (+ old-len 1))]
(loop [i 0]
(if (< i old-len)
(do (aset new-tail i (aget (.-tail pv) i)) (recur (unchecked-inc i)))
(do (aset new-tail i val)
(PersistentVector. (unchecked-inc cnt) (.-shift pv) (.-root pv) new-tail (.-_meta pv))))))
(let [tail-node (VectorNode. (.-tail pv))
root-overflow? (> (unchecked-inc (unsigned-bit-shift-right cnt shift-increment))
(bit-shift-left 1 (.-shift pv)))]
(if root-overflow?
(let [nr (object-array branch-factor)]
(aset nr 0 (.-root pv))
(aset nr 1 (new-path (.-shift pv) tail-node))
(let [new-root (VectorNode. nr)
new-shift (+ (.-shift pv) shift-increment)
new-tail (object-array 1)]
(aset new-tail 0 val)
(PersistentVector. (unchecked-inc cnt) new-shift new-root new-tail (.-_meta pv))))
(let [new-root (push-tail (.-root pv) (.-shift pv) tail-node cnt)
new-tail (object-array 1)]
(aset new-tail 0 val)
(PersistentVector. (unchecked-inc cnt) (.-shift pv) new-root new-tail (.-_meta pv))))))))
(defn pv-nth [pv i]
(let [node (array-for pv i)]
(if node
(aget node (int (bit-and i tail-max)))
(throw (str "Index out of bounds: " i)))))
(defn pv-assoc [pv i val]
(let [cnt (.-cnt pv)]
(if (and (<= 0 i) (< i cnt))
(if (>= i (tailoff pv))
(let [new-tail (object-array (alength (.-tail pv)))]
(loop [j 0]
(if (< j (alength new-tail))
(do (aset new-tail j
(if (= j (int (bit-and i tail-max))) val (aget (.-tail pv) j)))
(recur (unchecked-inc j)))
(PersistentVector. cnt (.-shift pv) (.-root pv) new-tail (.-_meta pv)))))
(PersistentVector. cnt (.-shift pv) (do-assoc (.-shift pv) (.-root pv) i val) (.-tail pv) (.-_meta pv)))
(if (= i cnt)
(pv-conj pv val)
(throw (str "Index out of bounds: " i))))))
(defn- pop-tail [level node cnt]
(let [subidx (int (bit-and (unsigned-bit-shift-right (int (- cnt 2)) (int level)) tail-max))]
(if (> level shift-increment)
(let [new-child (pop-tail (int (- level shift-increment)) (aget (.-arr node) subidx) cnt)]
(if (and (nil? new-child) (zero? subidx))
nil
(let [ret (VectorNode. (aclone (.-arr node)))]
(aset (.-arr ret) subidx new-child)
ret)))
(if (zero? subidx)
nil
(let [ret (VectorNode. (aclone (.-arr node)))]
(aset (.-arr ret) subidx nil)
ret)))))
(defn- pv-nth-internal [cnt shift root i]
(if (and (<= 0 i) (< i cnt))
(if (>= i (- cnt (int (bit-and cnt tail-max))))
nil
(loop [node root level shift]
(if (> level 0)
(recur (aget (.-arr node) (int (bit-and (unsigned-bit-shift-right (int i) (int level)) tail-max)))
(int (- level shift-increment)))
(aget (.-arr node) (int (bit-and i tail-max))))))
nil))
(defn pv-pop [pv]
(let [cnt (.-cnt pv)]
(cond
(zero? cnt) (throw "Can't pop empty vector")
(= cnt 1) EMPTY
(> (- cnt (tailoff pv)) 1)
(let [old-tail (.-tail pv)
new-tail (object-array (dec (alength old-tail)))]
(loop [i 0]
(if (< i (alength new-tail))
(do (aset new-tail i (aget old-tail i)) (recur (unchecked-inc i)))
(PersistentVector. (dec cnt) (.-shift pv) (.-root pv) new-tail (.-_meta pv)))))
:else
(let [new-root (pop-tail (.-shift pv) (.-root pv) cnt)
new-cnt (dec cnt)
new-tail-len (int (bit-and new-cnt tail-max))
tail-len (if (zero? new-tail-len) branch-factor new-tail-len)
new-tail (object-array tail-len)]
(loop [i 0]
(if (< i tail-len)
(let [idx (+ (- new-cnt tail-len) i)]
(aset new-tail i (pv-nth-internal new-cnt (.-shift pv) new-root idx))
(recur (unchecked-inc i)))
(PersistentVector. new-cnt (.-shift pv) new-root new-tail (.-_meta pv))))))))
(defn pv-empty [_] EMPTY)
(defn vector [& args]
(loop [acc EMPTY items (seq args)]
(if (seq items)
(recur (pv-conj acc (first items)) (rest items))
acc)))
(defn vector? [x] (instance? PersistentVector x))

View file

@ -1,25 +0,0 @@
; Jolt Standard Library: jolt.http
; HTTP client over spork/http (janet.spork.http/*; requires `jpm install spork`).
; Responses come back as {:status int :headers map :body string}.
(defn- response->map [r]
;; clojure.core/get explicitly: this ns defines an http `get` that shadows it
{:status (clojure.core/get r :status)
:body (str (or (janet.spork.http/read-body r) ""))
:headers (reduce (fn [m kv] (assoc m (str (nth kv 0)) (str (nth kv 1))))
{}
(janet/pairs (or (clojure.core/get r :headers) (janet/struct))))})
(defn- header-struct [headers]
(apply janet/struct
(mapcat (fn [kv] [(str (key kv)) (str (val kv))]) (seq (or headers {})))))
(defn get
[url & {:keys [headers]}]
(response->map
(janet.spork.http/request "GET" url :headers (header-struct headers))))
(defn post
[url body & {:keys [headers]}]
(response->map
(janet.spork.http/request "POST" url :body body :headers (header-struct headers))))

View file

@ -52,7 +52,7 @@
(defn- drain-reader (defn- drain-reader
"All remaining content of a reader as a string. Shim readers (StringReader, "All remaining content of a reader as a string. Shim readers (StringReader,
PushbackReader, io/reader results) expose char-wise .read; a raw janet file PushbackReader, io/reader results) expose char-wise .read; a raw file
handle is read whole." handle is read whole."
[reader] [reader]
(if (= :core/file (janet/type reader)) (if (= :core/file (janet/type reader))

View file

@ -10,7 +10,7 @@
(map? form) (outer (into (empty form) (map inner form))) (map? form) (outer (into (empty form) (map inner form)))
; lists rebuild as lists, other seqs (incl. macro/template output: cons/ ; lists rebuild as lists, other seqs (incl. macro/template output: cons/
; concat/lazy-seq) walk too — without this, postwalk-replace silently no-op'd ; concat/lazy-seq) walk too — without this, postwalk-replace silently no-op'd
; a quoted list, breaking clojure.template/apply-template (jolt-khk) ; a quoted list, breaking clojure.template/apply-template
(list? form) (outer (apply list (map inner form))) (list? form) (outer (apply list (map inner form)))
(seq? form) (outer (map inner form)) (seq? form) (outer (map inner form))
:else (outer form))) :else (outer form)))

View file

@ -5,7 +5,7 @@
;; Ported from clojure.zip (Rich Hickey). A loc is a vector [node path] carrying ;; Ported from clojure.zip (Rich Hickey). A loc is a vector [node path] carrying
;; the zipper fns (:zip/branch? :zip/children :zip/make-node) as metadata. The ;; the zipper fns (:zip/branch? :zip/children :zip/make-node) as metadata. The
;; reference indexes a loc with (loc 0)/(loc 1); Jolt uses (nth loc ...) because a ;; reference indexes a loc with (loc 0)/(loc 1); Jolt uses (nth loc ...) because a
;; metadata-bearing vector is not currently invocable as a fn (see jolt-vh5). ;; metadata-bearing vector is not currently invocable as a fn.
(ns clojure.zip (ns clojure.zip
"Functional hierarchical zipper, with navigation, editing, and enumeration.") "Functional hierarchical zipper, with navigation, editing, and enumeration.")

Some files were not shown because too many files have changed in this diff Show more