jolt/host/chez/rt.ss
Yogthos cb3cfaf0c2 Chez Phase 1 (increment 3b): seq tier + dynamic IFn dispatch on the Chez RT
Brings up the seq layer on the Chez runtime. host/chez/seq.ss adds one
lazy-capable node (cseq) that models Clojure's list, cons, and lazy seq -
all print as (...), all sequential-= to each other and to vectors. seq
coerces any seqable (vector/map/set/string/list/seq/nil) to a cseq or nil;
the empty seq is a distinct value printing () (rest of a 1-elem coll is ()
not nil, seq of empty is nil). Leaf ops: first/rest/next/seq/cons/list,
reverse/last, map/filter/remove/reduce/into, range/take/drop/concat/apply,
keys/vals, plus nth/peek/pop extended over seqs. map/filter/reduce apply
their fn arg through jolt-invoke, so a procedure, keyword, or collection all
work as the fn.

Dynamic IFn dispatch: a keyword/vector/coll held in a local (let binding or
fn param) and called as a fn now routes through the jolt-invoke fallback
(procedure? -> apply; keyword/coll -> lookup). The emitter only routes a
:local callee that isn't a known procedure - a named fn's self-recursion
name stays a direct call, so the fib hot path is untouched. Closes the 3
ex-known IFn divergences.

emit.janet: seq/pred ops added to native-ops with arity gates; value-position
clojure.core refs resolve to the RT procedure (native-ops names one for each),
with +/-/*// routed to flonum-coercing wrappers so higher-order arithmetic
((reduce + [])) keeps the all-double model. values.ss: cross-type sequential
=/hash so a vector and a list of the same elements are jolt= and hash alike.
rt.ss: printer learns seqs; top-level nil prints as the empty string (jolt -e
str-style). Fixed latent bug: (conj nil ...) now builds a list, not a vector.

Gates: emit-test 69/69 (fib/mandelbrot/collections/seq/IFn parity vs the jolt
oracle, fib(30) ~24ms unchanged). Subset probe 433/436 -> 595/595 compiled,
0 divergences (was 3 known), 2060/2655 out of subset. Full run-tests green
(125 files, conformance + suites included).
2026-06-17 15:19:18 -04:00

86 lines
4.6 KiB
Scheme

;; Phase 1 (jolt-cf1q.2) — the minimal Chez RT the emitted Scheme rests on.
;;
;; 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:
;; 1. the var-cell late-binding registry (Clojure vars — a global root that a
;; reference reads at call time, so redefinition / mutual recursion work);
;; 2. the rt primitive shims the emitter names (jolt-inc/dec/not) and jolt's
;; number printing (all jolt numbers model Clojure doubles; integer-valued
;; print without a trailing ".0", matching the Janet host).
;;
;; Emitted programs do `(load "host/chez/rt.ss")`; this loads values.ss in turn.
(load "host/chez/values.ss")
(load "host/chez/collections.ss")
(load "host/chez/seq.ss")
;; --- rt arithmetic / logic shims (named in emit.janet's native-ops) ----------
(define (jolt-inc x) (+ x 1))
(define (jolt-dec x) (- x 1))
;; jolt `not`: only nil and false are falsey.
(define (jolt-not x) (if (jolt-truthy? x) #f #t))
;; --- var cells: late-bound global roots (Clojure vars) -----------------------
;; A var is a mutable cell keyed by "ns/name". A `:def` sets the root; a `:var`
;; reference reads it at use time (late binding), so a forward/mutually-recursive
;; reference resolves to whatever the cell holds when the call actually runs.
(define-record-type var-cell (fields ns name (mutable root)) (nongenerative var-cell-v1))
(define var-table (make-hashtable string-hash string=?))
(define (jolt-var ns name)
(let ((k (string-append ns "/" name)))
(or (hashtable-ref var-table k #f)
(let ((c (make-var-cell ns name jolt-nil)))
(hashtable-set! var-table k c)
c))))
(define (var-deref ns name) (var-cell-root (jolt-var ns name)))
(define (def-var! ns name v) (var-cell-root-set! (jolt-var ns name) v) v)
;; --- jolt number printing ----------------------------------------------------
;; jolt models every number as a Clojure double: integer-valued values print
;; without a ".0" (the Janet host prints (* 1.0 5) as "5", (/ 1 2) as "0.5").
(define (jolt-num->string x)
(if (and (rational? x) (integer? x))
(number->string (exact x))
(number->string x)))
;; Program-final-value printer. jolt's `-e` prints in str-style: strings raw (no
;; quotes), chars as `\c`/`\newline`, collections recursively. NOTE: maps/sets
;; render in HAMT-iteration order, which does NOT match the Janet host's order —
;; so unordered values are compared via `=` (true/false), not printed form.
;; The full canonical printer is Phase 2.
(define (jolt-str-join strs)
(cond ((null? strs) "") ((null? (cdr strs)) (car strs))
(else (string-append (car strs) " " (jolt-str-join (cdr strs))))))
(define (jolt-char->string c)
(string-append "\\" (case c ((#\newline) "newline") ((#\space) "space") ((#\tab) "tab")
((#\return) "return") (else (string c)))))
;; Program-final printer: jolt's `-e` is str-style at the top level, where a
;; bare nil renders as the empty string (a nil ELEMENT inside a collection still
;; prints "nil", which jolt-pr-str handles).
(define (jolt-final-str x) (if (jolt-nil? x) "" (jolt-pr-str x)))
(define (jolt-pr-str x)
(cond
((jolt-nil? x) "nil")
((eq? x #t) "true")
((eq? x #f) "false")
((number? x) (jolt-num->string x))
((string? x) x)
((char? x) (jolt-char->string x))
((keyword? x) (let ((ns (keyword-t-ns x)))
(if ns (string-append ":" ns "/" (keyword-t-name x)) (string-append ":" (keyword-t-name x)))))
((jolt-symbol? x) (let ((ns (symbol-t-ns x)))
(if (or (jolt-nil? ns) (not ns) (eq? ns '())) (symbol-t-name x)
(string-append ns "/" (symbol-t-name x)))))
((pvec? x) (let ((acc '())) (let loop ((i (fx- (pvec-count x) 1)))
(when (fx>=? i 0) (set! acc (cons (jolt-pr-str (pvec-nth-d x i jolt-nil)) acc)) (loop (fx- i 1))))
(string-append "[" (jolt-str-join acc) "]")))
((pset? x) (string-append "#{" (jolt-str-join (pset-fold x (lambda (e a) (cons (jolt-pr-str e) a)) '())) "}"))
((pmap? x) (string-append "{" (jolt-str-join
(pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '())) "}"))
;; lists / cons / lazy seqs all print as (...) — forces a finite seq.
((empty-list-t? x) "()")
((cseq? x) (string-append "(" (jolt-str-join
(let loop ((s x) (acc '()))
(if (jolt-nil? s) (reverse acc)
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")"))
(else (format "~a" x))))